MODFLOW 6  version 6.7.0.dev3
USGS Modular Hydrologic Model
methodcellmodule Module Reference

Data Types

type  methodcelltype
 

Functions/Subroutines

subroutine try_pass (this, particle, nextlevel, advancing)
 Try passing the particle to the next subdomain. or to a boundary of this method's tracking domain. More...
 
subroutine assess (this, particle, cell_defn, tmax)
 Check reporting/terminating conditions before tracking the particle across the cell. More...
 
subroutine cellexit (this, particle)
 Particle exits a cell. More...
 
logical(lgp) function forms_cycle (this, particle, event)
 Check if the event forms a cycle in the particle path. More...
 
subroutine store_event (this, particle, event)
 Save the event in the particle's history. Acts like a queue, the oldest event is removed when the event count exceeds the maximum size. More...
 
integer(i4b) function get_level (this)
 Get the cell method's level. More...
 
integer(i4b) function iboundary_to_icellface (this, iboundary)
 Convert an iboundary number to an iface number. More...
 

Function/Subroutine Documentation

◆ assess()

subroutine methodcellmodule::assess ( class(methodcelltype), intent(inout)  this,
type(particletype), intent(inout), pointer  particle,
type(celldefntype), intent(inout), pointer  cell_defn,
real(dp), intent(in)  tmax 
)
private

Check a number of conditions determining whether to continue tracking the particle or terminate it, as well as whether to record any output data as per selected reporting conditions.

Definition at line 77 of file MethodCell.f90.

78  ! modules
83  ! dummy
84  class(MethodCellType), intent(inout) :: this
85  type(ParticleType), pointer, intent(inout) :: particle
86  type(CellDefnType), pointer, intent(inout) :: cell_defn
87  real(DP), intent(in) :: tmax
88  ! local
89  logical(LGP) :: dry_cell, dry_particle, no_exit_face, stop_zone, weak_sink
90  integer(I4B) :: i
91  real(DP) :: t, ttrackmax
92 
93  dry_cell = cell_defn%isatstat == saturation_dry
94  dry_particle = particle%z > cell_defn%top
95  no_exit_face = cell_defn%inoexitface > 0
96  stop_zone = cell_defn%izone > 0 .and. particle%istopzone == cell_defn%izone
97  weak_sink = cell_defn%iweaksink > 0
98 
99  particle%izone = cell_defn%izone
100  if (stop_zone) then
101  call this%terminate(particle, status=term_stopzone)
102  return
103  end if
104 
105  if (no_exit_face .and. .not. dry_cell) then
106  call this%terminate(particle, status=term_no_exits)
107  return
108  end if
109 
110  if (weak_sink) then
111  if (particle%istopweaksink > 0) then
112  call this%terminate(particle, status=term_weaksink)
113  return
114  else
115  call this%weaksink(particle)
116  end if
117  end if
118 
119  if (dry_cell) then
120  if (particle%idrymeth == 0) then
121  ! drop to cell bottom. handled by pass
122  ! to bottom method, nothing to do here
123  no_exit_face = .false.
124  else if (particle%idrymeth == 1) then
125  ! stop
126  call this%terminate(particle, status=term_inactive)
127  return
128  else if (particle%idrymeth == 2) then
129  ! stay
130  particle%advancing = .false.
131  no_exit_face = .false.
132 
133  ! we might report tracking times
134  ! out of order here, but we want
135  ! the particle termination event
136  ! (if this is the last time step)
137  ! to have the maximum tracking t,
138  ! so we need to keep tabs on it.
139  ttrackmax = totim
140 
141  ! update tracking time to time
142  ! step end time and save record
143  particle%ttrack = totim
144  call this%timestep(particle)
145 
146  ! record user tracking times
147  call this%tracktimes%advance()
148  if (this%tracktimes%any()) then
149  do i = this%tracktimes%selection(1), this%tracktimes%selection(2)
150  t = this%tracktimes%times(i)
151  if (t < totimc) cycle
152  if (t >= tmax) exit
153  particle%ttrack = t
154  call this%usertime(particle)
155  if (t > ttrackmax) ttrackmax = t
156  end do
157  end if
158 
159  ! terminate if last period/step
160  if (endofsimulation) then
161  particle%ttrack = ttrackmax
162  call this%terminate(particle, status=term_no_exits)
163  return
164  end if
165  end if
166  else if (dry_particle .and. this%name /= "passtobottom") then
167  if (particle%idrymeth == 0) then
168  ! drop to water table
169  particle%z = cell_defn%top
170  call this%dropped(particle)
171  else if (particle%idrymeth == 1) then
172  ! stop
173  call this%terminate(particle, status=term_inactive)
174  return
175  else if (particle%idrymeth == 2) then
176  ! stay
177  particle%advancing = .false.
178  no_exit_face = .false.
179 
180  ! we might report tracking times
181  ! out of order here, but we want
182  ! the particle termination event
183  ! (if this is the last time step)
184  ! to have the maximum tracking t,
185  ! so we need to keep tabs on it.
186  ttrackmax = totim
187 
188  ! update tracking time to time
189  ! step end time and save record
190  particle%ttrack = totim
191  call this%timestep(particle)
192 
193  ! record user tracking times
194  call this%tracktimes%advance()
195  if (this%tracktimes%any()) then
196  do i = this%tracktimes%selection(1), this%tracktimes%selection(2)
197  t = this%tracktimes%times(i)
198  if (t < totimc) cycle
199  if (t >= tmax) exit
200  particle%ttrack = t
201  call this%usertime(particle)
202  if (t > ttrackmax) ttrackmax = t
203  end do
204  end if
205  end if
206  end if
207 
208  if (no_exit_face) then
209  particle%advancing = .false.
210  particle%istatus = term_no_exits
211  call this%terminate(particle)
212  return
213  end if
214 
@, public weaksink
particle entered a weak sink
@, public usertime
user-specified tracking time
@, public terminate
particle terminated
@, public timestep
time step ended
@ term_weaksink
terminated in a weak sink cell
Definition: Particle.f90:31
@ term_inactive
terminated in an inactive cell
Definition: Particle.f90:34
@ term_no_exits
terminated in a cell with no exit face
Definition: Particle.f90:32
@ term_stopzone
terminated in a cell with a stop zone number
Definition: Particle.f90:33
logical(lgp), pointer, public endofsimulation
flag indicating end of simulation
Definition: tdis.f90:28
real(dp), pointer, public totim
time relative to start of simulation
Definition: tdis.f90:32
real(dp), pointer, public totimc
simulation time at start of time step
Definition: tdis.f90:33

◆ cellexit()

subroutine methodcellmodule::cellexit ( class(methodcelltype), intent(inout)  this,
type(particletype), intent(inout), pointer  particle 
)

Definition at line 218 of file MethodCell.f90.

219  class(MethodCellType), intent(inout) :: this
220  type(ParticleType), pointer, intent(inout) :: particle
221  class(ParticleEventType), pointer :: event
222  ! local
223  integer(I4B) :: i, nhist
224  class(*), pointer :: prev
225 
226  allocate (cellexiteventtype :: event)
227  select type (event)
228  type is (cellexiteventtype)
229  event%exit_face = particle%iboundary(level_feature)
230  end select
231  call this%events%dispatch(particle, event)
232  if (particle%icycwin == 0) then
233  deallocate (event)
234  return
235  end if
236  if (this%forms_cycle(particle, event)) then
237  ! print event history
238  print *, "Cyclic pathline detected"
239  nhist = particle%history%Count()
240  do i = 1, nhist
241  prev => particle%history%GetItem(i)
242  select type (prev)
243  class is (particleeventtype)
244  print *, "Back ", nhist - i + 1, ": ", prev%get_text()
245  end select
246  end do
247  print *, "Current :", event%get_text()
248  call pstop(1, 'Cyclic pathline detected, aborting')
249  else
250  call this%store_event(particle, event)
251  end if
Here is the call graph for this function:

◆ forms_cycle()

logical(lgp) function methodcellmodule::forms_cycle ( class(methodcelltype), intent(inout)  this,
type(particletype), intent(inout), pointer  particle,
class(particleeventtype), intent(in), pointer  event 
)
private

Definition at line 255 of file MethodCell.f90.

256  ! dummy
257  class(MethodCellType), intent(inout) :: this
258  type(ParticleType), pointer, intent(inout) :: particle
259  class(ParticleEventType), pointer, intent(in) :: event
260  ! local
261  class(IteratorType), allocatable :: itr
262  logical(LGP) :: found_cycle
263 
264  found_cycle = .false.
265  select type (event)
266  type is (cellexiteventtype)
267  itr = particle%history%Iterator()
268  do while (itr%has_next())
269  call itr%next()
270  select type (prev => itr%value())
271  class is (cellexiteventtype)
272  if (event%icu == prev%icu .and. &
273  event%ilay == prev%ilay .and. &
274  event%izone == prev%izone .and. &
275  event%exit_face == prev%exit_face .and. &
276  event%exit_face /= 0) then
277  found_cycle = .true.
278  exit
279  end if
280  end select
281  end do
282  end select

◆ get_level()

integer(i4b) function methodcellmodule::get_level ( class(methodcelltype), intent(in)  this)
private

Definition at line 306 of file MethodCell.f90.

307  class(MethodCellType), intent(in) :: this
308  integer(I4B) :: level
309  level = level_feature

◆ iboundary_to_icellface()

integer(i4b) function methodcellmodule::iboundary_to_icellface ( class(methodcelltype), intent(inout)  this,
integer(i4b), intent(in)  iboundary 
)
private

Definition at line 313 of file MethodCell.f90.

314  class(MethodCellType), intent(inout) :: this
315  integer(I4B), intent(in) :: iboundary
316  integer(I4B) :: iface
317  integer(I4B) :: nfaces
318 
319  iface = iboundary
320  nfaces = this%cell%defn%npolyverts + 2
321  if (iface >= nfaces) &
322  ! uncompress and drop wraparound index
323  iface = iface + (this%fmi%max_faces - nfaces) - 1

◆ store_event()

subroutine methodcellmodule::store_event ( class(methodcelltype), intent(inout)  this,
type(particletype), intent(inout), pointer  particle,
class(particleeventtype), intent(in), pointer  event 
)
private

Definition at line 288 of file MethodCell.f90.

289  ! dummy
290  class(MethodCellType), intent(inout) :: this
291  type(ParticleType), pointer, intent(inout) :: particle
292  class(ParticleEventType), pointer, intent(in) :: event
293  ! local
294  class(*), pointer :: p
295 
296  select type (event)
297  type is (cellexiteventtype)
298  p => event
299  call particle%history%Add(p)
300  if (particle%history%Count() > particle%icycwin) &
301  call particle%history%RemoveNode(1, .true.)
302  end select

◆ try_pass()

subroutine methodcellmodule::try_pass ( class(methodcelltype), intent(inout)  this,
type(particletype), intent(inout), pointer  particle,
integer(i4b)  nextlevel,
logical(lgp)  advancing 
)
private

If the particle is not advancing, or if it's not at a boundary, nothing happens. Otherwise, raise a cell exit event. Then, if at a net outflow boundary face, or top face of a partially saturated cell, terminate.

Definition at line 37 of file MethodCell.f90.

38  class(MethodCellType), intent(inout) :: this
39  type(ParticleType), pointer, intent(inout) :: particle
40  logical(LGP) :: advancing
41  integer(I4B) :: nextlevel
42  ! local
43  integer(I4B) :: ic, iboundary, icellface
44 
45  if (.not. particle%advancing) then
46  advancing = .false.
47  particle%iboundary = 0
48  return
49  end if
50 
51  call this%pass(particle)
52 
53  iboundary = particle%iboundary(level_feature)
54  icellface = this%iboundary_to_icellface(iboundary)
55  if (icellface <= 0) return
56 
57  ! on a cell face, done advancing. raise an exit event
58  advancing = .false.
59  call this%cellexit(particle)
60 
61  ! assigned boundary face with net outflow? terminate
62  ic = particle%itrdomain(level_feature)
63  if (this%fmi%is_net_out_boundary_face(ic, icellface)) then
64  call this%terminate(particle, status=term_boundary)
65  return
66  end if
67