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:
Grzegorz Kowal 2014-07-22 03:25:06 -03:00
parent 75653bf226
commit 1f7e65b359

View File

@ -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