41 method%name => method%cell%type
42 method%delegates = .true.
44 method%subcell => subcell
50 deallocate (this%name)
54 subroutine load_mcpq(this, particle, next_level, submethod)
57 integer,
intent(in) :: next_level
58 class(
methodtype),
pointer,
intent(inout) :: submethod
60 select type (subcell => this%subcell)
62 call this%load_subcell(particle, subcell)
67 subcell=this%subcell, &
68 trackctl=this%trackctl, &
69 tracktimes=this%tracktimes)
79 integer(I4B) :: isc, exitFace, npolyverts, inface, infaceoff
81 select type (cell => this%cell)
83 exitface = particle%iboundary(3)
84 isc = particle%idomain(3)
85 npolyverts = cell%defn%npolyverts
88 select case (exitface)
96 particle%idomain(3) = 4
97 particle%iboundary(3) = 2
101 particle%idomain(3) = 3
102 particle%iboundary(3) = 2
125 particle%idomain(3) = 2
126 particle%iboundary(3) = 1
130 particle%idomain(3) = 1
131 particle%iboundary(3) = 1
138 particle%idomain(3) = 2
139 particle%iboundary(3) = 4
151 particle%idomain(3) = 3
152 particle%iboundary(3) = 4
163 particle%idomain(3) = 1
164 particle%iboundary(3) = 3
168 particle%idomain(3) = 4
169 particle%iboundary(3) = 3
178 inface = npolyverts + 2
181 inface = npolyverts + 3
184 if (inface .eq. -1)
then
185 particle%iboundary(2) = 0
186 else if (inface .eq. 0)
then
187 particle%iboundary(2) = 0
189 if ((inface .ge. 1) .and. (inface .le. 4))
then
191 inface = inface + cell%irvOrigin - 1
192 if (inface .gt. 4) inface = inface - 4
193 inface = cell%irectvert(inface) + infaceoff
194 if (inface .lt. 1) inface = inface + npolyverts
196 particle%iboundary(2) = inface
206 real(DP),
intent(in) :: tmax
208 double precision :: xOrigin, yOrigin, zOrigin, sinrot, cosrot
210 select type (cell => this%cell)
213 call this%check(particle, cell%defn, tmax)
214 if (.not. particle%advancing)
return
218 xorigin = cell%xOrigin
219 yorigin = cell%yOrigin
220 zorigin = cell%zOrigin
223 call particle%transform(xorigin, yorigin, zorigin, &
227 call this%track(particle, 2, tmax)
230 call particle%transform(xorigin, yorigin, zorigin, &
231 sinrot, cosrot, invert=.true.)
232 call particle%reset_transform()
243 real(DP) :: dx, dy, dz, areax, areay, areaz
244 real(DP) :: dxprel, dyprel
245 integer(I4B) :: isc, npolyverts, m1, m2
246 real(DP) :: qextl1, qextl2, qintl1, qintl2
247 real(DP) :: factor, term
249 select type (cell => this%cell)
251 factor =
done / cell%defn%retfactor
252 factor = factor / cell%defn%porosity
253 npolyverts = cell%defn%npolyverts
255 isc = particle%idomain(3)
263 dxprel = particle%x / dx
264 dyprel = particle%y / dy
266 if (dyprel .ge. 5d-1)
then
267 if (dxprel .le. 5d-1)
then
273 if (dxprel .le. 5d-1)
then
280 subcell%isubcell = isc
281 particle%idomain(3) = isc
285 dz = cell%defn%top - &
290 qintl1 = cell%qintl(isc)
292 qintl2 = cell%qintl(isc + 1)
293 qextl1 = cell%qextl1(isc)
294 qextl2 = cell%qextl2(isc)
299 subcell%sinrot =
dzero
300 subcell%cosrot =
done
301 subcell%zOrigin =
dzero
306 term = factor / areax
307 subcell%vx1 = qintl1 * term
308 subcell%vx2 = -qextl2 * term
309 term = factor / areay
310 subcell%vy1 = -qintl2 * term
311 subcell%vy2 = -qextl1 * term
314 subcell%yOrigin =
dzero
315 term = factor / areax
316 subcell%vx1 = -qintl2 * term
317 subcell%vx2 = -qextl1 * term
318 term = factor / areay
319 subcell%vy1 = qextl2 * term
320 subcell%vy2 = -qintl1 * term
322 subcell%xOrigin =
dzero
323 subcell%yOrigin =
dzero
324 term = factor / areax
325 subcell%vx1 = qextl2 * term
326 subcell%vx2 = -qintl1 * term
327 term = factor / areay
328 subcell%vy1 = qextl1 * term
329 subcell%vy2 = qintl2 * term
331 subcell%xOrigin =
dzero
333 term = factor / areax
334 subcell%vx1 = qextl1 * term
335 subcell%vx2 = qintl2 * term
336 term = factor / areay
337 subcell%vy1 = qintl1 * term
338 subcell%vy2 = -qextl2 * term
342 term = factor / areaz
343 subcell%vz1 = 2.5d-1 * cell%defn%faceflow(m1) * term
344 subcell%vz2 = -2.5d-1 * cell%defn%faceflow(m2) * term
subroutine, public create_cell_rect_quad(cell)
Create a new rectangular-quad cell.
This module contains simulation constants.
real(dp), parameter dzero
real constant zero
real(dp), parameter done
real constant 1
subroutine pstop(status, message)
Stop the program, optionally specifying an error status code.
This module defines variable data types.
procedure subroutine, public create_method_cell_quad(method)
Create a new Pollock quad-refined cell method.
subroutine load_mcpq(this, particle, next_level, submethod)
Load subcell into tracking method.
subroutine pass_mcpq(this, particle)
Pass particle to next subcell if there is one, or to the cell face.
subroutine load_subcell(this, particle, subcell)
Load the rectangular subcell from the rectangular cell.
subroutine apply_mcpq(this, particle, tmax)
Solve the quad-rectangular cell via Pollock's method.
Particle tracking strategies.
Subcell-level tracking methods.
type(methodsubcellpollocktype), pointer, public method_subcell_plck
subroutine, public create_subcell_rect(subcell)
Create a new rectangular subcell.
Base grid cell definition.
Base type for particle tracking methods.
Particle tracked by the PRT model.