BLOCKS: Correct neighbor pointers in refine_block() for 2D case.

If we refine the lowest block, which neighbor fields point to itself,
we should point them to the proper children. Include this case in
refine_block() for 2D.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2014-07-07 16:48:44 -03:00
parent 6ae36d29d9
commit 09ddc6cb00

View File

@ -1579,84 +1579,136 @@ module blocks
! pointers of neighbors
!
#if NDIMS == 2
! child (1,1)
pchild => pmeta%child(1)%ptr
! X
if (associated(pmeta%edges(1,1,1)%ptr)) then
pneigh => pmeta%edges(1,1,1)%ptr
pchild%edges(1,1,1)%ptr => pmeta%edges(1,1,1)%ptr
pchild%edges(2,1,1)%ptr => pmeta%edges(1,1,1)%ptr
pneigh%edges(1,2,1)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(2,2,1)%ptr => pchild
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
pneigh%edges(1,2,1)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(2,2,1)%ptr => pchild
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
pchild%edges(1,1,2)%ptr => pmeta%edges(1,1,2)%ptr
pchild%edges(1,2,2)%ptr => pmeta%edges(1,1,2)%ptr
pneigh%edges(2,1,2)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(2,2,2)%ptr => pchild
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
pneigh%edges(2,1,2)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(2,2,2)%ptr => pchild
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)
pchild => pmeta%child(2)%ptr
! X
if (associated(pmeta%edges(2,1,1)%ptr)) then
pneigh => pmeta%edges(2,1,1)%ptr
pchild%edges(1,1,1)%ptr => pmeta%edges(2,1,1)%ptr
pchild%edges(2,1,1)%ptr => pmeta%edges(2,1,1)%ptr
pneigh%edges(2,2,1)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(1,2,1)%ptr => pchild
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
pneigh%edges(2,2,1)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(1,2,1)%ptr => pchild
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
pchild%edges(2,1,2)%ptr => pmeta%edges(2,1,2)%ptr
pchild%edges(2,2,2)%ptr => pmeta%edges(2,1,2)%ptr
pneigh%edges(1,1,2)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(1,2,2)%ptr => pchild
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
pneigh%edges(1,1,2)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(1,2,2)%ptr => pchild
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
pchild%edges(1,2,1)%ptr => pmeta%edges(1,2,1)%ptr
pchild%edges(2,2,1)%ptr => pmeta%edges(1,2,1)%ptr
pneigh%edges(1,1,1)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(2,1,1)%ptr => pchild
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
pneigh%edges(1,1,1)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(2,1,1)%ptr => pchild
end if
end if
! Y
if (associated(pmeta%edges(1,2,2)%ptr)) then
pneigh => pmeta%edges(1,2,2)%ptr
pchild%edges(1,1,2)%ptr => pmeta%edges(1,2,2)%ptr
pchild%edges(1,2,2)%ptr => pmeta%edges(1,2,2)%ptr
pneigh%edges(2,2,2)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(2,1,2)%ptr => pchild
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
pneigh%edges(2,2,2)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(2,1,2)%ptr => pchild
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
pchild%edges(1,2,1)%ptr => pmeta%edges(2,2,1)%ptr
pchild%edges(2,2,1)%ptr => pmeta%edges(2,2,1)%ptr
pneigh%edges(2,1,1)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(1,1,1)%ptr => pchild
if (pneigh%id == pmeta%id) then
pchild%edges(1,1,1)%ptr => pmeta%child(2)%ptr
pchild%edges(2,1,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
pneigh%edges(2,1,1)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(1,1,1)%ptr => pchild
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
pchild%edges(2,1,2)%ptr => pmeta%edges(2,2,2)%ptr
pchild%edges(2,2,2)%ptr => pmeta%edges(2,2,2)%ptr
pneigh%edges(1,2,2)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(1,1,2)%ptr => pchild
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
pneigh%edges(1,2,2)%ptr => pchild
if (pneigh%level > pmeta%level) pneigh%edges(1,1,2)%ptr => pchild
end if
end if
#endif /* NDIMS == 2 */
@ -1664,76 +1716,132 @@ module blocks
! corners if they lay at larger level
!
#if NDIMS == 2
! child (1,1)
pchild => pmeta%child(1)%ptr
if (associated(pmeta%corners(1,1)%ptr)) then
pneigh => pmeta%corners(1,1)%ptr
pchild%corners(1,1)%ptr => pmeta%corners(1,1)%ptr
pneigh%corners(2,2)%ptr => pchild
if (pneigh%id == pmeta%id) then
pchild%corners(1,1)%ptr => pmeta%child(4)%ptr
else
pchild%corners(1,1)%ptr => pmeta%corners(1,1)%ptr
pneigh%corners(2,2)%ptr => pchild
end if
end if
if (associated(pmeta%edges(2,1,1)%ptr)) then
pneigh => pmeta%edges(2,1,1)%ptr
pchild%corners(2,1)%ptr => pmeta%edges(2,1,1)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(1,2)%ptr => pchild
if (pneigh%id == pmeta%id) then
pchild%corners(2,1)%ptr => pmeta%child(4)%ptr
else
pchild%corners(2,1)%ptr => pmeta%edges(2,1,1)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(1,2)%ptr => pchild
end if
endif
if (associated(pmeta%edges(1,2,2)%ptr)) then
pneigh => pmeta%edges(1,2,2)%ptr
pchild%corners(1,2)%ptr => pmeta%edges(1,2,2)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(2,1)%ptr => pchild
if (pneigh%id == pmeta%id) then
pchild%corners(2,1)%ptr => pmeta%child(4)%ptr
else
pchild%corners(1,2)%ptr => pmeta%edges(1,2,2)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(2,1)%ptr => pchild
end if
end if
pchild%corners(2,2)%ptr => pmeta%child(4)%ptr
! child (2,1)
pchild => pmeta%child(2)%ptr
if (associated(pmeta%edges(1,1,1)%ptr)) then
pneigh => pmeta%edges(1,1,1)%ptr
pchild%corners(1,1)%ptr => pmeta%edges(1,1,1)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(2,2)%ptr => pchild
if (pneigh%id == pmeta%id) then
pchild%corners(1,1)%ptr => pmeta%child(3)%ptr
else
pchild%corners(1,1)%ptr => pmeta%edges(1,1,1)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(2,2)%ptr => pchild
end if
end if
if (associated(pmeta%corners(2,1)%ptr)) then
pneigh => pmeta%corners(2,1)%ptr
pchild%corners(2,1)%ptr => pmeta%corners(2,1)%ptr
pneigh%corners(1,2)%ptr => pchild
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
pneigh%corners(1,2)%ptr => pchild
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
pchild%corners(2,2)%ptr => pmeta%edges(2,2,2)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(1,1)%ptr => pchild
if (pneigh%id == pmeta%id) then
pchild%corners(2,2)%ptr => pmeta%child(3)%ptr
else
pchild%corners(2,2)%ptr => pmeta%edges(2,2,2)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(1,1)%ptr => pchild
end if
end if
! child (1,2)
pchild => pmeta%child(3)%ptr
if (associated(pmeta%edges(1,1,2)%ptr)) then
pneigh => pmeta%edges(1,1,2)%ptr
pchild%corners(1,1)%ptr => pmeta%edges(1,1,2)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(2,2)%ptr => pchild
if (pneigh%id == pmeta%id) then
pchild%corners(1,1)%ptr => pmeta%child(2)%ptr
else
pchild%corners(1,1)%ptr => pmeta%edges(1,1,2)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(2,2)%ptr => pchild
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
pchild%corners(1,2)%ptr => pmeta%corners(1,2)%ptr
pneigh%corners(2,1)%ptr => pchild
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
pneigh%corners(2,1)%ptr => pchild
end if
end if
if (associated(pmeta%edges(2,2,1)%ptr)) then
pneigh => pmeta%edges(2,2,1)%ptr
pchild%corners(2,2)%ptr => pmeta%edges(2,2,1)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(1,1)%ptr => pchild
if (pneigh%id == pmeta%id) then
pchild%corners(2,2)%ptr => pmeta%child(2)%ptr
else
pchild%corners(2,2)%ptr => pmeta%edges(2,2,1)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(1,1)%ptr => pchild
end if
end if
! child (2,2)
pchild => pmeta%child(4)%ptr
pchild%corners(1,1)%ptr => pmeta%child(1)%ptr
if (associated(pmeta%edges(2,1,2)%ptr)) then
pneigh => pmeta%edges(2,1,2)%ptr
pchild%corners(2,1)%ptr => pmeta%edges(2,1,2)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(1,2)%ptr => pchild
if (pneigh%id == pmeta%id) then
pchild%corners(2,1)%ptr => pmeta%child(1)%ptr
else
pchild%corners(2,1)%ptr => pmeta%edges(2,1,2)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(1,2)%ptr => pchild
end if
end if
if (associated(pmeta%edges(1,2,1)%ptr)) then
pneigh => pmeta%edges(1,2,1)%ptr
pchild%corners(1,2)%ptr => pmeta%edges(1,2,1)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(2,1)%ptr => pchild
if (pneigh%id == pmeta%id) then
pchild%corners(1,2)%ptr => pmeta%child(1)%ptr
else
pchild%corners(1,2)%ptr => pmeta%edges(1,2,1)%ptr
if (pneigh%level > pmeta%level) pneigh%corners(2,1)%ptr => pchild
end if
end if
if (associated(pmeta%corners(2,2)%ptr)) then
pneigh => pmeta%corners(2,2)%ptr
pchild%corners(2,2)%ptr => pmeta%corners(2,2)%ptr
pneigh%corners(1,1)%ptr => pchild
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
pneigh%corners(1,1)%ptr => pchild
end if
end if
#endif /* NDIMS == 2 */