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

Merge branch 'master' into reconnection

Browse Source
This commit is contained in:
Grzegorz Kowal 2014-01-25 16:41:35 -02:00
commit 23fe63639a
9 changed files with 2907 additions and 1706 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3974
src/blocks.F90
View File

File diff suppressed because it is too large Load Diff

379
src/boundaries.F90
View File

@ -460,7 +460,7 @@ module boundaries
! check if the block and neighbor belong to the same process, if so, update ! check if the block and neighbor belong to the same process, if so, update
! fluxes directly ! fluxes directly
! !
if (pmeta%cpu == nproc .and. pneigh%cpu == nproc) then if (pmeta%process == nproc .and. pneigh%process == nproc) then
#endif /* MPI */ #endif /* MPI */
! update directional flux from the neighbor ! update directional flux from the neighbor
@ -523,8 +523,8 @@ module boundaries
! increase the counter for the number of blocks to exchange ! increase the counter for the number of blocks to exchange
! !
block_counter(idir,pmeta%cpu,pneigh%cpu) = & block_counter(idir,pmeta%process,pneigh%process) = &
block_counter(idir,pmeta%cpu,pneigh%cpu) + 1 block_counter(idir,pmeta%process,pneigh%process) + 1
! allocate a new info object ! allocate a new info object
! !
@ -546,17 +546,17 @@ module boundaries
! check if the list is empty ! check if the list is empty
! !
if (associated(block_array(idir,pmeta%cpu,pneigh%cpu)%ptr))& if (associated(block_array(idir,pmeta%process,pneigh%process)%ptr)) then
then
! if it is, associate the newly created block with it ! if it is, associate the newly created block with it
! !
pinfo%prev => block_array(idir,pmeta%cpu,pneigh%cpu)%ptr pinfo%prev => &
block_array(idir,pmeta%process,pneigh%process)%ptr
end if ! %ptr associated end if ! %ptr associated
! point the list to the newly created block ! point the list to the newly created block
! !
block_array(idir,pmeta%cpu,pneigh%cpu)%ptr => pinfo block_array(idir,pmeta%process,pneigh%process)%ptr => pinfo
end if ! pmeta and pneigh on local process end if ! pmeta and pneigh on local process
#endif /* MPI */ #endif /* MPI */
@ -970,30 +970,37 @@ module boundaries
! !
if (pmeta%leaf .and. pmeta%level == ilev) then if (pmeta%leaf .and. pmeta%level == ilev) then
! process only if this block is marked for update
!
if (pmeta%update) then
#ifdef MPI #ifdef MPI
! check if the current block belongs to the local process ! check if the current block belongs to the local process
! !
if (pmeta%cpu == nproc) then if (pmeta%process == nproc) then
#endif /* MPI */ #endif /* MPI */
! iterate over all neighbors ! iterate over all neighbors
! !
do iside = 1, nsides do iside = 1, nsides
! assign a neighbor pointer to the current neighbor ! assign a neighbor pointer to the current neighbor
! !
pneigh => pmeta%neigh(idir,iside,1)%ptr pneigh => pmeta%neigh(idir,iside,1)%ptr
! make sure that the neighbor is not associated, then apply specific boundaries ! make sure that the neighbor is not associated, then apply specific boundaries
! !
if (.not. associated(pneigh)) & if (.not. associated(pneigh)) &
call boundary_specific(pmeta%data, idir, iside) call boundary_specific(pmeta%data, idir, iside)
end do ! sides end do ! sides
#ifdef MPI #ifdef MPI
end if ! block belong to the local process end if ! block belong to the local process
#endif /* MPI */ #endif /* MPI */
end if ! pmeta is marked for update
end if ! leaf end if ! leaf
! assign the pointer to the next block on the list ! assign the pointer to the next block on the list
@ -1137,96 +1144,104 @@ module boundaries
! !
if (pneigh%level == pmeta%level) then if (pneigh%level == pmeta%level) then
! process only if this block and its neighbor are marked for update
!
if (pmeta%update .and. pneigh%update) then
! copy blocks only for the first face ! copy blocks only for the first face
! !
if (iface == 1) then if (iface == 1) then
#ifdef MPI #ifdef MPI
! check if the current meta block and its neighbor belong to the same process ! check if the current meta block and its neighbor belong to the same process
! !
if (pmeta%cpu == pneigh%cpu) then if (pmeta%process == pneigh%process) then
! check if the current meta block belongs to the current process ! check if the current meta block belongs to the current process
! !
if (pmeta%cpu == nproc) then if (pmeta%process == nproc) then
#endif /* MPI */ #endif /* MPI */
! assign a pointer to the data structure of the current block ! assign a pointer to the data structure of the current block
! !
pdata => pmeta%data pdata => pmeta%data
! update boundaries of the current block ! update boundaries of the current block
! !
select case(idir) select case(idir)
case(1) case(1)
if (iside == 1) then if (iside == 1) then
call boundary_copy(pdata & call boundary_copy(pdata &
, pneigh%data%u(:,iel:ie,:,:), idir, iside) , pneigh%data%u(:,iel:ie,:,:), idir, iside)
else else
call boundary_copy(pdata & call boundary_copy(pdata &
, pneigh%data%u(:,ib:ibu,:,:), idir, iside) , pneigh%data%u(:,ib:ibu,:,:), idir, iside)
end if end if
case(2) case(2)
if (iside == 1) then if (iside == 1) then
call boundary_copy(pdata & call boundary_copy(pdata &
, pneigh%data%u(:,:,jel:je,:), idir, iside) , pneigh%data%u(:,:,jel:je,:), idir, iside)
else else
call boundary_copy(pdata & call boundary_copy(pdata &
, pneigh%data%u(:,:,jb:jbu,:), idir, iside) , pneigh%data%u(:,:,jb:jbu,:), idir, iside)
end if end if
#if NDIMS == 3 #if NDIMS == 3
case(3) case(3)
if (iside == 1) then if (iside == 1) then
call boundary_copy(pdata & call boundary_copy(pdata &
, pneigh%data%u(:,:,:,kel:ke), idir, iside) , pneigh%data%u(:,:,:,kel:ke), idir, iside)
else else
call boundary_copy(pdata & call boundary_copy(pdata &
, pneigh%data%u(:,:,:,kb:kbu), idir, iside) , pneigh%data%u(:,:,:,kb:kbu), idir, iside)
end if end if
#endif /* NDIMS == 3 */ #endif /* NDIMS == 3 */
end select end select
#ifdef MPI #ifdef MPI
end if ! pmeta on the current process end if ! pmeta on the current process
else ! block and neighbor belong to different processes else ! block and neighbor belong to different processes
! increase the counter for number of blocks to exchange ! increase the counter for number of blocks to exchange
! !
block_counter(pmeta%cpu,pneigh%cpu) = & block_counter(pmeta%process,pneigh%process) = &
block_counter(pmeta%cpu,pneigh%cpu) + 1 block_counter(pmeta%process,pneigh%process) + 1
! allocate a new info object ! allocate a new info object
! !
allocate(pinfo) allocate(pinfo)
! fill out its fields ! fill out its fields
! !
pinfo%block => pmeta pinfo%block => pmeta
pinfo%neigh => pneigh pinfo%neigh => pneigh
pinfo%direction = idir pinfo%direction = idir
pinfo%side = iside pinfo%side = iside
pinfo%face = iface pinfo%face = iface
pinfo%level_difference = pmeta%level - pneigh%level pinfo%level_difference = pmeta%level - pneigh%level
! nullify pointer fields ! nullify pointer fields
! !
nullify(pinfo%prev) nullify(pinfo%prev)
nullify(pinfo%next) nullify(pinfo%next)
! if the list is not empty append the newly created block ! if the list is not empty append the newly created block
! !
if (associated(block_array(pmeta%cpu,pneigh%cpu)%ptr)) & if (associated(block_array(pmeta%process &
pinfo%prev => block_array(pmeta%cpu,pneigh%cpu)%ptr ,pneigh%process)%ptr)) &
pinfo%prev => block_array(pmeta%process &
,pneigh%process)%ptr
! point the list to the newly created block ! point the list to the newly created block
! !
block_array(pmeta%cpu,pneigh%cpu)%ptr => pinfo block_array(pmeta%process,pneigh%process)%ptr => pinfo
end if ! block and neighbor belong to different processes end if ! block and neighbor belong to different processes
#endif /* MPI */ #endif /* MPI */
end if ! iface = 1 end if ! iface = 1
end if ! pmeta and pneigh marked for update
end if ! neighbor at the same level end if ! neighbor at the same level
@ -1605,121 +1620,129 @@ module boundaries
! !
if (pmeta%level < pneigh%level) then if (pmeta%level < pneigh%level) then
! process only if this block and its neighbor are marked for update
!
if (pmeta%update .and. pneigh%update) then
#ifdef MPI #ifdef MPI
! check if the current meta block and its neighbor belong to the same process ! check if the current meta block and its neighbor belong to the same process
! !
if (pmeta%cpu == pneigh%cpu) then if (pmeta%process == pneigh%process) then
! check if the current meta block belongs to the current process ! check if the current meta block belongs to the current process
! !
if (pmeta%cpu == nproc) then if (pmeta%process == nproc) then
#endif /* MPI */ #endif /* MPI */
! process each direction separatelly ! process each direction separatelly
! !
select case(idir) select case(idir)
case(1) case(1)
! prepare indices of the neighbor slices used for the boundary update ! prepare indices of the neighbor slices used for the boundary update
! !
if (iside == 1) then if (iside == 1) then
il = ie - nd + 1 il = ie - nd + 1
iu = ie iu = ie
else else
il = ib il = ib
iu = ib + nd - 1 iu = ib + nd - 1
end if end if
jl = 1 jl = 1
ju = jm ju = jm
kl = 1 kl = 1
ku = km ku = km
case(2) case(2)
! prepare indices of the neighbor slices used for the boundary update ! prepare indices of the neighbor slices used for the boundary update
! !
if (iside == 1) then if (iside == 1) then
jl = je - nd + 1 jl = je - nd + 1
ju = je ju = je
else else
jl = jb jl = jb
ju = jb + nd - 1 ju = jb + nd - 1
end if end if
il = 1 il = 1
iu = im iu = im
kl = 1 kl = 1
ku = km ku = km
#if NDIMS == 3 #if NDIMS == 3
case(3) case(3)
! prepare indices of the neighbor slices used for the boundary update ! prepare indices of the neighbor slices used for the boundary update
! !
if (iside == 1) then if (iside == 1) then
kl = ke - nd + 1 kl = ke - nd + 1
ku = ke ku = ke
else else
kl = kb kl = kb
ku = kb + nd - 1 ku = kb + nd - 1
end if end if
il = 1 il = 1
iu = im iu = im
jl = 1 jl = 1
ju = jm ju = jm
#endif /* NDIMS == 3 */ #endif /* NDIMS == 3 */
end select end select
! assign a pointer to the associate data block ! assign a pointer to the associate data block
! !
pdata => pmeta%data pdata => pmeta%data
! update boundaries of the current block ! update boundaries of the current block
! !
call boundary_restrict(pdata & call boundary_restrict(pdata &
, pneigh%data%u(:,il:iu,jl:ju,kl:ku) & , pneigh%data%u(:,il:iu,jl:ju,kl:ku) &
, idir, iside, iface) , idir, iside, iface)
#ifdef MPI #ifdef MPI
end if ! block on the current processor end if ! block on the current processor
else ! block and neighbor on different processors else ! block and neighbor on different processors
! increase the counter for number of blocks to exchange ! increase the counter for number of blocks to exchange
! !
block_counter(pmeta%cpu,pneigh%cpu) = & block_counter(pmeta%process,pneigh%process) = &
block_counter(pmeta%cpu,pneigh%cpu) + 1 block_counter(pmeta%process,pneigh%process) + 1
! allocate a new info object ! allocate a new info object
! !
allocate(pinfo) allocate(pinfo)
! fill out its fields ! fill out its fields
! !
pinfo%block => pmeta pinfo%block => pmeta
pinfo%neigh => pneigh pinfo%neigh => pneigh
pinfo%direction = idir pinfo%direction = idir
pinfo%side = iside pinfo%side = iside
pinfo%face = iface pinfo%face = iface
pinfo%level_difference = pmeta%level - pneigh%level pinfo%level_difference = pmeta%level - pneigh%level
! nullify pointers ! nullify pointers
! !
nullify(pinfo%prev) nullify(pinfo%prev)
nullify(pinfo%next) nullify(pinfo%next)
! if the list is not empty append the created block ! if the list is not empty append the created block
! !
if (associated(block_array(pmeta%cpu,pneigh%cpu)%ptr)) & if (associated(block_array(pmeta%process &
pinfo%prev => block_array(pmeta%cpu,pneigh%cpu)%ptr ,pneigh%process)%ptr)) &
pinfo%prev => block_array(pmeta%process &
,pneigh%process)%ptr
! point the list to the last created block ! point the list to the last created block
! !
block_array(pmeta%cpu,pneigh%cpu)%ptr => pinfo block_array(pmeta%process,pneigh%process)%ptr => pinfo
end if ! block and neighbor on different processors end if ! block and neighbor on different processors
#endif /* MPI */ #endif /* MPI */
end if ! pmeta and pneigh marked for update
end if ! block at lower level than neighbor end if ! block at lower level than neighbor
end if ! neighbor associated end if ! neighbor associated
@ -2112,116 +2135,124 @@ module boundaries
! !
if (pneigh%level < pmeta%level) then if (pneigh%level < pmeta%level) then
! process only if this block and its neighbor are marked for update
!
if (pmeta%update .and. pneigh%update) then
! perform update only for the first face, since all faces point the same block ! perform update only for the first face, since all faces point the same block
! !
if (iface == 1) then if (iface == 1) then
#ifdef MPI #ifdef MPI
! check if the current meta block and its neighbor belong to the same process ! check if the current meta block and its neighbor belong to the same process
! !
if (pmeta%cpu == pneigh%cpu) then if (pmeta%process == pneigh%process) then
! check if the current meta block belong to the current process ! check if the current meta block belong to the current process
! !
if (pmeta%cpu == nproc) then if (pmeta%process == nproc) then
#endif /* MPI */ #endif /* MPI */
! find the neighbor side and face pointing to the current block ! find the neighbor side and face pointing to the current block
! !
nside = 3 - iside nside = 3 - iside
nface = 1 nface = 1
do while(pmeta%id /= & do while(pmeta%id /= &
pneigh%neigh(idir,nside,nface)%ptr%id) pneigh%neigh(idir,nside,nface)%ptr%id)
nface = nface + 1 nface = nface + 1
end do end do
! prepare indices of the neighbor slices used for the boundary update ! prepare indices of the neighbor slices used for the boundary update
! !
il = 1 il = 1
iu = im iu = im
jl = 1 jl = 1
ju = jm ju = jm
kl = 1 kl = 1
ku = km ku = km
select case(idir) select case(idir)
case(1) case(1)
if (iside == 1) then if (iside == 1) then
il = ie - nh il = ie - nh
iu = ie + 1 iu = ie + 1
else else
il = ib - 1 il = ib - 1
iu = ib + nh iu = ib + nh
end if end if
case(2) case(2)
if (iside == 1) then if (iside == 1) then
jl = je - nh jl = je - nh
ju = je + 1 ju = je + 1
else else
jl = jb - 1 jl = jb - 1
ju = jb + nh ju = jb + nh
end if end if
case(3) case(3)
if (iside == 1) then if (iside == 1) then
kl = ke - nh kl = ke - nh
ku = ke + 1 ku = ke + 1
else else
kl = kb - 1 kl = kb - 1
ku = kb + nh ku = kb + nh
end if end if
end select end select
! assign a pointer to the associated data block ! assign a pointer to the associated data block
! !
pdata => pmeta%data pdata => pmeta%data
! update boundaries of the current block from its neighbor ! update boundaries of the current block from its neighbor
! !
call boundary_prolong(pdata & call boundary_prolong(pdata &
, pneigh%data%u(:,il:iu,jl:ju,kl:ku) & , pneigh%data%u(:,il:iu,jl:ju,kl:ku) &
, idir, iside, nface) , idir, iside, nface)
#ifdef MPI #ifdef MPI
end if ! pmeta on the current process end if ! pmeta on the current process
else ! block and neighbor belong to different processes else ! block and neighbor belong to different processes
! increase the counter for the number of blocks to exchange ! increase the counter for the number of blocks to exchange
! !
block_counter(pmeta%cpu,pneigh%cpu) = & block_counter(pmeta%process,pneigh%process) = &
block_counter(pmeta%cpu,pneigh%cpu) + 1 block_counter(pmeta%process,pneigh%process) + 1
! allocate a new info object ! allocate a new info object
! !
allocate(pinfo) allocate(pinfo)
! fill out its fields ! fill out its fields
! !
pinfo%block => pmeta pinfo%block => pmeta
pinfo%neigh => pneigh pinfo%neigh => pneigh
pinfo%direction = idir pinfo%direction = idir
pinfo%side = iside pinfo%side = iside
pinfo%face = iface pinfo%face = iface
pinfo%level_difference = pmeta%level - pneigh%level pinfo%level_difference = pmeta%level - pneigh%level
! nullify pointers ! nullify pointers
! !
nullify(pinfo%prev) nullify(pinfo%prev)
nullify(pinfo%next) nullify(pinfo%next)
! if the list is not empty append the newly created info object to it ! if the list is not empty append the newly created info object to it
! !
if (associated(block_array(pmeta%cpu,pneigh%cpu)%ptr)) & if (associated(block_array(pmeta%process &
pinfo%prev => block_array(pmeta%cpu,pneigh%cpu)%ptr ,pneigh%process)%ptr)) &
pinfo%prev => block_array(pmeta%process &
,pneigh%process)%ptr
! point the list to the newly created info object ! point the list to the newly created info object
! !
block_array(pmeta%cpu,pneigh%cpu)%ptr => pinfo block_array(pmeta%process,pneigh%process)%ptr => pinfo
end if ! block and neighbor belong to different processes end if ! block and neighbor belong to different processes
#endif /* MPI */ #endif /* MPI */
end if ! iface = 1 end if ! iface = 1
end if ! pmeta and pneigh marked for update
end if ! neighbor belongs to lower level end if ! neighbor belongs to lower level

11
src/domains.F90
View File

@ -136,8 +136,8 @@ module domains
use blocks , only : pointer_meta, block_meta, block_data & use blocks , only : pointer_meta, block_meta, block_data &
, append_metablock, append_datablock & , append_metablock, append_datablock &
, link_blocks, metablock_set_leaf & , link_blocks, metablock_set_leaf &
, metablock_set_config, metablock_set_level & , metablock_set_configuration, metablock_set_level &
, metablock_set_coord, metablock_set_bounds , metablock_set_coordinates, metablock_set_bounds
use blocks , only : nsides, nfaces use blocks , only : nsides, nfaces
use boundaries , only : xlbndry, xubndry, ylbndry, yubndry, zlbndry, zubndry use boundaries , only : xlbndry, xubndry, ylbndry, yubndry, zlbndry, zubndry
use coordinates, only : xmin, xmax, ymin, ymax, zmin, zmax use coordinates, only : xmin, xmax, ymin, ymax, zmin, zmax
@ -228,8 +228,9 @@ module domains
! set the configuration type ! set the configuration type
! !
call metablock_set_config(block_array(loc(1),loc(2),loc(3))%ptr & call metablock_set_configuration( &
, cfg(loc(1),loc(2),loc(3))) block_array(loc(1),loc(2),loc(3))%ptr &
, cfg(loc(1),loc(2),loc(3)))
! increase the block number ! increase the block number
! !
@ -305,7 +306,7 @@ module domains
! set block coordinates ! set block coordinates
! !
call metablock_set_coord(pmeta, il, jl, kl) call metablock_set_coordinates(pmeta, il, jl, kl)
! set the bounds ! set the bounds
! !

4
src/driver.F90
View File

@ -364,7 +364,7 @@ program amun
! initialize block module ! initialize block module
! !
call initialize_blocks() call initialize_blocks(master, iret)
! initialize boundaries module and print info ! initialize boundaries module and print info
! !
@ -633,7 +633,7 @@ program amun
! deallocate block structure ! deallocate block structure
! !
call finalize_blocks() call finalize_blocks(iret)
! finalize the random number generator ! finalize the random number generator
! !

34
src/evolution.F90
View File

@ -211,6 +211,7 @@ module evolution
! include external procedures ! include external procedures
! !
use blocks , only : set_blocks_update
use boundaries , only : boundary_variables use boundaries , only : boundary_variables
use mesh , only : update_mesh use mesh , only : update_mesh
@ -240,6 +241,10 @@ module evolution
! !
if (toplev > 1) then if (toplev > 1) then
! set all meta blocks to not be updated
!
call set_blocks_update(.false.)
! check refinement and refine ! check refinement and refine
! !
call update_mesh() call update_mesh()
@ -248,11 +253,15 @@ module evolution
! !
call boundary_variables() call boundary_variables()
end if ! toplev > 1
! update primitive variables ! update primitive variables
! !
call update_variables() call update_variables()
! set all meta blocks to be updated
!
call set_blocks_update(.true.)
end if ! toplev > 1
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
@ -694,6 +703,7 @@ module evolution
! include external variables ! include external variables
! !
use blocks , only : block_meta, list_meta
use blocks , only : block_data, list_data use blocks , only : block_data, list_data
! local variables are not implicit by default ! local variables are not implicit by default
@ -702,22 +712,30 @@ module evolution
! local pointers ! local pointers
! !
type(block_data), pointer :: pblock type(block_meta), pointer :: pmeta
type(block_data), pointer :: pdata
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
! associate the pointer with the first block on the data block list
!
pdata => list_data
! iterate over all data blocks ! iterate over all data blocks
! !
pblock => list_data do while (associated(pdata))
do while (associated(pblock))
! associate pmeta with the corresponding meta block
!
pmeta => pdata%meta
! convert conserved variables to primitive ones for the current block ! convert conserved variables to primitive ones for the current block
! !
call update_primitive_variables(pblock%u, pblock%q) if (pmeta%update) call update_primitive_variables(pdata%u, pdata%q)
! assign pointer to the next block ! assign pointer to the next block
! !
pblock => pblock%next pdata => pdata%next
end do end do

30
src/io.F90
View File

@ -2294,12 +2294,12 @@ module io
if (associated(pmeta%data) ) dat(l) = 1 if (associated(pmeta%data) ) dat(l) = 1
id (l) = pmeta%id id (l) = pmeta%id
cpu(l) = pmeta%cpu cpu(l) = pmeta%process
lev(l) = pmeta%level lev(l) = pmeta%level
cfg(l) = pmeta%config cfg(l) = pmeta%conf
ref(l) = pmeta%refine ref(l) = pmeta%refine
pos(l,:) = pmeta%pos(:) pos(l,:) = pmeta%pos(:)
cor(l,:) = pmeta%coord(:) cor(l,:) = pmeta%coords(:)
if (pmeta%leaf) lea(l) = 1 if (pmeta%leaf) lea(l) = 1
@ -2417,10 +2417,10 @@ module io
use blocks , only : block_meta, list_meta use blocks , only : block_meta, list_meta
use blocks , only : nchildren, nsides, nfaces use blocks , only : nchildren, nsides, nfaces
use blocks , only : get_mblocks use blocks , only : get_mblocks
use blocks , only : metablock_set_id, metablock_set_cpu & use blocks , only : metablock_set_id, metablock_set_process &
, metablock_set_refine, metablock_set_config & , metablock_set_refinement, metablock_set_configuration &
, metablock_set_level, metablock_set_position & , metablock_set_level, metablock_set_position &
, metablock_set_coord, metablock_set_bounds & , metablock_set_coordinates, metablock_set_bounds &
, metablock_set_leaf , metablock_set_leaf
use error , only : print_error use error , only : print_error
use hdf5 , only : hid_t, hsize_t use hdf5 , only : hid_t, hsize_t
@ -2549,14 +2549,14 @@ module io
block_array(id(l))%ptr => pmeta block_array(id(l))%ptr => pmeta
call metablock_set_id (pmeta, id (l)) call metablock_set_id (pmeta, id (l))
call metablock_set_cpu (pmeta, min(lcpu, cpu(l))) call metablock_set_process (pmeta, min(lcpu, cpu(l)))
call metablock_set_refine (pmeta, ref(l)) call metablock_set_refinement (pmeta, ref(l))
call metablock_set_config (pmeta, cfg(l)) call metablock_set_configuration(pmeta, cfg(l))
call metablock_set_level (pmeta, lev(l)) call metablock_set_level (pmeta, lev(l))
call metablock_set_position(pmeta, pos(l,1), pos(l,2), pos(l,3)) call metablock_set_position (pmeta, pos(l,1), pos(l,2), pos(l,3))
call metablock_set_coord (pmeta, cor(l,1), cor(l,2), cor(l,3)) call metablock_set_coordinates (pmeta, cor(l,1), cor(l,2), cor(l,3))
call metablock_set_bounds (pmeta, xmn(l), xmx(l), ymn(l), ymx(l) & call metablock_set_bounds (pmeta, xmn(l), xmx(l), ymn(l), ymx(l) &
, zmn(l), zmx(l)) , zmn(l), zmx(l))
if (lea(l) .eq. 1) call metablock_set_leaf(pmeta) if (lea(l) .eq. 1) call metablock_set_leaf(pmeta)
@ -3065,7 +3065,7 @@ module io
! fill in the coordinate array ! fill in the coordinate array
! !
cor(l,:) = pdata%meta%coord(:) cor(l,:) = pdata%meta%coords(:)
! fill in the bounds array ! fill in the bounds array
! !

2
src/makefile
View File

@ -122,7 +122,7 @@ clean-all: clean-bak clean-data clean-exec clean-logs clean-modules \
#------------------------------------------------------------------------------- #-------------------------------------------------------------------------------
blocks.o : blocks.F90 error.o blocks.o : blocks.F90 error.o timers.o
boundaries.o : boundaries.F90 blocks.o coordinates.o equations.o error.o \ boundaries.o : boundaries.F90 blocks.o coordinates.o equations.o error.o \
interpolations.o mpitools.o timers.o interpolations.o mpitools.o timers.o
constants.o : constants.F90 constants.o : constants.F90

111
src/mesh.F90
View File

@ -86,7 +86,7 @@ module mesh
! import external procedures and variables ! import external procedures and variables
! !
use blocks , only : datablock_set_dims use blocks , only : set_block_dimensions
use coordinates , only : xmin, xmax, ymin, ymax, zmin, zmax use coordinates , only : xmin, xmax, ymin, ymax, zmin, zmax
use coordinates , only : toplev, im, jm, km use coordinates , only : toplev, im, jm, km
use equations , only : nv use equations , only : nv
@ -131,7 +131,7 @@ module mesh
! set data block dimensions ! set data block dimensions
! !
call datablock_set_dims(nv, nv, im, jm, km) call set_block_dimensions(nv, nv, im, jm, km)
! only master prepares the mesh statistics file ! only master prepares the mesh statistics file
! !
@ -387,9 +387,9 @@ module mesh
! increase the block level and process counts ! increase the block level and process counts
! !
ldist(pmeta%level) = ldist(pmeta%level) + 1 ldist(pmeta%level) = ldist(pmeta%level) + 1
#ifdef MPI #ifdef MPI
cdist(pmeta%cpu+1) = cdist(pmeta%cpu+1) + 1 cdist(pmeta%process+1) = cdist(pmeta%process+1) + 1
#endif /* MPI */ #endif /* MPI */
end if ! the leaf end if ! the leaf
@ -701,7 +701,7 @@ module mesh
! assign the process number to the current block ! assign the process number to the current block
! !
pmeta%cpu = np pmeta%process = np
! check if the current block is the leaf ! check if the current block is the leaf
! !
@ -714,7 +714,7 @@ module mesh
! if the block belongs to the current process, append a new data block, link it ! if the block belongs to the current process, append a new data block, link it
! to the current meta block and initialize the problem ! to the current meta block and initialize the problem
! !
if (pmeta%cpu == nproc) then if (pmeta%process == nproc) then
! append new data block ! append new data block
! !
@ -1175,13 +1175,14 @@ module mesh
! check if the parent blocks is on the same processor as the next block, if not ! check if the parent blocks is on the same processor as the next block, if not
! move it to the same processor ! move it to the same processor
! !
if (pmeta%cpu /= pmeta%next%cpu) pmeta%cpu = pmeta%next%cpu if (pmeta%process /= pmeta%next%process) &
pmeta%process = pmeta%next%process
! find the case when child blocks are spread across at least 2 processors ! find the case when child blocks are spread across at least 2 processors
! !
flag = .false. flag = .false.
do p = 1, nchildren do p = 1, nchildren
flag = flag .or. (pmeta%child(p)%ptr%cpu /= pmeta%cpu) flag = flag .or. (pmeta%child(p)%ptr%process /= pmeta%process)
end do end do
if (flag) then if (flag) then
@ -1192,16 +1193,16 @@ module mesh
! generate the tag for communication ! generate the tag for communication
! !
itag = pmeta%child(p)%ptr%cpu * nprocs + pmeta%cpu & itag = pmeta%child(p)%ptr%process * nprocs + pmeta%process &
+ nprocs + p + 1 + nprocs + p + 1
! if the current children is not on the same processor, then ... ! if the current children is not on the same processor, then ...
! !
if (pmeta%child(p)%ptr%cpu /= pmeta%cpu) then if (pmeta%child(p)%ptr%process /= pmeta%process) then
! if the meta block is on the same process ! if the meta block is on the same process
! !
if (pmeta%cpu == nproc) then if (pmeta%process == nproc) then
! allocate data blocks for children on the processor which will receive data ! allocate data blocks for children on the processor which will receive data
! !
@ -1210,8 +1211,8 @@ module mesh
! receive the data ! receive the data
! !
call receive_real_array(size(rbuf), pmeta%child(p)%ptr%cpu & call receive_real_array(size(rbuf) &
, itag, rbuf, iret) , pmeta%child(p)%ptr%process, itag, rbuf, iret)
! coppy buffer to data ! coppy buffer to data
! !
@ -1221,7 +1222,7 @@ module mesh
! send data to the right processor and deallocate data block ! send data to the right processor and deallocate data block
! !
if (pmeta%child(p)%ptr%cpu == nproc) then if (pmeta%child(p)%ptr%process == nproc) then
! copy data to buffer ! copy data to buffer
! !
@ -1229,7 +1230,8 @@ module mesh
! send data ! send data
! !
call send_real_array(size(rbuf), pmeta%cpu, itag, rbuf, iret) call send_real_array(size(rbuf), pmeta%process &
, itag, rbuf, iret)
! deallocate data block ! deallocate data block
! !
@ -1239,7 +1241,7 @@ module mesh
! set the current processor of the block ! set the current processor of the block
! !
pmeta%child(p)%ptr%cpu = pmeta%cpu pmeta%child(p)%ptr%process = pmeta%process
end if ! if child is are on different processes end if ! if child is are on different processes
@ -1274,7 +1276,7 @@ module mesh
if (associated(pparent)) then if (associated(pparent)) then
#ifdef MPI #ifdef MPI
if (pmeta%cpu .eq. nproc) then if (pmeta%process .eq. nproc) then
#endif /* MPI */ #endif /* MPI */
if (.not. associated(pparent%data)) then if (.not. associated(pparent%data)) then
call append_datablock(pdata) call append_datablock(pdata)
@ -1313,7 +1315,7 @@ module mesh
if (pmeta%refine .eq. 1) then if (pmeta%refine .eq. 1) then
pparent => pmeta pparent => pmeta
#ifdef MPI #ifdef MPI
if (pmeta%cpu .eq. nproc) then if (pmeta%process .eq. nproc) then
#endif /* MPI */ #endif /* MPI */
call refine_block(pmeta, res(pmeta%level + 1,:), .true.) call refine_block(pmeta, res(pmeta%level + 1,:), .true.)
call prolong_block(pparent) call prolong_block(pparent)
@ -1435,7 +1437,7 @@ module mesh
! check if the block belongs to another process ! check if the block belongs to another process
! !
if (pmeta%cpu /= np) then if (pmeta%process /= np) then
! check if the block is the leaf ! check if the block is the leaf
! !
@ -1443,11 +1445,11 @@ module mesh
! generate a tag for communication ! generate a tag for communication
! !
itag = pmeta%cpu * nprocs + np + nprocs + 1 itag = pmeta%process * nprocs + np + nprocs + 1
! sends the block to the right process ! sends the block to the right process
! !
if (nproc == pmeta%cpu) then if (nproc == pmeta%process) then
! copy data to buffer ! copy data to buffer
! !
@ -1464,7 +1466,7 @@ module mesh
! send data block ! send data block
! !
end if ! nproc == pmeta%cpu end if ! nproc == pmeta%process
! receive the block from another process ! receive the block from another process
! !
@ -1477,7 +1479,7 @@ module mesh
! receive the data ! receive the data
! !
call receive_real_array(size(rbuf), pmeta%cpu, itag, rbuf, iret) call receive_real_array(size(rbuf), pmeta%process, itag, rbuf, iret)
! coppy the buffer to data block ! coppy the buffer to data block
! !
@ -1490,9 +1492,9 @@ module mesh
! set new processor number ! set new processor number
! !
pmeta%cpu = np pmeta%process = np
end if ! pmeta%cpu /= np end if ! pmeta%process /= np
! increase the number of blocks on the current process; if it exceeds the ! increase the number of blocks on the current process; if it exceeds the
! allowed number reset the counter and increase the processor number ! allowed number reset the counter and increase the processor number
@ -1882,65 +1884,6 @@ module mesh
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
end subroutine restrict_block end subroutine restrict_block
#ifdef DEBUG
!
!===============================================================================
!
! check_mesh: subroutine checks if the block structure is correct
! subroutine CHECK_MESH:
! ---------------------
!
! Subroutine checks if the meta block structure is correct.
!
! Arguments:
!
! string - the identification string;
!
!===============================================================================
!
subroutine check_mesh(string)
! import external procedures and variables
!
use blocks , only : block_meta, list_meta
use blocks , only : check_metablock
! local variables are not implicit by default
!
implicit none
! input arguments
!
character(len=*), intent(in) :: string
! local pointers
!
type(block_meta), pointer :: pmeta
!-------------------------------------------------------------------------------
!
! assign the pointer with the first block on the list
!
pmeta => list_meta
! iterate over all meta blocks
!
do while(associated(pmeta))
! check the current block
!
call check_metablock(pmeta, string)
! assign the pointer with the next block on the meta block list
!
pmeta => pmeta%next
end do ! over meta blocks
!-------------------------------------------------------------------------------
!
end subroutine check_mesh
#endif /* DEBUG */
!=============================================================================== !===============================================================================
! !

68
src/schemes.F90
View File

@ -1118,7 +1118,7 @@ module schemes
! calculate the flux along the Z direction ! calculate the flux along the Z direction
! !
do j = jbl, ieu do j = jbl, jeu
do i = ibl, ieu do i = ibl, ieu
! copy directional variable vectors to pass to the one dimensional solver ! copy directional variable vectors to pass to the one dimensional solver
@ -2901,37 +2901,10 @@ module schemes
else ! sm = 0 else ! sm = 0
! conservative variables for the left intermediate state ! when Sₘ = 0 all variables are continuous, therefore the flux reduces
! to the HLL one
! !
ui(idn) = wl(idn) / sl f(:,i) = (sl * wr(:) - sr * wl(:)) / srml
ui(imx) = 0.0d+00
ui(imy) = ui(idn) * vy
ui(imz) = ui(idn) * vz
ui(ibx) = bx
ui(iby) = by
ui(ibz) = bz
ui(ibp) = ql(ibp,i)
ui(ien) = (wl(ien) - bx * vb) / sl
! the left intermediate flux
!
f(:,i) = sl * ui(:) - wl(:)
! conservative variables for the right intermediate state
!
ui(idn) = wr(idn) / sr
ui(imx) = 0.0d+00
ui(imy) = ui(idn) * vy
ui(imz) = ui(idn) * vz
ui(ibx) = bx
ui(iby) = by
ui(ibz) = bz
ui(ibp) = qr(ibp,i)
ui(ien) = (wr(ien) - bx * vb) / sr
! the right intermediate flux
!
f(:,i) = 0.5d+00 * (f(:,i) + (sr * ui(:) - wr(:)))
end if ! sm = 0 end if ! sm = 0
@ -3348,37 +3321,10 @@ module schemes
else ! sm = 0 else ! sm = 0
! conservative variables for the inmost left intermediate state ! in the case when Sₘ = 0 and Bₓ² > 0, all variables are continuous, therefore
! the flux can be averaged from the Alfvén waves using the simple HLL formula
! !
ui(idn) = dnl f(:,i) = (sml * wcr(:) - smr * wcl(:)) / (smr - sml)
ui(imx) = 0.0d+00
ui(imy) = dnl * vy
ui(imz) = dnl * vz
ui(ibx) = bx
ui(iby) = by
ui(ibz) = bz
ui(ibp) = ql(ibp,i)
ui(ien) = (wcl(ien) - bx * vb) / cal
! the inmost left intermediate flux
!
f(:,i) = cal * ui(:) - wcl(:)
! conservative variables for the inmost right intermediate state
!
ui(idn) = dnr
ui(imx) = 0.0d+00
ui(imy) = dnr * vy
ui(imz) = dnr * vz
ui(ibx) = bx
ui(iby) = by
ui(ibz) = bz
ui(ibp) = qr(ibp,i)
ui(ien) = (wcr(ien) - bx * vb) / car
! the inmost right intermediate flux
!
f(:,i) = 0.5d+00 * (f(:,i) + (car * ui(:) - wcr(:)))
end if ! sm = 0 end if ! sm = 0