Merge branch 'master' into mpi

Conflicts:

	src/mesh.F90
This commit is contained in:
Grzegorz Kowal 2008-12-22 16:08:51 -06:00
commit 2719b0b451
3 changed files with 143 additions and 160 deletions

View File

@ -995,153 +995,6 @@ module blocks
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
end subroutine derefine_block end subroutine derefine_block
!
!===============================================================================
!
! allocate_blocks: subroutine allocates a configuration of blocks
!
! TODO: move to/replace with a subroutine in problem module; this will allow
! a user to define his/her own initial mesh
!
!===============================================================================
!
subroutine allocate_blocks(block_config, xmn, xmx, ymn, ymx &
, zmn, zmx)
use config, only : xlbndry, xubndry, ylbndry, yubndry
use error , only : print_error
implicit none
! input parameters
!
character(len=1), intent(in) :: block_config
real , intent(in) :: xmn, xmx, ymn, ymx, zmn, zmx
! local pointers
!
type(block), pointer :: pbl, pbr, ptl, ptr
! local variables
!
real :: xl, xc, xr, yl, yc, yr, zl, zc, zr
!
!-------------------------------------------------------------------------------
!
select case(block_config)
case('z', 'Z')
! create root blocks
!
call append_block(pbl)
call append_block(pbr)
call append_block(ptl)
call append_block(ptr)
! set configurations
!
pbl%config = 'Z'
pbr%config = 'Z'
ptl%config = 'Z'
ptr%config = 'Z'
! copy pointer of the first block in chain
!
plist => pbl
case('n', 'N')
! create root blocks
!
call append_block(pbl)
call append_block(ptl)
call append_block(ptr)
call append_block(pbr)
! set configurations
!
pbl%config = 'D'
ptl%config = 'N'
ptr%config = 'N'
pbr%config = 'C'
! copy pointer of the first block in chain
!
plist => pbl
case default
call print_error("blocks::allocate_blocks","Configuration '" // block_config // "' not supported! Terminating!")
end select
! set leaf flags
!
pbl%leaf = .true.
pbr%leaf = .true.
ptl%leaf = .true.
ptr%leaf = .true.
! set neighbors
!
if (xlbndry .eq. 'periodic') &
pbl%neigh(1,1,:)%id = pbr%id
pbl%neigh(1,2,:)%id = pbr%id
if (ylbndry .eq. 'periodic') &
pbl%neigh(2,1,:)%id = ptl%id
pbl%neigh(2,2,:)%id = ptl%id
pbr%neigh(1,1,:)%id = pbl%id
if (xubndry .eq. 'periodic') &
pbr%neigh(1,2,:)%id = pbl%id
if (ylbndry .eq. 'periodic') &
pbr%neigh(2,1,:)%id = ptr%id
pbr%neigh(2,2,:)%id = ptr%id
if (xlbndry .eq. 'periodic') &
ptl%neigh(1,1,:)%id = ptr%id
ptl%neigh(1,2,:)%id = ptr%id
ptl%neigh(2,1,:)%id = pbl%id
if (yubndry .eq. 'periodic') &
ptl%neigh(2,2,:)%id = pbl%id
ptr%neigh(1,1,:)%id = ptl%id
if (xubndry .eq. 'periodic') &
ptr%neigh(1,2,:)%id = ptl%id
ptr%neigh(2,1,:)%id = pbr%id
if (yubndry .eq. 'periodic') &
ptr%neigh(2,2,:)%id = pbr%id
! set block bounds
!
xl = xmn
xc = 0.5 * (xmx + xmn)
xr = xmx
yl = ymn
yc = 0.5 * (ymx + ymn)
yr = ymx
pbl%xmin = xl
pbl%xmax = xc
pbl%ymin = yl
pbl%ymax = yc
ptl%xmin = xl
ptl%xmax = xc
ptl%ymin = yc
ptl%ymax = yr
ptr%xmin = xc
ptr%xmax = xr
ptr%ymin = yc
ptr%ymax = yr
pbr%xmin = xc
pbr%xmax = xr
pbr%ymin = yl
pbr%ymax = yc
!-------------------------------------------------------------------------------
!
end subroutine allocate_blocks
!=============================================================================== !===============================================================================
! !

View File

@ -49,14 +49,14 @@ module mesh
! !
subroutine init_mesh subroutine init_mesh
use config , only : iblocks, jblocks, kblocks, ncells & use config , only : im, jm, km, xmin, xmax, ymin, ymax, zmin, zmax &
, xmin, xmax, ymin, ymax, zmin, zmax, maxlev, ngrids , ncells, maxlev
use blocks , only : list_allocated, init_blocks, clear_blocks & use blocks , only : list_allocated, init_blocks, clear_blocks &
, allocate_blocks, refine_block, get_pointer & , refine_block, get_pointer &
, block, nchild, ndims, plist, last_id , block, nchild, ndims, plist, last_id
use error , only : print_info use error , only : print_info
use mpitools, only : is_master use mpitools, only : is_master
use problem , only : init_problem, check_ref use problem , only : init_domain, init_problem, check_ref
implicit none implicit none
@ -79,18 +79,18 @@ module mesh
! print information ! print information
! !
if (is_master()) then if (is_master()) then
write(*,"(1x,a)" ) "Generating initial mesh:" write(*,"(1x,a)" ) "Generating initial mesh:"
write(*,"(4x,a,1x,i6)") "refining to max. level =", maxlev write(*,"(4x,a,1x,i6)") "refining to max. level =", maxlev
write(*,"(4x,a,1x,i6)") "effective resolution =", ncells*2**maxlev write(*,"(4x,a,1x,i6)") "effective resolution =", ncells*2**maxlev
endif endif
! allocate initial structure of blocks according the the defined geometry ! initialize blocks
!
! TODO: by default we initiate 2x2=4 blocks in N configuration
! TODO: in the future allow user to define an arbitrary shape
! !
call init_blocks call init_blocks
call allocate_blocks('N', xmin, xmax, ymin, ymax, zmin, zmax)
! allocate the initial structure of blocks according to the problem
!
call init_domain
! at this point we assume, that the initial structure of blocks ! at this point we assume, that the initial structure of blocks
! according to the defined geometry is already created; no refinement ! according to the defined geometry is already created; no refinement
@ -249,9 +249,9 @@ module mesh
! allocating space for coordinate variables ! allocating space for coordinate variables
! !
allocate(ax (maxlev, ngrids)) allocate(ax (maxlev, im))
allocate(ay (maxlev, ngrids)) allocate(ay (maxlev, jm))
allocate(az (maxlev, ngrids)) allocate(az (maxlev, km))
allocate(adx (maxlev)) allocate(adx (maxlev))
allocate(ady (maxlev)) allocate(ady (maxlev))
allocate(adz (maxlev)) allocate(adz (maxlev))

View File

@ -32,6 +32,27 @@ module problem
! !
!=============================================================================== !===============================================================================
! !
! init_domain: subroutine initializes the domain for a given problem
!
!===============================================================================
!
subroutine init_domain
use config, only : problem
!
!-------------------------------------------------------------------------------
!
select case(trim(problem))
case default
call domain_default()
end select
!-------------------------------------------------------------------------------
!
end subroutine init_domain
!
!===============================================================================
!
! init_problem: subroutine initializes the variables according to ! init_problem: subroutine initializes the variables according to
! the studied problem ! the studied problem
! !
@ -109,6 +130,115 @@ module problem
! !
!=============================================================================== !===============================================================================
! !
! domain_default: subroutine initializes the default domain of 2x2 blocks in
! 'N' configuration
!
!===============================================================================
!
subroutine domain_default
use blocks, only : block, append_block
use config, only : xlbndry, xubndry, ylbndry, yubndry &
, xmin, xmax, ymin, ymax
implicit none
! local variables
!
real :: xl, xc, xr, yl, yc, yr
! local pointers
!
type(block), pointer :: pbl, pbr, ptl, ptr
!
!-------------------------------------------------------------------------------
!
! create root blocks
!
call append_block(pbl)
call append_block(ptl)
call append_block(ptr)
call append_block(pbr)
! set configurations
!
pbl%config = 'D'
ptl%config = 'N'
ptr%config = 'N'
pbr%config = 'C'
! set leaf flags
!
pbl%leaf = .true.
pbr%leaf = .true.
ptl%leaf = .true.
ptr%leaf = .true.
! set neighbors
!
if (xlbndry .eq. 'periodic') &
pbl%neigh(1,1,:)%id = pbr%id
pbl%neigh(1,2,:)%id = pbr%id
if (ylbndry .eq. 'periodic') &
pbl%neigh(2,1,:)%id = ptl%id
pbl%neigh(2,2,:)%id = ptl%id
pbr%neigh(1,1,:)%id = pbl%id
if (xubndry .eq. 'periodic') &
pbr%neigh(1,2,:)%id = pbl%id
if (ylbndry .eq. 'periodic') &
pbr%neigh(2,1,:)%id = ptr%id
pbr%neigh(2,2,:)%id = ptr%id
if (xlbndry .eq. 'periodic') &
ptl%neigh(1,1,:)%id = ptr%id
ptl%neigh(1,2,:)%id = ptr%id
ptl%neigh(2,1,:)%id = pbl%id
if (yubndry .eq. 'periodic') &
ptl%neigh(2,2,:)%id = pbl%id
ptr%neigh(1,1,:)%id = ptl%id
if (xubndry .eq. 'periodic') &
ptr%neigh(1,2,:)%id = ptl%id
ptr%neigh(2,1,:)%id = pbr%id
if (yubndry .eq. 'periodic') &
ptr%neigh(2,2,:)%id = pbr%id
! set the bounds of the blocks
!
xl = xmin
xc = 0.5 * (xmax + xmin)
xr = xmax
yl = ymin
yc = 0.5 * (ymax + ymin)
yr = ymax
pbl%xmin = xl
pbl%xmax = xc
pbl%ymin = yl
pbl%ymax = yc
ptl%xmin = xl
ptl%xmax = xc
ptl%ymin = yc
ptl%ymax = yr
ptr%xmin = xc
ptr%xmax = xr
ptr%ymin = yc
ptr%ymax = yr
pbr%xmin = xc
pbr%xmax = xr
pbr%ymin = yl
pbr%ymax = yc
!-------------------------------------------------------------------------------
!
end subroutine domain_default
!
!===============================================================================
!
! init_blast: subroutine initializes the variables for the blast problem ! init_blast: subroutine initializes the variables for the blast problem
! !
!=============================================================================== !===============================================================================