Rewrite and add support for 3D to subroutine derefine_block().

This commit is contained in:
Grzegorz Kowal 2009-09-29 17:19:26 -03:00
parent dd8af20c86
commit 463be7ad77

View File

@ -1216,73 +1216,70 @@ module blocks
! !
integer :: i, j, k, l, p integer :: i, j, k, l, p
! pointers ! local arrays
!
integer, dimension(ndims, nsides, nfaces) :: arr
! local pointers
! !
type(block_meta), pointer :: pchild, pneigh type(block_meta), pointer :: pchild, pneigh
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
! update parent neighbor fields from the children ! prepare reference array
! !
pchild => pblock%child(1)%ptr
pblock%neigh(1,1,1)%ptr => pchild%neigh(1,1,1)%ptr
pblock%neigh(2,1,1)%ptr => pchild%neigh(2,1,1)%ptr
#if NDIMS == 3 #if NDIMS == 3
pblock%neigh(3,1,1)%ptr => pchild%neigh(3,1,1)%ptr arr(1,1,:) = (/ 1, 3, 5, 7 /)
#endif /* NDIMS == 3 */ arr(1,2,:) = (/ 2, 4, 6, 8 /)
pchild => pblock%child(2)%ptr arr(2,1,:) = (/ 1, 2, 5, 6 /)
pblock%neigh(1,2,1)%ptr => pchild%neigh(1,2,1)%ptr arr(2,2,:) = (/ 3, 4, 7, 8 /)
pblock%neigh(2,1,2)%ptr => pchild%neigh(2,1,2)%ptr arr(3,1,:) = (/ 1, 2, 3, 4 /)
#if NDIMS == 3 arr(3,2,:) = (/ 5, 6, 7, 8 /)
pblock%neigh(3,1,2)%ptr => pchild%neigh(3,1,2)%ptr #else /* NDIMS == 3 */
#endif /* NDIMS == 3 */ arr(1,1,:) = (/ 1, 3 /)
pchild => pblock%child(3)%ptr arr(1,2,:) = (/ 2, 4 /)
pblock%neigh(1,1,2)%ptr => pchild%neigh(1,1,2)%ptr arr(2,1,:) = (/ 1, 2 /)
pblock%neigh(2,2,1)%ptr => pchild%neigh(2,2,1)%ptr arr(2,2,:) = (/ 3, 4 /)
#if NDIMS == 3
pblock%neigh(3,1,3)%ptr => pchild%neigh(3,1,3)%ptr
#endif /* NDIMS == 3 */
pchild => pblock%child(4)%ptr
pblock%neigh(1,2,2)%ptr => pchild%neigh(1,2,2)%ptr
pblock%neigh(2,2,2)%ptr => pchild%neigh(2,2,2)%ptr
#if NDIMS == 3
pblock%neigh(3,1,4)%ptr => pchild%neigh(3,1,4)%ptr
#endif /* NDIMS == 3 */
#if NDIMS == 3
pchild => pblock%child(5)%ptr
pblock%neigh(1,1,3)%ptr => pchild%neigh(1,1,3)%ptr
pblock%neigh(2,1,3)%ptr => pchild%neigh(2,1,3)%ptr
pblock%neigh(3,2,1)%ptr => pchild%neigh(3,2,1)%ptr
pchild => pblock%child(6)%ptr
pblock%neigh(1,2,1)%ptr => pchild%neigh(1,2,1)%ptr
pblock%neigh(2,1,2)%ptr => pchild%neigh(2,1,2)%ptr
pblock%neigh(3,2,2)%ptr => pchild%neigh(3,2,2)%ptr
pchild => pblock%child(7)%ptr
pblock%neigh(1,1,2)%ptr => pchild%neigh(1,1,2)%ptr
pblock%neigh(2,2,1)%ptr => pchild%neigh(2,2,1)%ptr
pblock%neigh(3,2,3)%ptr => pchild%neigh(3,2,3)%ptr
pchild => pblock%child(8)%ptr
pblock%neigh(1,2,2)%ptr => pchild%neigh(1,2,2)%ptr
pblock%neigh(2,2,2)%ptr => pchild%neigh(2,2,2)%ptr
pblock%neigh(3,2,4)%ptr => pchild%neigh(3,2,4)%ptr
#endif /* NDIMS == 3 */ #endif /* NDIMS == 3 */
! update the neighbor fields of neighbors ! iterate over all boundaries of the parent block
! !
do i = 1, ndims do i = 1, ndims
do j = 1, nsides do j = 1, nsides
do k = 1, nfaces do k = 1, nfaces
pneigh => pblock%neigh(i,j,k)%ptr
! calculate the right child number
!
p = arr(i,j,k)
! assign the pointer to the current neighbor
!
pneigh => pblock%child(p)%ptr%neigh(i,j,k)%ptr
! assign the right neighbor to the current neighbor pointer
!
pblock%neigh(i,j,k)%ptr => pneigh
! update the neighbor fields of neighbors
!
if (associated(pneigh)) then if (associated(pneigh)) then
l = 3 - j l = 3 - j
do p = 1, nfaces do p = 1, nfaces
pneigh%neigh(i,l,p)%ptr => pblock pneigh%neigh(i,l,p)%ptr => pblock
end do end do
end if end if
end do end do
end do end do
end do end do
! deallocate child blocks
!
do p = 1, nchild
call metablock_unsetleaf(pblock%child(p)%ptr)
call deallocate_metablock(pblock%child(p)%ptr)
end do
! set the leaf flag of parent block ! set the leaf flag of parent block
! !
call metablock_setleaf(pblock) call metablock_setleaf(pblock)
@ -1290,13 +1287,6 @@ module blocks
! reset the refinement flag of the parent block ! reset the refinement flag of the parent block
! !
pblock%refine = 0 pblock%refine = 0
! deallocate child blocks
!
do p = 1, nchild
call metablock_unsetleaf(pblock%child(p)%ptr)
call deallocate_metablock(pblock%child(p)%ptr)
end do
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !