New module to handle the boundary conditions.
The subroutine 'boundary' sweeps over all leaf blocks. For each block it sweeps over its neighbors and performs update of the boundaries. This is an initial version yet, it supports only neighboring blocks of the same level of refinement.
This commit is contained in:
Grzegorz Kowal
parent
2bc8d0452d
commit
936420c599
188
src/boundaries.F90
Normal file
188
src/boundaries.F90
Normal file
@ -0,0 +1,188 @@
|
||||
!!*****************************************************************************
|
||||
!!
|
||||
!! module: boundaries - routines for handling the boundary conditions
|
||||
!!
|
||||
!! Copyright (C) 2008 Grzegorz Kowal <kowal@astro.wisc.edu>
|
||||
!!
|
||||
!!*****************************************************************************
|
||||
!!
|
||||
!! This file is part of Godunov-AMR.
|
||||
!!
|
||||
!! Godunov-AMR is free software; you can redistribute it and/or modify
|
||||
!! it under the terms of the GNU General Public License as published by
|
||||
!! the Free Software Foundation; either version 3 of the License, or
|
||||
!! (at your option) any later version.
|
||||
!!
|
||||
!! Godunov-AMR is distributed in the hope that it will be useful,
|
||||
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
!! GNU General Public License for more details.
|
||||
!!
|
||||
!! You should have received a copy of the GNU General Public License
|
||||
!! along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
!!
|
||||
!!*****************************************************************************
|
||||
!!
|
||||
!
|
||||
module boundaries
|
||||
|
||||
implicit none
|
||||
|
||||
integer, save :: n
|
||||
real , save :: t, dt, dtn
|
||||
|
||||
contains
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
! boundary: subroutine sweeps over all leaf blocks and performs the boundary
|
||||
! update
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
subroutine boundary
|
||||
|
||||
use blocks, only : block, plist, ndims
|
||||
use error , only : print_error
|
||||
|
||||
implicit none
|
||||
|
||||
! local variables
|
||||
!
|
||||
integer :: i, j, k, dl
|
||||
|
||||
! local pointers
|
||||
!
|
||||
type(block), pointer :: pblock, pneigh
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
! iterate over all blocks and perform boundary update
|
||||
!
|
||||
pblock => plist
|
||||
do while (associated(pblock))
|
||||
|
||||
! if the current block is a leaf...
|
||||
!
|
||||
if (pblock%leaf .eq. 'T') then
|
||||
|
||||
! iterate over all neighbor blocks
|
||||
!
|
||||
do i = 1, ndims
|
||||
do j = 1, 2
|
||||
do k = 1, 2
|
||||
|
||||
pneigh => pblock%pneigh(i,j,k)%p
|
||||
|
||||
! check if neighbor is associated
|
||||
!
|
||||
if (associated(pneigh)) then
|
||||
|
||||
! neighbor is associated, which means the periodic boundary conditions
|
||||
! or interior of the domain
|
||||
!
|
||||
if (pneigh%leaf .eq. 'T') then
|
||||
|
||||
! calculate the difference of current and neighbor levels
|
||||
!
|
||||
dl = pblock%level - pneigh%level
|
||||
|
||||
! depending on the level difference
|
||||
!
|
||||
select case(dl)
|
||||
case(-1) ! restriction
|
||||
|
||||
case(0) ! the same level, copying
|
||||
call bnd_copy(pblock%u, pneigh%u, i, j, k)
|
||||
case(1) ! prolongation
|
||||
|
||||
case default
|
||||
call print_error("boundaries::boundary", "Level difference unsupported!")
|
||||
end select
|
||||
|
||||
! perform copying, prolongation or restriction
|
||||
!
|
||||
|
||||
else
|
||||
print *, pneigh%id, 'is not a leaf'
|
||||
endif
|
||||
else
|
||||
|
||||
! neighbor is not associated, it means that we have non periodic boundary here
|
||||
!
|
||||
|
||||
endif
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
endif
|
||||
|
||||
! assign pointer to the next block
|
||||
!
|
||||
pblock => pblock%next
|
||||
|
||||
end do
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine boundary
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
! bnd_copy: subroutine copies the interior of neighbor to update the boundaries
|
||||
! of current block
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
subroutine bnd_copy(u, b, id, is, ip)
|
||||
|
||||
use blocks, only : nvars
|
||||
use config, only : igrids, jgrids, kgrids, nghost, ncells
|
||||
use error , only : print_warning
|
||||
|
||||
implicit none
|
||||
|
||||
! arguments
|
||||
!
|
||||
real, dimension(nvars,igrids,jgrids,kgrids), intent(inout) :: u
|
||||
real, dimension(nvars,igrids,jgrids,kgrids), intent(in) :: b
|
||||
integer , intent(in) :: id, is, ip
|
||||
|
||||
! local variables
|
||||
!
|
||||
integer :: ii
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
! calcuate the flag determinig the side of boundary to update
|
||||
!
|
||||
ii = 100 * id + 10 * is
|
||||
|
||||
! perform update according to the flag
|
||||
!
|
||||
select case(ii)
|
||||
case(110)
|
||||
u(:,1:nghost,:,:) = b(:,ncells:ncells+nghost,:,:)
|
||||
case(120)
|
||||
u(:,igrids-nghost:igrids,:,:) = b(:,nghost+1:2*nghost,:,:)
|
||||
case(210)
|
||||
u(:,:,1:nghost,:) = b(:,:,ncells:ncells+nghost,:)
|
||||
case(220)
|
||||
u(:,:,jgrids-nghost:jgrids,:) = b(:,:,nghost+1:2*nghost,:)
|
||||
case(310)
|
||||
u(:,:,:,1:nghost) = b(:,:,:,ncells:ncells+nghost)
|
||||
case(320)
|
||||
u(:,:,:,kgrids-nghost:kgrids) = b(:,:,:,nghost+1:2*nghost)
|
||||
case default
|
||||
call print_warning("boundaries::bnd_copy", "Boundary flag unsupported!")
|
||||
end select
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine bnd_copy
|
||||
|
||||
!===============================================================================
|
||||
!
|
||||
end module
|
||||
@ -42,9 +42,10 @@ module evolution
|
||||
!
|
||||
subroutine evolve
|
||||
|
||||
use blocks, only : block, plist
|
||||
use blocks , only : block, plist
|
||||
use boundaries, only : boundary
|
||||
use mesh , only : dx_min
|
||||
use scheme, only : maxspeed
|
||||
use scheme , only : maxspeed
|
||||
|
||||
implicit none
|
||||
|
||||
@ -73,8 +74,9 @@ module evolution
|
||||
|
||||
end do
|
||||
|
||||
! TODO: boundary conditions
|
||||
! update boundaries
|
||||
!
|
||||
call boundary
|
||||
|
||||
! reset maximum speed
|
||||
!
|
||||
|
||||
13
src/makefile
13
src/makefile
@ -78,10 +78,12 @@ name = godunov-amr
|
||||
|
||||
default: $(name).x
|
||||
|
||||
sources = blocks.F90 config.F90 driver.F90 error.F90 evolution.F90 \
|
||||
interpolation.F90 io.F90 mesh.F90 problem.F90 scheme.F90 timer.F90
|
||||
objects = blocks.o config.o driver.o error.o evolution.o \
|
||||
interpolation.o io.o mesh.o problem.o scheme.o timer.o
|
||||
sources = blocks.F90 boundaries.F90 config.F90 driver.F90 error.F90 \
|
||||
evolution.F90 interpolation.F90 io.F90 mesh.F90 problem.F90 \
|
||||
scheme.F90 timer.F90
|
||||
objects = blocks.o boundaries.o config.o driver.o error.o \
|
||||
evolution.o interpolation.o io.o mesh.o problem.o \
|
||||
scheme.o timer.o
|
||||
files = $(sources) makefile make.default config.in license.txt hosts
|
||||
|
||||
$(name).x: $(objects)
|
||||
@ -99,10 +101,11 @@ clean-all:
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
blocks.o : blocks.F90 config.o
|
||||
boundaries.o : boundaries.F90 blocks.o config.o error.o
|
||||
config.o : config.F90 error.o
|
||||
driver.o : driver.F90 config.o evolution.o io.o mesh.o timer.o
|
||||
error.o : error.F90
|
||||
evolution.o : evolution.F90 blocks.o config.o mesh.o scheme.o
|
||||
evolution.o : evolution.F90 blocks.o boundaries.o config.o mesh.o scheme.o
|
||||
interpolation.o : interpolation.F90
|
||||
io.o : io.F90 blocks.o error.o
|
||||
mesh.o : mesh.F90 blocks.o config.o error.o problem.o
|
||||
|
||||
@ -232,7 +232,7 @@ module mesh
|
||||
write(bstr,"(i)") last_id
|
||||
write(tstr,"(i)") (2**maxlev)**ndims
|
||||
write(*,*)
|
||||
write(*,"(4x,a,1x,a6,' / ',a,' = ',f7.4,' %')") "allocated/total blocks =", trim(adjustl(bstr)),trim(adjustl(tstr)), (100.0*last_id)/(2**maxlev)**ndims
|
||||
write(*,"(4x,a,1x,a6,' / ',a,' = ',f8.4,' %')") "allocated/total blocks =", trim(adjustl(bstr)),trim(adjustl(tstr)), (100.0*last_id)/(2**maxlev)**ndims
|
||||
|
||||
! allocating space for coordinate variables
|
||||
!
|
||||
|
||||
@ -195,7 +195,6 @@ module problem
|
||||
check_ref = -1
|
||||
endif
|
||||
|
||||
|
||||
return
|
||||
|
||||
!----------------------------------------------------------------------
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user