Rewrite and add support for 3D to subroutine derefine_block().
This commit is contained in:
parent
dd8af20c86
commit
463be7ad77
@ -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
|
|
||||||
!
|
!
|
||||||
!-------------------------------------------------------------------------------
|
!-------------------------------------------------------------------------------
|
||||||
!
|
!
|
||||||
|
Loading…
x
Reference in New Issue
Block a user