20 real(dp),
allocatable,
public :: qextl1(:), qextl2(:), qintl(:)
38 method%subcell => subcell
39 method%type => method%subcell%type
40 method%delegates = .false.
46 deallocate (this%type)
54 real(DP),
intent(in) :: tmax
62 select type (subcell => this%subcell)
68 xorigin = subcell%xOrigin
69 yorigin = subcell%yOrigin
70 zorigin = subcell%zOrigin
71 sinrot = subcell%sinrot
72 cosrot = subcell%cosrot
73 call particle%transform(xorigin, yorigin)
74 call this%track_subcell(subcell, particle, tmax)
75 call particle%transform(xorigin, yorigin, invert=.true.)
93 real(DP),
intent(in) :: tmax
112 integer(I4B) :: statusVX
113 integer(I4B) :: statusVY
114 integer(I4B) :: statusVZ
119 integer(I4B) :: exitFace
120 integer(I4B) :: reason
121 integer(I4B) :: tslice(2)
126 initialx = particle%x / subcell%dx
127 initialy = particle%y / subcell%dy
128 initialz = particle%z / subcell%dz
131 statusvx =
calculate_dt(subcell%vx1, subcell%vx2, subcell%dx, &
132 initialx, vx, dvxdx, dtexitx)
133 statusvy =
calculate_dt(subcell%vy1, subcell%vy2, subcell%dy, &
134 initialy, vy, dvydy, dtexity)
135 statusvz =
calculate_dt(subcell%vz1, subcell%vz2, subcell%dz, &
136 initialz, vz, dvzdz, dtexitz)
139 if ((statusvx .eq. 3) .and. (statusvy .eq. 3) .and. (statusvz .eq. 3))
then
140 call this%save(particle, reason=9)
147 if ((statusvx .lt. 2) .or. (statusvy .lt. 2) .or. (statusvz .lt. 2))
then
150 if (vx .lt. 0d0)
then
152 else if (vx .gt. 0)
then
156 if (dtexity .lt. dtexit)
then
158 if (vy .lt. 0d0)
then
160 else if (vy .gt. 0d0)
then
165 if (dtexitz .lt. dtexit)
then
167 if (vz .lt. 0d0)
then
169 else if (vz .gt. 0d0)
then
177 texit = particle%ttrack + dtexit
184 call this%tracktimes%try_advance()
185 tslice = this%tracktimes%selection
187 if (all(tslice > 0))
then
188 do i = tslice(1), tslice(2)
189 t = this%tracktimes%times(i)
190 if (t < particle%ttrack .or. t >= texit .or. t >= tmax) cycle
192 x =
new_x(vx, dvxdx, subcell%vx1, subcell%vx2, &
193 dt, initialx, subcell%dx, statusvx == 1)
194 y =
new_x(vy, dvydy, subcell%vy1, subcell%vy2, &
195 dt, initialy, subcell%dy, statusvy == 1)
196 z =
new_x(vz, dvzdz, subcell%vz1, subcell%vz2, &
197 dt, initialz, subcell%dz, statusvz == 1)
198 particle%x = x * subcell%dx
199 particle%y = y * subcell%dy
200 particle%z = z * subcell%dz
203 call this%save(particle, reason=5)
207 if (texit .gt. tmax)
then
213 x =
new_x(vx, dvxdx, subcell%vx1, subcell%vx2, &
214 dt, initialx, subcell%dx, statusvx == 1)
215 y =
new_x(vy, dvydy, subcell%vy1, subcell%vy2, &
216 dt, initialy, subcell%dy, statusvy == 1)
217 z =
new_x(vz, dvzdz, subcell%vz1, subcell%vz2, &
218 dt, initialz, subcell%dz, statusvz == 1)
221 particle%advancing = .false.
229 if ((exitface .eq. 1) .or. (exitface .eq. 2))
then
231 y =
new_x(vy, dvydy, subcell%vy1, subcell%vy2, &
232 dt, initialy, subcell%dy, statusvy == 1)
233 z =
new_x(vz, dvzdz, subcell%vz1, subcell%vz2, &
234 dt, initialz, subcell%dz, statusvz == 1)
235 if (exitface .eq. 2) x = 1.0d0
236 else if ((exitface .eq. 3) .or. (exitface .eq. 4))
then
237 x =
new_x(vx, dvxdx, subcell%vx1, subcell%vx2, dt, &
238 initialx, subcell%dx, statusvx == 1)
240 z =
new_x(vz, dvzdz, subcell%vz1, subcell%vz2, dt, &
241 initialz, subcell%dz, statusvz == 1)
242 if (exitface .eq. 4) y = 1.0d0
243 else if ((exitface .eq. 5) .or. (exitface .eq. 6))
then
244 x =
new_x(vx, dvxdx, subcell%vx1, subcell%vx2, &
245 dt, initialx, subcell%dx, statusvx == 1)
246 y =
new_x(vy, dvydy, subcell%vy1, subcell%vy2, &
247 dt, initialy, subcell%dy, statusvy == 1)
249 if (exitface .eq. 6) z = 1.0d0
251 print *,
"programmer error, invalid exit face", exitface
259 particle%x = x * subcell%dx
260 particle%y = y * subcell%dy
261 particle%z = z * subcell%dz
263 particle%iboundary(3) = exitface
266 if (reason >= 0)
call this%save(particle, reason=reason)
287 integer(I4B) :: status
303 logical(LGP) :: nooutflow
309 if (v2a .lt. 0d0) v2a = -v2a
311 if (v1a .lt. 0d0) v1a = -v1a
314 if (dva .lt. 0d0) dva = -dva
319 if ((v2a .lt. tol) .and. (v1a .lt. tol))
then
330 if (v2a .gt. vv) vv = v2a
332 if (vvv .lt. 1.0d-4)
then
337 if (v1 .gt. zro) dt = (dx - x) / v1
338 if (v1 .lt. zrom) dt = -x / v1
347 v = (1.0d0 - xl) * v1 + xl * v2
352 if (v1 .lt. 0d0) nooutflow = .false.
353 if (v2 .gt. 0d0) nooutflow = .false.
363 if ((v1 .le. 0d0) .and. (v2 .ge. 0d0))
then
364 if (abs(v) .le. 0d0)
then
366 if (v2 .le. 0d0) v = -v
376 if (vr .le. 0d0)
then
384 if (v1v2 .gt. 0d0)
then
385 if (v .gt. 0d0) vr = vr2
386 if (v .lt. 0d0) vr = vr1
391 if (dabs(vr) .lt. 1.0d-10)
then
411 pure function new_x(v, dvdx, v1, v2, dt, x, dx, velocity_profile)
result(newx)
413 real(dp),
intent(in) :: v
414 real(dp),
intent(in) :: dvdx
415 real(dp),
intent(in) :: v1
416 real(dp),
intent(in) :: v2
417 real(dp),
intent(in) :: dt
418 real(dp),
intent(in) :: x
419 real(dp),
intent(in) :: dx
420 logical(LGP),
intent(in),
optional :: velocity_profile
423 logical(LGP) :: lprofile
426 if (
present(velocity_profile))
then
427 lprofile = velocity_profile
435 newx = newx + (v1 * dt / dx)
436 else if (v .ne. 0d0)
then
437 newx = newx + (v * (exp(dvdx * dt) - 1.0d0) / dvdx / dx)
441 if (newx .lt. 0d0) newx = 0d0
442 if (newx .gt. 1.0d0) newx = 1.0d0
subroutine pstop(status, message)
Stop the program, optionally specifying an error status code.
This module defines variable data types.
Particle tracking strategies.
pure real(dp) function new_x(v, dvdx, v1, v2, dt, x, dx, velocity_profile)
Update a cell-local coordinate based on a time increment.
integer(i4b) function, public calculate_dt(v1, v2, dx, xL, v, dvdx, dt)
Calculate particle travel time to exit and exit status.
subroutine track_subcell(this, subcell, particle, tmax)
Track a particle across a rectangular subcell using Pollock's method.
subroutine, public create_method_subcell_pollock(method)
Create a new Pollock's subcell-method object.
subroutine apply_msp(this, particle, tmax)
Apply Pollock's method to a rectangular subcell.
subroutine destroy_msp(this)
Destructor for a Pollock's subcell-method object.
pure character(len=lenmempath) function, public get_particle_id(particle)
Return the particle's composite ID.
subroutine, public create_subcell_rect(subcell)
Create a new rectangular subcell.
Base type for grid cells of a concrete type. Contains a cell-definition which is information shared b...
Base type for particle tracking methods.
Rectangular subcell tracking method.
A particle tracked by the PRT model.
Manages particle track (i.e. pathline) files.