Rewrite indices in subroutine bnd_copy().

BOUNDARY CONDITIONS

 - rewrite index calculation in subroutine bnd_copy();
This commit is contained in:
Grzegorz Kowal 2010-03-30 21:53:07 -03:00
parent 03f00b65d5
commit cc4e6e50bb

View File

@ -368,35 +368,31 @@ module boundaries
! !
subroutine bnd_copy(pdata, u, idir, iside, iface) subroutine bnd_copy(pdata, u, idir, iside, iface)
use blocks, only : block_data, nvr, nfl, nqt use blocks, only : block_data, nfl, nqt
#ifdef MHD #ifdef MHD
use blocks, only : ibx, iby, ibz use blocks, only : ibx, iby, ibz
#endif /* MHD */ #endif /* MHD */
use config, only : im, ib, ibl, ibu, ie, iel, ieu & use config, only : im, ib, ibl, ibu, ie, iel, ieu &
, jm, jb, jbl, jbu, je, jel, jeu & , jm, jb, jbl, jbu, je, jel, jeu &
, km, kb, kbl, kbu, ke, kel, keu, ng , km, kb, kbl, kbu, ke, kel, keu
use error , only : print_warning use error , only : print_error
implicit none implicit none
! arguments ! arguments
! !
type(block_data), pointer , intent(inout) :: pdata type(block_data), pointer , intent(inout) :: pdata
real , dimension(nqt,im,jm,km), intent(in) :: u
integer , intent(in) :: idir, iside, iface real , dimension(nqt,im,jm,km), intent(in) :: u
integer , intent(in) :: idir, iside, iface
! local variables ! local variables
! !
integer :: ii
integer :: il, iu, jl, ju, kl, ku integer :: il, iu, jl, ju, kl, ku
integer :: is, it, js, jt, ks, kt integer :: is, it, js, jt, ks, kt
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
! calcuate the flag determinig the side of boundary to update
!
ii = 100 * idir + 10 * iside
! prepare common indices ! prepare common indices
! !
il = 1 il = 1
@ -413,39 +409,62 @@ module boundaries
ks = 1 ks = 1
kt = km kt = km
! prepare indices ! prepare source and destination boundary indices
! !
select case(ii) select case(idir)
case(110) case(1)
il = iel
iu = ie
it = ibl
case(120) if (iside .eq. 1) then
il = ib il = iel
iu = ibu iu = ie
is = ieu
case(210) is = 1
jl = jel it = ibl
ju = je else
jt = jbl il = ib
iu = ibu
case(220) is = ieu
jl = jb it = im
ju = jbu end if
js = jeu
case(310) case(2)
kl = kel
ku = ke
kt = kbl
case(320) if (iside .eq. 1) then
kl = kb jl = jel
ku = kbu ju = je
ks = keu
js = 1
jt = jbl
else
jl = jb
ju = jbu
js = jeu
jt = jm
end if
#if NDIMS == 3
case(3)
if (iside .eq. 1) then
kl = kel
ku = ke
ks = 1
kt = kbl
else
kl = kb
ku = kbu
ks = keu
kt = km
end if
#endif /* NDIMS == 3 */
case default
call print_error("boundaries::bnd_copy", "Direction unsupported!")
end select end select
@ -462,20 +481,20 @@ module boundaries
#ifdef FLUXCT #ifdef FLUXCT
! perform update of the staggered magnetic field components ! perform update of the staggered magnetic field components
! !
if (it .eq. ng) then if (it .eq. ibl) then
pdata%u(ibx,is:it-1,js:jt,ks:kt) = u(ibx,il:iu-1,jl:ju,kl:ku) pdata%u(ibx,is:it-1,js:jt,ks:kt) = u(ibx,il:iu-1,jl:ju,kl:ku)
else else
pdata%u(ibx,is:it ,js:jt,ks:kt) = u(ibx,il:iu ,jl:ju,kl:ku) pdata%u(ibx,is:it ,js:jt,ks:kt) = u(ibx,il:iu ,jl:ju,kl:ku)
end if end if
if (jt .eq. ng) then if (jt .eq. jbl) then
pdata%u(iby,is:it,js:jt-1,ks:kt) = u(iby,il:iu,jl:ju-1,kl:ku) pdata%u(iby,is:it,js:jt-1,ks:kt) = u(iby,il:iu,jl:ju-1,kl:ku)
else else
pdata%u(iby,is:it,js:jt ,ks:kt) = u(iby,il:iu,jl:ju ,kl:ku) pdata%u(iby,is:it,js:jt ,ks:kt) = u(iby,il:iu,jl:ju ,kl:ku)
end if end if
#if NDIMS == 3 #if NDIMS == 3
if (kt .eq. ng) then if (kt .eq. kbl) then
pdata%u(ibz,is:it,js:jt,ks:kt-1) = u(ibz,il:iu,jl:ju,kl:ku-1) pdata%u(ibz,is:it,js:jt,ks:kt-1) = u(ibz,il:iu,jl:ju,kl:ku-1)
else else
pdata%u(ibz,is:it,js:jt,ks:kt ) = u(ibz,il:iu,jl:ju,kl:ku ) pdata%u(ibz,is:it,js:jt,ks:kt ) = u(ibz,il:iu,jl:ju,kl:ku )