Improve block prolongation and add support for 3D.
MESH STRUCTURE, REFINEMENT - subroutine prolong_block() has been completely rewritten; now it supports 2D and 3D boxes, and the calculation of bounds for the expanded array is automated now
This commit is contained in:
parent
1fdf2b72ae
commit
671985874f
112
src/mesh.F90
112
src/mesh.F90
@ -789,76 +789,96 @@ module mesh
|
|||||||
!
|
!
|
||||||
subroutine prolong_block(pblock)
|
subroutine prolong_block(pblock)
|
||||||
|
|
||||||
use blocks , only : block_meta, block_data, nv => nvars
|
use blocks , only : block_meta, block_data, nvars, nchild
|
||||||
use config , only : in, jn, kn, im, jm, km, ng
|
use config , only : ng, in, jn, kn, im, jm, km
|
||||||
use interpolation, only : expand
|
use interpolation, only : expand
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
! input arguments
|
! input arguments
|
||||||
!
|
!
|
||||||
type(block_meta), pointer :: pblock, pchild
|
type(block_meta), pointer, intent(inout) :: pblock
|
||||||
|
|
||||||
! local variables
|
! local variables
|
||||||
!
|
!
|
||||||
integer :: q, dm(3), fm(3), il, iu, jl, ju, k
|
integer :: q, p
|
||||||
|
integer :: il, iu, jl, ju, kl, ku
|
||||||
|
integer :: is, js, ks
|
||||||
|
|
||||||
! local arrays
|
! local arrays
|
||||||
!
|
!
|
||||||
real, dimension(nv,2*im,2*jm,2*km) :: u
|
integer, dimension(3) :: dm, fm
|
||||||
|
|
||||||
|
! local allocatable arrays
|
||||||
|
!
|
||||||
|
real, dimension(:,:,:,:), allocatable :: u
|
||||||
|
|
||||||
|
! local pointers
|
||||||
|
!
|
||||||
|
type(block_meta), pointer :: pchild
|
||||||
|
|
||||||
!-------------------------------------------------------------------------------
|
!-------------------------------------------------------------------------------
|
||||||
!
|
!
|
||||||
dm(1) = im
|
! prepare dimensions
|
||||||
dm(2) = jm
|
!
|
||||||
dm(3) = km
|
dm(:) = (/ im, jm, km /)
|
||||||
fm(:) = 2 * (dm(:) - ng)
|
fm(:) = 2 * (dm(:) - ng)
|
||||||
if (km .eq. 1) &
|
#if NDIMS == 2
|
||||||
fm(3) = 1
|
fm(3) = 1
|
||||||
|
ks = 1
|
||||||
|
kl = 1
|
||||||
|
ku = 1
|
||||||
|
#endif /* NDIMS == 2 */
|
||||||
|
|
||||||
! first expand variables
|
! allocate array to the product of expansion
|
||||||
!
|
!
|
||||||
do q = 1, nv
|
allocate(u(nvars,2*im,2*jm,2*km))
|
||||||
call expand(dm,fm,ng,pblock%data%u(q,:,:,:),u(q,:,:,:),'t','t','t')
|
|
||||||
end do
|
|
||||||
|
|
||||||
! fill values of children
|
! expand all variables and place them in the array u
|
||||||
!
|
!
|
||||||
il = 1
|
do q = 1, nvars
|
||||||
iu = il + im - 1
|
call expand(dm, fm, ng, pblock%data%u(q,:,:,:), u(q,:,:,:), 't', 't', 't')
|
||||||
jl = 1
|
|
||||||
ju = jl + jm - 1
|
|
||||||
pchild => pblock%child(1)%ptr
|
|
||||||
do k = 1, km
|
|
||||||
pchild%data%u(:,:,:,k) = u(:,il:iu,jl:ju,k)
|
|
||||||
end do
|
end do
|
||||||
|
|
||||||
il = in + 1
|
! iterate over all children
|
||||||
iu = il + im - 1
|
!
|
||||||
jl = 1
|
do p = 1, nchild
|
||||||
ju = jl + jm - 1
|
|
||||||
pchild => pblock%child(2)%ptr
|
! assign pointer to the current child
|
||||||
do k = 1, km
|
!
|
||||||
pchild%data%u(:,:,:,k) = u(:,il:iu,jl:ju,k)
|
pchild => pblock%child(p)%ptr
|
||||||
|
|
||||||
|
! calculate the position of child in the parent block
|
||||||
|
!
|
||||||
|
is = mod((p - 1) ,2)
|
||||||
|
js = mod((p - 1) / 2,2)
|
||||||
|
#if NDIMS == 3
|
||||||
|
ks = mod((p - 1) / 4,2)
|
||||||
|
#endif /* NDIMS == 3 */
|
||||||
|
|
||||||
|
! calculate indices of the current child subdomain
|
||||||
|
!
|
||||||
|
il = 1 + is * in
|
||||||
|
jl = 1 + js * jn
|
||||||
|
#if NDIMS == 3
|
||||||
|
kl = 1 + ks * kn
|
||||||
|
#endif /* NDIMS == 3 */
|
||||||
|
|
||||||
|
iu = il + im - 1
|
||||||
|
ju = jl + jm - 1
|
||||||
|
#if NDIMS == 3
|
||||||
|
ku = kl + km - 1
|
||||||
|
#endif /* NDIMS == 3 */
|
||||||
|
|
||||||
|
! copy data to the current child
|
||||||
|
!
|
||||||
|
pchild%data%u(1:nvars,1:im,1:jm,1:km) = u(1:nvars,il:iu,jl:ju,kl:ku)
|
||||||
|
|
||||||
end do
|
end do
|
||||||
|
|
||||||
il = 1
|
! deallocate local arrays
|
||||||
iu = il + im - 1
|
!
|
||||||
jl = in + 1
|
if (allocated(u)) deallocate(u)
|
||||||
ju = jl + jm - 1
|
|
||||||
pchild => pblock%child(3)%ptr
|
|
||||||
do k = 1, km
|
|
||||||
pchild%data%u(:,:,:,k) = u(:,il:iu,jl:ju,k)
|
|
||||||
end do
|
|
||||||
|
|
||||||
il = in + 1
|
|
||||||
iu = il + im - 1
|
|
||||||
jl = in + 1
|
|
||||||
ju = jl + jm - 1
|
|
||||||
pchild => pblock%child(4)%ptr
|
|
||||||
do k = 1, km
|
|
||||||
pchild%data%u(:,:,:,k) = u(:,il:iu,jl:ju,k)
|
|
||||||
end do
|
|
||||||
|
|
||||||
!-------------------------------------------------------------------------------
|
!-------------------------------------------------------------------------------
|
||||||
!
|
!
|
||||||
|
Loading…
x
Reference in New Issue
Block a user