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
! fluxes directly
!
if (pmeta%cpu == nproc .and. pneigh%cpu == nproc) then
if (pmeta%process == nproc .and. pneigh%process == nproc) then
#endif /* MPI */
! update directional flux from the neighbor
@ -523,8 +523,8 @@ module boundaries
! increase the counter for the number of blocks to exchange
!
block_counter(idir,pmeta%cpu,pneigh%cpu) = &
block_counter(idir,pmeta%cpu,pneigh%cpu) + 1
block_counter(idir,pmeta%process,pneigh%process) = &
block_counter(idir,pmeta%process,pneigh%process) + 1
! allocate a new info object
!
@ -546,17 +546,17 @@ module boundaries
! check if the list is empty
!
if (associated(block_array(idir,pmeta%cpu,pneigh%cpu)%ptr))&
then
if (associated(block_array(idir,pmeta%process,pneigh%process)%ptr)) then
! 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
! 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
#endif /* MPI */
@ -970,30 +970,37 @@ module boundaries
!
if (pmeta%leaf .and. pmeta%level == ilev) then
! process only if this block is marked for update
!
if (pmeta%update) then
#ifdef MPI
! check if the current block belongs to the local process
!
if (pmeta%cpu == nproc) then
if (pmeta%process == nproc) then
#endif /* MPI */
! iterate over all neighbors
!
do iside = 1, nsides
do iside = 1, nsides
! 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
!
if (.not. associated(pneigh)) &
if (.not. associated(pneigh)) &
call boundary_specific(pmeta%data, idir, iside)
end do ! sides
end do ! sides
#ifdef MPI
end if ! block belong to the local process
end if ! block belong to the local process
#endif /* MPI */
end if ! pmeta is marked for update
end if ! leaf
! assign the pointer to the next block on the list
@ -1137,96 +1144,104 @@ module boundaries
!
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
!
if (iface == 1) then
if (iface == 1) then
#ifdef MPI
! 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
!
if (pmeta%cpu == nproc) then
if (pmeta%process == nproc) then
#endif /* MPI */
! assign a pointer to the data structure of the current block
!
pdata => pmeta%data
pdata => pmeta%data
! update boundaries of the current block
!
select case(idir)
case(1)
if (iside == 1) then
call boundary_copy(pdata &
select case(idir)
case(1)
if (iside == 1) then
call boundary_copy(pdata &
, pneigh%data%u(:,iel:ie,:,:), idir, iside)
else
call boundary_copy(pdata &
else
call boundary_copy(pdata &
, pneigh%data%u(:,ib:ibu,:,:), idir, iside)
end if
case(2)
if (iside == 1) then
call boundary_copy(pdata &
end if
case(2)
if (iside == 1) then
call boundary_copy(pdata &
, pneigh%data%u(:,:,jel:je,:), idir, iside)
else
call boundary_copy(pdata &
else
call boundary_copy(pdata &
, pneigh%data%u(:,:,jb:jbu,:), idir, iside)
end if
end if
#if NDIMS == 3
case(3)
if (iside == 1) then
call boundary_copy(pdata &
case(3)
if (iside == 1) then
call boundary_copy(pdata &
, pneigh%data%u(:,:,:,kel:ke), idir, iside)
else
call boundary_copy(pdata &
else
call boundary_copy(pdata &
, pneigh%data%u(:,:,:,kb:kbu), idir, iside)
end if
end if
#endif /* NDIMS == 3 */
end select
end select
#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
!
block_counter(pmeta%cpu,pneigh%cpu) = &
block_counter(pmeta%cpu,pneigh%cpu) + 1
block_counter(pmeta%process,pneigh%process) = &
block_counter(pmeta%process,pneigh%process) + 1
! allocate a new info object
!
allocate(pinfo)
allocate(pinfo)
! fill out its fields
!
pinfo%block => pmeta
pinfo%neigh => pneigh
pinfo%direction = idir
pinfo%side = iside
pinfo%face = iface
pinfo%level_difference = pmeta%level - pneigh%level
pinfo%block => pmeta
pinfo%neigh => pneigh
pinfo%direction = idir
pinfo%side = iside
pinfo%face = iface
pinfo%level_difference = pmeta%level - pneigh%level
! nullify pointer fields
!
nullify(pinfo%prev)
nullify(pinfo%next)
nullify(pinfo%prev)
nullify(pinfo%next)
! if the list is not empty append the newly created block
!
if (associated(block_array(pmeta%cpu,pneigh%cpu)%ptr)) &
pinfo%prev => block_array(pmeta%cpu,pneigh%cpu)%ptr
if (associated(block_array(pmeta%process &
,pneigh%process)%ptr)) &
pinfo%prev => block_array(pmeta%process &
,pneigh%process)%ptr
! 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 */
end if ! iface = 1
end if ! iface = 1
end if ! pmeta and pneigh marked for update
end if ! neighbor at the same level
@ -1605,121 +1620,129 @@ module boundaries
!
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
! 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
!
if (pmeta%cpu == nproc) then
if (pmeta%process == nproc) then
#endif /* MPI */
! 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
!
if (iside == 1) then
il = ie - nd + 1
iu = ie
else
il = ib
iu = ib + nd - 1
end if
jl = 1
ju = jm
kl = 1
ku = km
if (iside == 1) then
il = ie - nd + 1
iu = ie
else
il = ib
iu = ib + nd - 1
end if
jl = 1
ju = jm
kl = 1
ku = km
case(2)
case(2)
! prepare indices of the neighbor slices used for the boundary update
!
if (iside == 1) then
jl = je - nd + 1
ju = je
else
jl = jb
ju = jb + nd - 1
end if
il = 1
iu = im
kl = 1
ku = km
if (iside == 1) then
jl = je - nd + 1
ju = je
else
jl = jb
ju = jb + nd - 1
end if
il = 1
iu = im
kl = 1
ku = km
#if NDIMS == 3
case(3)
case(3)
! prepare indices of the neighbor slices used for the boundary update
!
if (iside == 1) then
kl = ke - nd + 1
ku = ke
else
kl = kb
ku = kb + nd - 1
end if
il = 1
iu = im
jl = 1
ju = jm
if (iside == 1) then
kl = ke - nd + 1
ku = ke
else
kl = kb
ku = kb + nd - 1
end if
il = 1
iu = im
jl = 1
ju = jm
#endif /* NDIMS == 3 */
end select
end select
! assign a pointer to the associate data block
!
pdata => pmeta%data
pdata => pmeta%data
! update boundaries of the current block
!
call boundary_restrict(pdata &
call boundary_restrict(pdata &
, pneigh%data%u(:,il:iu,jl:ju,kl:ku) &
, idir, iside, iface)
#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
!
block_counter(pmeta%cpu,pneigh%cpu) = &
block_counter(pmeta%cpu,pneigh%cpu) + 1
block_counter(pmeta%process,pneigh%process) = &
block_counter(pmeta%process,pneigh%process) + 1
! allocate a new info object
!
allocate(pinfo)
allocate(pinfo)
! fill out its fields
!
pinfo%block => pmeta
pinfo%neigh => pneigh
pinfo%direction = idir
pinfo%side = iside
pinfo%face = iface
pinfo%level_difference = pmeta%level - pneigh%level
pinfo%block => pmeta
pinfo%neigh => pneigh
pinfo%direction = idir
pinfo%side = iside
pinfo%face = iface
pinfo%level_difference = pmeta%level - pneigh%level
! nullify pointers
!
nullify(pinfo%prev)
nullify(pinfo%next)
nullify(pinfo%prev)
nullify(pinfo%next)
! if the list is not empty append the created block
!
if (associated(block_array(pmeta%cpu,pneigh%cpu)%ptr)) &
pinfo%prev => block_array(pmeta%cpu,pneigh%cpu)%ptr
if (associated(block_array(pmeta%process &
,pneigh%process)%ptr)) &
pinfo%prev => block_array(pmeta%process &
,pneigh%process)%ptr
! 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 */
end if ! pmeta and pneigh marked for update
end if ! block at lower level than neighbor
end if ! neighbor associated
@ -2112,116 +2135,124 @@ module boundaries
!
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
!
if (iface == 1) then
if (iface == 1) then
#ifdef MPI
! 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
!
if (pmeta%cpu == nproc) then
if (pmeta%process == nproc) then
#endif /* MPI */
! find the neighbor side and face pointing to the current block
!
nside = 3 - iside
nface = 1
do while(pmeta%id /= &
nside = 3 - iside
nface = 1
do while(pmeta%id /= &
pneigh%neigh(idir,nside,nface)%ptr%id)
nface = nface + 1
end do
nface = nface + 1
end do
! prepare indices of the neighbor slices used for the boundary update
!
il = 1
iu = im
jl = 1
ju = jm
kl = 1
ku = km
il = 1
iu = im
jl = 1
ju = jm
kl = 1
ku = km
select case(idir)
case(1)
if (iside == 1) then
il = ie - nh
iu = ie + 1
else
il = ib - 1
iu = ib + nh
end if
case(2)
if (iside == 1) then
jl = je - nh
ju = je + 1
else
jl = jb - 1
ju = jb + nh
end if
case(3)
if (iside == 1) then
kl = ke - nh
ku = ke + 1
else
kl = kb - 1
ku = kb + nh
end if
end select
select case(idir)
case(1)
if (iside == 1) then
il = ie - nh
iu = ie + 1
else
il = ib - 1
iu = ib + nh
end if
case(2)
if (iside == 1) then
jl = je - nh
ju = je + 1
else
jl = jb - 1
ju = jb + nh
end if
case(3)
if (iside == 1) then
kl = ke - nh
ku = ke + 1
else
kl = kb - 1
ku = kb + nh
end if
end select
! assign a pointer to the associated data block
!
pdata => pmeta%data
pdata => pmeta%data
! 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) &
, idir, iside, nface)
#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
!
block_counter(pmeta%cpu,pneigh%cpu) = &
block_counter(pmeta%cpu,pneigh%cpu) + 1
block_counter(pmeta%process,pneigh%process) = &
block_counter(pmeta%process,pneigh%process) + 1
! allocate a new info object
!
allocate(pinfo)
allocate(pinfo)
! fill out its fields
!
pinfo%block => pmeta
pinfo%neigh => pneigh
pinfo%direction = idir
pinfo%side = iside
pinfo%face = iface
pinfo%level_difference = pmeta%level - pneigh%level
pinfo%block => pmeta
pinfo%neigh => pneigh
pinfo%direction = idir
pinfo%side = iside
pinfo%face = iface
pinfo%level_difference = pmeta%level - pneigh%level
! nullify pointers
!
nullify(pinfo%prev)
nullify(pinfo%next)
nullify(pinfo%prev)
nullify(pinfo%next)
! if the list is not empty append the newly created info object to it
!
if (associated(block_array(pmeta%cpu,pneigh%cpu)%ptr)) &
pinfo%prev => block_array(pmeta%cpu,pneigh%cpu)%ptr
if (associated(block_array(pmeta%process &
,pneigh%process)%ptr)) &
pinfo%prev => block_array(pmeta%process &
,pneigh%process)%ptr
! 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 */
end if ! iface = 1
end if ! iface = 1
end if ! pmeta and pneigh marked for update
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 &
, append_metablock, append_datablock &
, link_blocks, metablock_set_leaf &
, metablock_set_config, metablock_set_level &
, metablock_set_coord, metablock_set_bounds
, metablock_set_configuration, metablock_set_level &
, metablock_set_coordinates, metablock_set_bounds
use blocks , only : nsides, nfaces
use boundaries , only : xlbndry, xubndry, ylbndry, yubndry, zlbndry, zubndry
use coordinates, only : xmin, xmax, ymin, ymax, zmin, zmax
@ -228,8 +228,9 @@ module domains
! set the configuration type
!
call metablock_set_config(block_array(loc(1),loc(2),loc(3))%ptr &
, cfg(loc(1),loc(2),loc(3)))
call metablock_set_configuration( &
block_array(loc(1),loc(2),loc(3))%ptr &
, cfg(loc(1),loc(2),loc(3)))
! increase the block number
!
@ -305,7 +306,7 @@ module domains
! set block coordinates
!
call metablock_set_coord(pmeta, il, jl, kl)
call metablock_set_coordinates(pmeta, il, jl, kl)
! set the bounds
!

4
src/driver.F90
View File

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

34
src/evolution.F90
View File

@ -211,6 +211,7 @@ module evolution
! include external procedures
!
use blocks , only : set_blocks_update
use boundaries , only : boundary_variables
use mesh , only : update_mesh
@ -240,6 +241,10 @@ module evolution
!
if (toplev > 1) then
! set all meta blocks to not be updated
!
call set_blocks_update(.false.)
! check refinement and refine
!
call update_mesh()
@ -248,11 +253,15 @@ module evolution
!
call boundary_variables()
end if ! toplev > 1
! 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
!
use blocks , only : block_meta, list_meta
use blocks , only : block_data, list_data
! local variables are not implicit by default
@ -702,22 +712,30 @@ module evolution
! 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
!
pblock => list_data
do while (associated(pblock))
do while (associated(pdata))
! associate pmeta with the corresponding meta block
!
pmeta => pdata%meta
! 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
!
pblock => pblock%next
pdata => pdata%next
end do

30
src/io.F90
View File

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

111
src/mesh.F90
View File

@ -86,7 +86,7 @@ module mesh
! 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 : toplev, im, jm, km
use equations , only : nv
@ -131,7 +131,7 @@ module mesh
! 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
!
@ -387,9 +387,9 @@ module mesh
! increase the block level and process counts
!
ldist(pmeta%level) = ldist(pmeta%level) + 1
ldist(pmeta%level) = ldist(pmeta%level) + 1
#ifdef MPI
cdist(pmeta%cpu+1) = cdist(pmeta%cpu+1) + 1
cdist(pmeta%process+1) = cdist(pmeta%process+1) + 1
#endif /* MPI */
end if ! the leaf
@ -701,7 +701,7 @@ module mesh
! assign the process number to the current block
!
pmeta%cpu = np
pmeta%process = np
! 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
! to the current meta block and initialize the problem
!
if (pmeta%cpu == nproc) then
if (pmeta%process == nproc) then
! 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
! 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
!
flag = .false.
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
if (flag) then
@ -1192,16 +1193,16 @@ module mesh
! 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
! 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 (pmeta%cpu == nproc) then
if (pmeta%process == nproc) then
! allocate data blocks for children on the processor which will receive data
!
@ -1210,8 +1211,8 @@ module mesh
! receive the data
!
call receive_real_array(size(rbuf), pmeta%child(p)%ptr%cpu &
, itag, rbuf, iret)
call receive_real_array(size(rbuf) &
, pmeta%child(p)%ptr%process, itag, rbuf, iret)
! coppy buffer to data
!
@ -1221,7 +1222,7 @@ module mesh
! 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
!
@ -1229,7 +1230,8 @@ module mesh
! 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
!
@ -1239,7 +1241,7 @@ module mesh
! 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
@ -1274,7 +1276,7 @@ module mesh
if (associated(pparent)) then
#ifdef MPI
if (pmeta%cpu .eq. nproc) then
if (pmeta%process .eq. nproc) then
#endif /* MPI */
if (.not. associated(pparent%data)) then
call append_datablock(pdata)
@ -1313,7 +1315,7 @@ module mesh
if (pmeta%refine .eq. 1) then
pparent => pmeta
#ifdef MPI
if (pmeta%cpu .eq. nproc) then
if (pmeta%process .eq. nproc) then
#endif /* MPI */
call refine_block(pmeta, res(pmeta%level + 1,:), .true.)
call prolong_block(pparent)
@ -1435,7 +1437,7 @@ module mesh
! 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
!
@ -1443,11 +1445,11 @@ module mesh
! 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
!
if (nproc == pmeta%cpu) then
if (nproc == pmeta%process) then
! copy data to buffer
!
@ -1464,7 +1466,7 @@ module mesh
! send data block
!
end if ! nproc == pmeta%cpu
end if ! nproc == pmeta%process
! receive the block from another process
!
@ -1477,7 +1479,7 @@ module mesh
! 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
!
@ -1490,9 +1492,9 @@ module mesh
! 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
! allowed number reset the counter and increase the processor number
@ -1882,65 +1884,6 @@ module mesh
!-------------------------------------------------------------------------------
!
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
!
do j = jbl, ieu
do j = jbl, jeu
do i = ibl, ieu
! copy directional variable vectors to pass to the one dimensional solver
@ -2901,37 +2901,10 @@ module schemes
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
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(:)))
f(:,i) = (sl * wr(:) - sr * wl(:)) / srml
end if ! sm = 0
@ -3348,37 +3321,10 @@ module schemes
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
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(:)))
f(:,i) = (sml * wcr(:) - smr * wcl(:)) / (smr - sml)
end if ! sm = 0