gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Rewrite subroutine restrict_block.

Browse Source 
MESH

 - subroutine restrict_block has been rewritten to use one big array for
   storage variables from all children and them restricting this array
   and putting resulted variables in a new data block;
This commit is contained in:
Grzegorz Kowal 2010-07-04 01:15:34 -03:00
parent c057d098de
commit 26e103ce86
1 changed files with 65 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

127
src/mesh.F90
View File

@ -928,11 +928,11 @@ module mesh
!
subroutine restrict_block(pblock)
use blocks , only : block_meta, nchild, nfl
use blocks , only : block_meta, nchild, nfl, nqt
#ifdef MHD
use blocks , only : ibx, iby, ibz
#endif /* MHD */
use config , only : ng, im, jm, km, ib, jb, kb
use config , only : ng, in, jn, kn, im, jm, km
use interpolation, only : shrink
implicit none
@ -944,16 +944,17 @@ module mesh
! local variables
!
integer :: i, j, k, q, p
integer :: il, iu, jl, ju, kl, ku, i1, i2, j1, j2, k1, k2
integer :: is, js, ks
integer :: ib, jb, kb, ie, je, ke
integer :: il, iu, jl, ju, kl, ku
! local arrays
!
integer, dimension(3) :: dm, fm, pm
integer, dimension(3) :: dm, pm, fm
! local allocatable arrays
!
real, dimension(:,:,:), allocatable :: u
real, dimension(:,:,:,:), allocatable :: u, w
! local pointers
!
@ -964,22 +965,23 @@ module mesh
! prepare dimensions
!
dm(:) = (/ im, jm, km /)
pm(:) = dm(:) / 2
fm(:) = (dm(:) - ng) / 2
pm(:) = dm(:) - ng
fm(:) = 2 * pm(:)
#if NDIMS == 2
pm(3) = 1
fm(3) = 1
kb = 1
ke = 1
ks = 0
kl = 1
ku = 1
k1 = 1
k2 = 1
k = 1
#endif /* NDIMS == 2 */
! allocate temporary array
! allocate temporary arrays
!
allocate(u(pm(1), pm(2), pm(3)))
allocate(u(nqt, fm(1), fm(2), fm(3)))
allocate(w(nqt, pm(1), pm(2), pm(3)))
! iterate over all children
!
@ -1001,87 +1003,88 @@ module mesh
! calculate the bounds of the input array indices
!
i1 = 1 + ng / 2 * is
j1 = 1 + ng / 2 * js
#if NDIMS == 3
k1 = 1 + ng / 2 * ks
#endif /* NDIMS == 3 */
ib = 1 + ng * is
jb = 1 + ng * js
#if NDIMS == 2
kb = 1 + ng * ks
#endif /* NDIMS == 2 */
i2 = i1 + fm(1) - 1
j2 = j1 + fm(2) - 1
#if NDIMS == 3
k2 = k1 + fm(3) - 1
#endif /* NDIMS == 3 */
ie = ib + pm(1) - 1
je = jb + pm(2) - 1
#if NDIMS == 2
ke = kb + pm(3) - 1
#endif /* NDIMS == 2 */
! calculate the bounds of the destination array indices
!
il = 1 + ng / 2 + is * fm(1)
jl = 1 + ng / 2 + js * fm(2)
#if NDIMS == 3
kl = 1 + ng / 2 + ks * fm(3)
#endif /* NDIMS == 3 */
il = 1 + pm(1) * is
jl = 1 + pm(2) * js
#if NDIMS == 2
kl = 1 + pm(3) * ks
#endif /* NDIMS == 2 */
iu = il + fm(1) - 1
ju = jl + fm(2) - 1
#if NDIMS == 3
ku = kl + fm(3) - 1
#endif /* NDIMS == 3 */
iu = il + pm(1) - 1
ju = jl + pm(2) - 1
#if NDIMS == 2
ku = kl + pm(3) - 1
#endif /* NDIMS == 2 */
! iterate over all quantities
! copy variables from the current child to the proper location of the array u
!
do q = 1, nfl
u(1:nqt,il:iu,jl:ju,kl:ku) = pchild%data%u(1:nqt,ib:ie,jb:je,kb:je)
! shrink the current child
end do
! iterate over all quantities and shrink them and substitute to the new block
!
call shrink(dm, pm, pchild%data%u(q,:,:,:), u(:,:,:), 'm', 'm', 'm')
do q = 1, nfl
call shrink(fm, pm, u(q,:,:,:), w(q,:,:,:), 'm', 'm', 'm')
end do
! fill the parent block
!
pblock%data%u(q,il:iu,jl:ju,kl:ku) = u(i1:i2,j1:j2,k1:k2)
end do
#ifdef MHD
#ifdef FIELDCD
! iterate over magnetic field components
!
do q = ibx, ibz
! shrink the current child
!
call shrink(dm, pm, pchild%data%u(q,:,:,:), u(:,:,:), 'm', 'm', 'm')
! fill the parent block
!
pblock%data%u(q,il:iu,jl:ju,kl:ku) = u(i1:i2,j1:j2,k1:k2)
end do
do q = ibx, ibz
call shrink(fm, pm, u(q,:,:,:), w(q,:,:,:), 'm', 'm', 'm')
end do
#endif /* FIELDCD */
#ifdef FLUXCT
! restrict the X component of magnetic field
!
call shrink(dm, pm, pchild%data%u(ibx,:,:,:), u(:,:,:), 'c', 'm', 'm')
pblock%data%u(ibx,il:iu,jl:ju,kl:ku) = u(i1:i2,j1:j2,k1:k2)
call shrink(fm, pm, u(ibx,:,:,:), w(ibx,:,:,:), 'c', 'm', 'm')
! restrict the Y component of magnetic field
!
call shrink(dm, pm, pchild%data%u(iby,:,:,:), u(:,:,:), 'm', 'c', 'm')
pblock%data%u(iby,il:iu,jl:ju,kl:ku) = u(i1:i2,j1:j2,k1:k2)
call shrink(fm, pm, u(iby,:,:,:), w(iby,:,:,:), 'm', 'c', 'm')
! restrict the Z component of magnetic field
!
call shrink(dm, pm, pchild%data%u(ibz,:,:,:), u(:,:,:), 'm', 'm', 'c')
pblock%data%u(ibz,il:iu,jl:ju,kl:ku) = u(i1:i2,j1:j2,k1:k2)
call shrink(fm, pm, u(ibz,:,:,:), w(ibz,:,:,:), 'm', 'm', 'c')
#endif /* FLUXCT */
#endif /* MHD */
end do
! calculate substitution indices
!
ib = ng / 2 + 1
jb = ng / 2 + 1
kb = ng / 2 + 1
ie = ib + in + ng - 1
je = jb + jn + ng - 1
ke = kb + kn + ng - 1
#if NDIMS == 2
kb = 1
ke = 1
#endif /* NDIMS == 2 */
! deallocate temporary array
! substitute shrinked variables to the new data block
!
pblock%data%u(1:nqt,ib:ie,jb:je,kb:ke) = w(1:nqt,:,:,:)
! deallocate temporary arrays
!
deallocate(u)
deallocate(w)
!
!-------------------------------------------------------------------------------
!