MODFLOW 6  version 6.7.0.dev3
USGS Modular Hydrologic Model
Method.f90
Go to the documentation of this file.
1 !> @brief Particle tracking strategies
3 
4  use kindmodule, only: dp, i4b, lgp
5  use constantsmodule, only: dzero
6  use errorutilmodule, only: pstop
7  use subcellmodule, only: subcelltype
18  use basedismodule, only: disbasetype
19  use prtfmimodule, only: prtfmitype
20  use cellmodule, only: celltype
21  use celldefnmodule, only: celldefntype
23  use mathutilmodule, only: is_close
24  use domainmodule, only: domaintype
26  use listmodule, only: listtype
27  implicit none
28 
30 
31  !> @brief Tracking method level enumeration.
32  !!
33  !> Tracking levels: 1: model, 2: grid feature, 3: grid subfeature.
34  !! A tracking level identifies the domain through which a tracking
35  !! method is responsible for moving a particle. Methods operate on
36  !! a particular level and delegate to submethods for levels higher
37  !! than (i.e. below the scope of) their own.
38  !<
39  enum, bind(C)
40  enumerator :: level_model = 1
41  enumerator :: level_feature = 2
42  enumerator :: level_subfeature = 3
43  end enum
44 
45  private
46  public :: methodtype
47 
48  !> @brief Base type for particle tracking methods.
49  !!
50  !! The PRT tracking algorithm invokes a "tracking method" for each
51  !! domain. A domain can be a model, cell in a model, or subcell in
52  !! a cell. Tracking proceeds recursively, delegating to a possibly
53  !! arbitrary number of subdomains (currently, only the three above
54  !! are recognized). A tracking method is responsible for advancing
55  !! a particle through a domain, delegating to subdomains as needed
56  !! depending on cell geometry (implementing the strategy pattern).
57  !<
58  type, abstract :: methodtype
59  character(len=40), pointer, public :: name !< method name
60  logical(LGP), public :: delegates !< whether the method delegates
61  type(prtfmitype), pointer, public :: fmi => null() !< ptr to fmi
62  class(celltype), pointer, public :: cell => null() !< ptr to the current cell
63  class(subcelltype), pointer, public :: subcell => null() !< ptr to the current subcell
64  type(particleeventdispatchertype), pointer, public :: events => null() !< ptr to event dispatcher
65  type(timeselecttype), pointer, public :: tracktimes => null() !< ptr to user-defined tracking times
66  integer(I4B), dimension(:), pointer, contiguous, public :: izone => null() !< pointer to zone numbers
67  real(dp), dimension(:), pointer, contiguous, public :: flowja => null() !< pointer to intercell flows
68  real(dp), dimension(:), pointer, contiguous, public :: porosity => null() !< pointer to aquifer porosity
69  real(dp), dimension(:), pointer, contiguous, public :: retfactor => null() !< pointer to retardation factor
70  contains
71  ! Implemented in all subtypes
72  procedure(apply), deferred :: apply !< apply the method to the particle
73  procedure(assess), deferred :: assess !< assess conditions before tracking
74  procedure(deallocate), deferred :: deallocate !< deallocate the method object
75  procedure :: get_level !< get the tracking method level
76  ! Overridden in subtypes that delegate
77  procedure :: pass !< pass the particle to the next subdomain
78  procedure :: load !< load the subdomain tracking method
79  procedure :: find_exits !< find domain exit solutions
80  procedure :: pick_exit
81  ! Implemented here
82  procedure :: init
83  procedure :: track
84  procedure :: try_pass
85  ! Event firing methods
86  procedure :: release
87  procedure :: terminate
88  procedure :: timestep
89  procedure :: weaksink
90  procedure :: usertime
91  procedure :: dropped
92  end type methodtype
93 
94  abstract interface
95  subroutine apply(this, particle, tmax)
96  import dp
97  import methodtype
98  import particletype
99  class(methodtype), intent(inout) :: this
100  type(particletype), pointer, intent(inout) :: particle
101  real(DP), intent(in) :: tmax
102  end subroutine apply
103  subroutine assess(this, particle, cell_defn, tmax)
104  import dp
105  import methodtype
106  import particletype
107  import celldefntype
108  class(methodtype), intent(inout) :: this
109  type(particletype), pointer, intent(inout) :: particle
110  type(celldefntype), pointer, intent(inout) :: cell_defn
111  real(DP), intent(in) :: tmax
112  end subroutine assess
113  subroutine deallocate (this)
114  import methodtype
115  class(methodtype), intent(inout) :: this
116  end subroutine deallocate
117  end interface
118 
119 contains
120 
121  !> @brief Initialize the method with pointers to model data.
122  subroutine init(this, fmi, cell, subcell, events, tracktimes, &
123  izone, flowja, porosity, retfactor)
124  class(methodtype), intent(inout) :: this
125  type(prtfmitype), intent(in), pointer, optional :: fmi
126  class(celltype), intent(in), pointer, optional :: cell
127  class(subcelltype), intent(in), pointer, optional :: subcell
128  type(particleeventdispatchertype), intent(in), pointer, optional :: events
129  type(timeselecttype), intent(in), pointer, optional :: tracktimes
130  integer(I4B), intent(in), pointer, optional :: izone(:)
131  real(DP), intent(in), pointer, optional :: flowja(:)
132  real(DP), intent(in), pointer, optional :: porosity(:)
133  real(DP), intent(in), pointer, optional :: retfactor(:)
134 
135  if (present(fmi)) this%fmi => fmi
136  if (present(cell)) this%cell => cell
137  if (present(subcell)) this%subcell => subcell
138  if (present(events)) this%events => events
139  if (present(tracktimes)) this%tracktimes => tracktimes
140  if (present(izone)) this%izone => izone
141  if (present(flowja)) this%flowja => flowja
142  if (present(porosity)) this%porosity => porosity
143  if (present(retfactor)) this%retfactor => retfactor
144  end subroutine init
145 
146  !> @brief Track the particle over subdomains of the given
147  ! level until the particle terminates or tmax is reached.
148  recursive subroutine track(this, particle, level, tmax)
149  ! dummy
150  class(methodtype), intent(inout) :: this
151  type(particletype), pointer, intent(inout) :: particle
152  integer(I4B) :: level
153  real(dp), intent(in) :: tmax
154  ! local
155  logical(LGP) :: advancing
156  integer(I4B) :: nextlevel
157  class(methodtype), pointer :: submethod
158 
159  advancing = .true.
160  nextlevel = level + 1
161  do while (advancing)
162  call this%load(particle, nextlevel, submethod)
163  call submethod%apply(particle, tmax)
164  call this%try_pass(particle, nextlevel, advancing)
165  end do
166  end subroutine track
167 
168  !> @brief Try passing the particle to the next subdomain.
169  subroutine try_pass(this, particle, nextlevel, advancing)
170  class(methodtype), intent(inout) :: this
171  type(particletype), pointer, intent(inout) :: particle
172  integer(I4B) :: nextlevel
173  logical(LGP) :: advancing
174 
175  if (particle%advancing) then
176  ! if still advancing, pass to the next subdomain.
177  ! if that puts us on a boundary, then we're done.
178  call this%pass(particle)
179  if (particle%iboundary(nextlevel - 1) .ne. 0) &
180  advancing = .false.
181  else
182  ! otherwise we're already done so
183  ! reset the domain boundary value.
184  advancing = .false.
185  particle%iboundary = 0
186  end if
187  end subroutine try_pass
188 
189  !> @brief Get tracking method level.
190  function get_level(this) result(level)
191  class(methodtype), intent(in) :: this
192  integer(I4B) :: level
193  level = -1 ! suppress compiler warning
194  call pstop(1, "get_level must be overridden")
195  end function get_level
196 
197  !> @brief Load subdomain tracking method (submethod).
198  subroutine load(this, particle, next_level, submethod)
199  class(methodtype), intent(inout) :: this
200  type(particletype), pointer, intent(inout) :: particle
201  integer, intent(in) :: next_level
202  class(methodtype), pointer, intent(inout) :: submethod
203  call pstop(1, "load must be overridden")
204  end subroutine load
205 
206  !> @brief Pass particle to the next subdomain or to a domain boundary.
207  subroutine pass(this, particle)
208  class(methodtype), intent(inout) :: this
209  type(particletype), pointer, intent(inout) :: particle
210  call pstop(1, "pass must be overridden")
211  end subroutine pass
212 
213  !> @brief Compute candidate exit solutions.
214  subroutine find_exits(this, particle, domain)
215  class(methodtype), intent(inout) :: this
216  type(particletype), pointer, intent(inout) :: particle
217  class(domaintype), intent(in) :: domain
218  if (.not. this%delegates) &
219  call pstop(1, "find_exits called on non-delegating method")
220  call pstop(1, "find_exits must be overridden in delegating methods")
221  end subroutine find_exits
222 
223  !> @brief Choose an exit solution among candidates.
224  function pick_exit(this, particle) result(exit_soln)
225  class(methodtype), intent(inout) :: this
226  type(particletype), pointer, intent(inout) :: particle
227  integer(I4B) :: exit_soln
228  exit_soln = 0 ! suppress compiler warning
229  if (.not. this%delegates) &
230  call pstop(1, "pick_exit called on non-delegating method")
231  call pstop(1, "pick_exit must be overridden in delegating methods")
232  end function pick_exit
233 
234  !> @brief A particle is released.
235  subroutine release(this, particle)
236  class(methodtype), intent(inout) :: this
237  type(particletype), pointer, intent(inout) :: particle
238  class(particleeventtype), pointer :: event
239  allocate (releaseeventtype :: event)
240  call this%events%dispatch(particle, event)
241  deallocate (event)
242  end subroutine release
243 
244  !> @brief A particle terminates.
245  subroutine terminate(this, particle, status)
246  class(methodtype), intent(inout) :: this
247  type(particletype), pointer, intent(inout) :: particle
248  integer(I4B), intent(in), optional :: status
249  class(particleeventtype), pointer :: event
250  particle%advancing = .false.
251  if (present(status)) particle%istatus = status
252  allocate (terminationeventtype :: event)
253  call this%events%dispatch(particle, event)
254  deallocate (event)
255  end subroutine terminate
256 
257  !> @brief A time step ends.
258  subroutine timestep(this, particle)
259  class(methodtype), intent(inout) :: this
260  type(particletype), pointer, intent(inout) :: particle
261  class(particleeventtype), pointer :: event
262  allocate (timestepeventtype :: event)
263  call this%events%dispatch(particle, event)
264  deallocate (event)
265  end subroutine timestep
266 
267  !> @brief A particle leaves a weak sink.
268  subroutine weaksink(this, particle)
269  class(methodtype), intent(inout) :: this
270  type(particletype), pointer, intent(inout) :: particle
271  class(particleeventtype), pointer :: event
272  allocate (weaksinkeventtype :: event)
273  call this%events%dispatch(particle, event)
274  deallocate (event)
275  end subroutine weaksink
276 
277  !> @brief A user-defined tracking time occurs.
278  subroutine usertime(this, particle)
279  class(methodtype), intent(inout) :: this
280  type(particletype), pointer, intent(inout) :: particle
281  class(particleeventtype), pointer :: event
282  allocate (usertimeeventtype :: event)
283  call this%events%dispatch(particle, event)
284  deallocate (event)
285  end subroutine usertime
286 
287  !> @brief A particle drops to the water table.
288  subroutine dropped(this, particle)
289  class(methodtype), intent(inout) :: this
290  type(particletype), pointer, intent(inout) :: particle
291  class(particleeventtype), pointer :: event
292  allocate (droppedeventtype :: event)
293  call this%events%dispatch(particle, event)
294  deallocate (event)
295  end subroutine dropped
296 
297 end module methodmodule
This module contains simulation constants.
Definition: Constants.f90:9
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
subroutine pstop(status, message)
Stop the program, optionally specifying an error status code.
Definition: ErrorUtil.f90:24
This module defines variable data types.
Definition: kind.f90:8
pure logical function, public is_close(a, b, rtol, atol, symmetric)
Check if a real value is approximately equal to another.
Definition: MathUtil.f90:46
Particle tracking strategies.
Definition: Method.f90:2
subroutine dropped(this, particle)
A particle drops to the water table.
Definition: Method.f90:289
subroutine load(this, particle, next_level, submethod)
Load subdomain tracking method (submethod).
Definition: Method.f90:199
subroutine terminate(this, particle, status)
A particle terminates.
Definition: Method.f90:246
subroutine release(this, particle)
A particle is released.
Definition: Method.f90:236
recursive subroutine track(this, particle, level, tmax)
Track the particle over subdomains of the given.
Definition: Method.f90:149
subroutine weaksink(this, particle)
A particle leaves a weak sink.
Definition: Method.f90:269
subroutine try_pass(this, particle, nextlevel, advancing)
Try passing the particle to the next subdomain.
Definition: Method.f90:170
integer(i4b) function get_level(this)
Get tracking method level.
Definition: Method.f90:191
subroutine timestep(this, particle)
A time step ends.
Definition: Method.f90:259
@, public level_feature
Definition: Method.f90:41
subroutine usertime(this, particle)
A user-defined tracking time occurs.
Definition: Method.f90:279
subroutine find_exits(this, particle, domain)
Compute candidate exit solutions.
Definition: Method.f90:215
integer(i4b) function pick_exit(this, particle)
Choose an exit solution among candidates.
Definition: Method.f90:225
@, public level_subfeature
Definition: Method.f90:42
@, public level_model
Definition: Method.f90:40
subroutine pass(this, particle)
Pass particle to the next subdomain or to a domain boundary.
Definition: Method.f90:208
Specify times for some event to occur.
Definition: TimeSelect.f90:2
Base grid cell definition.
Definition: CellDefn.f90:25
Base type for grid cells of a concrete type. Contains a cell-definition which is information shared b...
Definition: Cell.f90:12
A tracking domain.
Definition: Domain.f90:8
Base type for exit solutions.
A generic heterogeneous doubly-linked list.
Definition: List.f90:14
Base type for particle tracking methods.
Definition: Method.f90:58
Base type for particle events.
Particle tracked by the PRT model.
Definition: Particle.f90:56
A subcell of a cell.
Definition: Subcell.f90:10
Represents a series of instants at which some event should occur.
Definition: TimeSelect.f90:30