BLOCKS: Rewrite 2D neighbor pointers update in refine_block().
This update of 2D neighbor pointers iterates over corners instead of updating each neighbor pointer explicitely. It updates both, edge and corner neighbor pointers at once. Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
75653bf226
commit
1f7e65b359
314
src/blocks.F90
314
src/blocks.F90
@ -1581,253 +1581,117 @@ module blocks
|
|||||||
|
|
||||||
end do ! nchildren
|
end do ! nchildren
|
||||||
|
|
||||||
! update edge neighbor pointers of children
|
! update neighbor pointers of the parent block
|
||||||
!
|
!
|
||||||
#if NDIMS == 2
|
#if NDIMS == 2
|
||||||
! child (1,1)
|
do jp = 1, nsides
|
||||||
pchild => pmeta%child(1)%ptr
|
jr = 3 - jp
|
||||||
! X
|
do ip = 1, nsides
|
||||||
if (associated(pmeta%edges(1,1,1)%ptr)) then
|
ir = 3 - ip
|
||||||
pneigh => pmeta%edges(1,1,1)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%edges(1,1,1)%ptr => pmeta%child(3)%ptr
|
|
||||||
pchild%edges(2,1,1)%ptr => pmeta%child(3)%ptr
|
|
||||||
else
|
|
||||||
pchild%edges(1,1,1)%ptr => pmeta%edges(1,1,1)%ptr
|
|
||||||
pchild%edges(2,1,1)%ptr => pmeta%edges(1,1,1)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
pchild%edges(1,2,1)%ptr => pmeta%child(3)%ptr
|
|
||||||
pchild%edges(2,2,1)%ptr => pmeta%child(3)%ptr
|
|
||||||
! Y
|
|
||||||
if (associated(pmeta%edges(1,1,2)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(1,1,2)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%edges(1,1,2)%ptr => pmeta%child(2)%ptr
|
|
||||||
pchild%edges(1,2,2)%ptr => pmeta%child(2)%ptr
|
|
||||||
else
|
|
||||||
pchild%edges(1,1,2)%ptr => pmeta%edges(1,1,2)%ptr
|
|
||||||
pchild%edges(1,2,2)%ptr => pmeta%edges(1,1,2)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
pchild%edges(2,1,2)%ptr => pmeta%child(2)%ptr
|
|
||||||
pchild%edges(2,2,2)%ptr => pmeta%child(2)%ptr
|
|
||||||
|
|
||||||
! child (2,1)
|
! calculate the child index
|
||||||
pchild => pmeta%child(2)%ptr
|
|
||||||
! X
|
|
||||||
if (associated(pmeta%edges(2,1,1)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(2,1,1)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%edges(1,1,1)%ptr => pmeta%child(4)%ptr
|
|
||||||
pchild%edges(2,1,1)%ptr => pmeta%child(4)%ptr
|
|
||||||
else
|
|
||||||
pchild%edges(1,1,1)%ptr => pmeta%edges(2,1,1)%ptr
|
|
||||||
pchild%edges(2,1,1)%ptr => pmeta%edges(2,1,1)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
pchild%edges(1,2,1)%ptr => pmeta%child(4)%ptr
|
|
||||||
pchild%edges(2,2,1)%ptr => pmeta%child(4)%ptr
|
|
||||||
! Y
|
|
||||||
pchild%edges(1,1,2)%ptr => pmeta%child(1)%ptr
|
|
||||||
pchild%edges(1,2,2)%ptr => pmeta%child(1)%ptr
|
|
||||||
if (associated(pmeta%edges(2,1,2)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(2,1,2)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%edges(2,1,2)%ptr => pmeta%child(1)%ptr
|
|
||||||
pchild%edges(2,2,2)%ptr => pmeta%child(1)%ptr
|
|
||||||
else
|
|
||||||
pchild%edges(2,1,2)%ptr => pmeta%edges(2,1,2)%ptr
|
|
||||||
pchild%edges(2,2,2)%ptr => pmeta%edges(2,1,2)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
|
|
||||||
! child (1,2)
|
|
||||||
pchild => pmeta%child(3)%ptr
|
|
||||||
! X
|
|
||||||
pchild%edges(1,1,1)%ptr => pmeta%child(1)%ptr
|
|
||||||
pchild%edges(2,1,1)%ptr => pmeta%child(1)%ptr
|
|
||||||
if (associated(pmeta%edges(1,2,1)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(1,2,1)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%edges(1,2,1)%ptr => pmeta%child(1)%ptr
|
|
||||||
pchild%edges(2,2,1)%ptr => pmeta%child(1)%ptr
|
|
||||||
else
|
|
||||||
pchild%edges(1,2,1)%ptr => pmeta%edges(1,2,1)%ptr
|
|
||||||
pchild%edges(2,2,1)%ptr => pmeta%edges(1,2,1)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
! Y
|
|
||||||
if (associated(pmeta%edges(1,2,2)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(1,2,2)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%edges(1,1,2)%ptr => pmeta%child(4)%ptr
|
|
||||||
pchild%edges(1,2,2)%ptr => pmeta%child(4)%ptr
|
|
||||||
else
|
|
||||||
pchild%edges(1,1,2)%ptr => pmeta%edges(1,2,2)%ptr
|
|
||||||
pchild%edges(1,2,2)%ptr => pmeta%edges(1,2,2)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
pchild%edges(2,1,2)%ptr => pmeta%child(4)%ptr
|
|
||||||
pchild%edges(2,2,2)%ptr => pmeta%child(4)%ptr
|
|
||||||
|
|
||||||
! child (2,2)
|
|
||||||
pchild => pmeta%child(4)%ptr
|
|
||||||
! X
|
|
||||||
pchild%edges(1,1,1)%ptr => pmeta%child(2)%ptr
|
|
||||||
pchild%edges(2,1,1)%ptr => pmeta%child(2)%ptr
|
|
||||||
if (associated(pmeta%edges(2,2,1)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(2,2,1)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%edges(1,2,1)%ptr => pmeta%child(2)%ptr
|
|
||||||
pchild%edges(2,2,1)%ptr => pmeta%child(2)%ptr
|
|
||||||
else
|
|
||||||
pchild%edges(1,2,1)%ptr => pmeta%edges(2,2,1)%ptr
|
|
||||||
pchild%edges(2,2,1)%ptr => pmeta%edges(2,2,1)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
! Y
|
|
||||||
pchild%edges(1,1,2)%ptr => pmeta%child(3)%ptr
|
|
||||||
pchild%edges(1,2,2)%ptr => pmeta%child(3)%ptr
|
|
||||||
if (associated(pmeta%edges(2,2,2)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(2,2,2)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%edges(2,1,2)%ptr => pmeta%child(3)%ptr
|
|
||||||
pchild%edges(2,2,2)%ptr => pmeta%child(3)%ptr
|
|
||||||
else
|
|
||||||
pchild%edges(2,1,2)%ptr => pmeta%edges(2,2,2)%ptr
|
|
||||||
pchild%edges(2,2,2)%ptr => pmeta%edges(2,2,2)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
#endif /* NDIMS == 2 */
|
|
||||||
|
|
||||||
! update corner neighbor pointers of children, and corresponding neighbor
|
|
||||||
! corners if they lay at larger level
|
|
||||||
!
|
!
|
||||||
#if NDIMS == 2
|
p = 2 * (jp - 1) + ip
|
||||||
! child (1,1)
|
|
||||||
pchild => pmeta%child(1)%ptr
|
|
||||||
|
|
||||||
if (associated(pmeta%corners(1,1)%ptr)) then
|
! associate pchild with the proper child
|
||||||
pneigh => pmeta%corners(1,1)%ptr
|
!
|
||||||
if (pneigh%id == pmeta%id) then
|
pchild => pmeta%child(p)%ptr
|
||||||
pchild%corners(1,1)%ptr => pmeta%child(4)%ptr
|
|
||||||
else
|
|
||||||
pchild%corners(1,1)%ptr => pmeta%corners(1,1)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
if (associated(pmeta%edges(2,1,1)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(2,1,1)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%corners(2,1)%ptr => pmeta%child(4)%ptr
|
|
||||||
else
|
|
||||||
if (pneigh%level > pmeta%level) &
|
|
||||||
pchild%corners(2,1)%ptr => pmeta%edges(2,1,1)%ptr
|
|
||||||
end if
|
|
||||||
endif
|
|
||||||
if (associated(pmeta%edges(1,2,2)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(1,2,2)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%corners(1,2)%ptr => pmeta%child(4)%ptr
|
|
||||||
else
|
|
||||||
if (pneigh%level > pmeta%level) &
|
|
||||||
pchild%corners(1,2)%ptr => pmeta%edges(1,2,2)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
pchild%corners(2,2)%ptr => pmeta%child(4)%ptr
|
|
||||||
|
|
||||||
! child (2,1)
|
!--- update edge neighbor pointers ---
|
||||||
pchild => pmeta%child(2)%ptr
|
!
|
||||||
|
! update external edges
|
||||||
|
!
|
||||||
|
! along X-direction
|
||||||
|
!
|
||||||
|
pneigh => pmeta%edges(ip,jp,1)%ptr
|
||||||
|
if (associated(pneigh)) then
|
||||||
|
if (pneigh%id == pmeta%id) then
|
||||||
|
q = 2 * (jr - 1) + ip
|
||||||
|
pchild%edges(ip,jp,1)%ptr => pmeta%child(q)%ptr
|
||||||
|
pchild%edges(ir,jp,1)%ptr => pmeta%child(q)%ptr
|
||||||
|
else
|
||||||
|
pchild%edges(ip,jp,1)%ptr => pneigh
|
||||||
|
pchild%edges(ir,jp,1)%ptr => pneigh
|
||||||
|
end if
|
||||||
|
end if ! pneigh associated
|
||||||
|
|
||||||
if (associated(pmeta%edges(1,1,1)%ptr)) then
|
! along Y-direction
|
||||||
pneigh => pmeta%edges(1,1,1)%ptr
|
!
|
||||||
|
pneigh => pmeta%edges(ip,jp,2)%ptr
|
||||||
|
if (associated(pneigh)) then
|
||||||
if (pneigh%id == pmeta%id) then
|
if (pneigh%id == pmeta%id) then
|
||||||
pchild%corners(1,1)%ptr => pmeta%child(3)%ptr
|
q = 2 * (jp - 1) + ir
|
||||||
|
pchild%edges(ip,jp,2)%ptr => pmeta%child(q)%ptr
|
||||||
|
pchild%edges(ip,jr,2)%ptr => pmeta%child(q)%ptr
|
||||||
else
|
else
|
||||||
if (pneigh%level > pmeta%level) &
|
pchild%edges(ip,jp,2)%ptr => pneigh
|
||||||
pchild%corners(1,1)%ptr => pmeta%edges(1,1,1)%ptr
|
pchild%edges(ip,jr,2)%ptr => pneigh
|
||||||
end if
|
|
||||||
end if
|
|
||||||
if (associated(pmeta%corners(2,1)%ptr)) then
|
|
||||||
pneigh => pmeta%corners(2,1)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%corners(2,1)%ptr => pmeta%child(3)%ptr
|
|
||||||
else
|
|
||||||
pchild%corners(2,1)%ptr => pmeta%corners(2,1)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
pchild%corners(1,2)%ptr => pmeta%child(3)%ptr
|
|
||||||
if (associated(pmeta%edges(2,2,2)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(2,2,2)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%corners(2,2)%ptr => pmeta%child(3)%ptr
|
|
||||||
else
|
|
||||||
if (pneigh%level > pmeta%level) &
|
|
||||||
pchild%corners(2,2)%ptr => pmeta%edges(2,2,2)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
end if
|
||||||
|
end if ! pneigh associated
|
||||||
|
|
||||||
! child (1,2)
|
! update internal edges
|
||||||
pchild => pmeta%child(3)%ptr
|
!
|
||||||
|
! along X-direction
|
||||||
|
!
|
||||||
|
q = 2 * (jr - 1) + ip
|
||||||
|
pchild%edges(ip,jr,1)%ptr => pmeta%child(q)%ptr
|
||||||
|
pchild%edges(ir,jr,1)%ptr => pmeta%child(q)%ptr
|
||||||
|
|
||||||
if (associated(pmeta%edges(1,1,2)%ptr)) then
|
! along Y-direction
|
||||||
pneigh => pmeta%edges(1,1,2)%ptr
|
!
|
||||||
if (pneigh%id == pmeta%id) then
|
q = 2 * (jp - 1) + ir
|
||||||
pchild%corners(1,1)%ptr => pmeta%child(2)%ptr
|
pchild%edges(ir,jp,2)%ptr => pmeta%child(q)%ptr
|
||||||
else
|
pchild%edges(ir,jr,2)%ptr => pmeta%child(q)%ptr
|
||||||
if (pneigh%level > pmeta%level) &
|
|
||||||
pchild%corners(1,1)%ptr => pmeta%edges(1,1,2)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
pchild%corners(2,1)%ptr => pmeta%child(2)%ptr
|
|
||||||
if (associated(pmeta%corners(1,2)%ptr)) then
|
|
||||||
pneigh => pmeta%corners(1,2)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%corners(1,2)%ptr => pmeta%child(2)%ptr
|
|
||||||
else
|
|
||||||
pchild%corners(1,2)%ptr => pmeta%corners(1,2)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
if (associated(pmeta%edges(2,2,1)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(2,2,1)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%corners(2,2)%ptr => pmeta%child(2)%ptr
|
|
||||||
else
|
|
||||||
if (pneigh%level > pmeta%level) &
|
|
||||||
pchild%corners(2,2)%ptr => pmeta%edges(2,2,1)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
|
|
||||||
! child (2,2)
|
!--- update corner neighbor pointers ---
|
||||||
pchild => pmeta%child(4)%ptr
|
!
|
||||||
|
! calculate the index of opposite child
|
||||||
|
!
|
||||||
|
q = 2 * (jr - 1) + ir
|
||||||
|
|
||||||
pchild%corners(1,1)%ptr => pmeta%child(1)%ptr
|
! update corner located at the parent's one
|
||||||
if (associated(pmeta%edges(2,1,2)%ptr)) then
|
!
|
||||||
pneigh => pmeta%edges(2,1,2)%ptr
|
pneigh => pmeta%corners(ip,jp)%ptr
|
||||||
|
if (associated(pneigh)) then
|
||||||
if (pneigh%id == pmeta%id) then
|
if (pneigh%id == pmeta%id) then
|
||||||
pchild%corners(2,1)%ptr => pmeta%child(1)%ptr
|
pchild%corners(ip,jp)%ptr => pmeta%child(q)%ptr
|
||||||
|
else
|
||||||
|
pchild%corners(ip,jp)%ptr => pneigh
|
||||||
|
end if
|
||||||
|
end if ! pneigh associated
|
||||||
|
|
||||||
|
! update corner touching another child
|
||||||
|
!
|
||||||
|
pchild%corners(ir,jr)%ptr => pmeta%child(q)%ptr
|
||||||
|
|
||||||
|
! update corners laying on parent's edges
|
||||||
|
!
|
||||||
|
! along X-direction
|
||||||
|
!
|
||||||
|
pneigh => pmeta%edges(ir,jp,1)%ptr
|
||||||
|
if (associated(pneigh)) then
|
||||||
|
if (pneigh%id == pmeta%id) then
|
||||||
|
pchild%corners(ir,jp)%ptr => pmeta%child(q)%ptr
|
||||||
else
|
else
|
||||||
if (pneigh%level > pmeta%level) &
|
if (pneigh%level > pmeta%level) &
|
||||||
pchild%corners(2,1)%ptr => pmeta%edges(2,1,2)%ptr
|
pchild%corners(ir,jp)%ptr => pneigh
|
||||||
end if
|
end if
|
||||||
end if
|
end if ! pneigh associated
|
||||||
if (associated(pmeta%edges(1,2,1)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(1,2,1)%ptr
|
! along Y-direction
|
||||||
|
!
|
||||||
|
pneigh => pmeta%edges(ip,jr,2)%ptr
|
||||||
|
if (associated(pneigh)) then
|
||||||
if (pneigh%id == pmeta%id) then
|
if (pneigh%id == pmeta%id) then
|
||||||
pchild%corners(1,2)%ptr => pmeta%child(1)%ptr
|
pchild%corners(ip,jr)%ptr => pmeta%child(q)%ptr
|
||||||
else
|
else
|
||||||
if (pneigh%level > pmeta%level) &
|
if (pneigh%level > pmeta%level) &
|
||||||
pchild%corners(1,2)%ptr => pmeta%edges(1,2,1)%ptr
|
pchild%corners(ip,jr)%ptr => pneigh
|
||||||
end if
|
|
||||||
end if
|
|
||||||
if (associated(pmeta%corners(2,2)%ptr)) then
|
|
||||||
pneigh => pmeta%corners(2,2)%ptr
|
|
||||||
if (pneigh%id == pmeta%id) then
|
|
||||||
pchild%corners(2,2)%ptr => pmeta%child(1)%ptr
|
|
||||||
else
|
|
||||||
pchild%corners(2,2)%ptr => pmeta%corners(2,2)%ptr
|
|
||||||
end if
|
|
||||||
end if
|
end if
|
||||||
|
end if ! pneigh associated
|
||||||
|
|
||||||
|
end do ! ip = 1, nsides
|
||||||
|
end do ! jp = 1, nsides
|
||||||
#endif /* NDIMS == 2 */
|
#endif /* NDIMS == 2 */
|
||||||
|
|
||||||
! update neighbor's edge pointers
|
! update neighbor's edge pointers
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user