diff --git a/src/boundaries.F90 b/src/boundaries.F90 new file mode 100644 index 0000000..906ae57 --- /dev/null +++ b/src/boundaries.F90 @@ -0,0 +1,188 @@ +!!***************************************************************************** +!! +!! module: boundaries - routines for handling the boundary conditions +!! +!! Copyright (C) 2008 Grzegorz Kowal +!! +!!***************************************************************************** +!! +!! 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 . +!! +!!***************************************************************************** +!! +! +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 diff --git a/src/evolution.F90 b/src/evolution.F90 index 2945682..8b011d5 100644 --- a/src/evolution.F90 +++ b/src/evolution.F90 @@ -42,9 +42,10 @@ module evolution ! subroutine evolve - use blocks, only : block, plist - use mesh , only : dx_min - use scheme, only : maxspeed + use blocks , only : block, plist + use boundaries, only : boundary + use mesh , only : dx_min + use scheme , only : maxspeed implicit none @@ -73,8 +74,9 @@ module evolution end do -! TODO: boundary conditions +! update boundaries ! + call boundary ! reset maximum speed ! diff --git a/src/makefile b/src/makefile index d4171a9..43efd82 100644 --- a/src/makefile +++ b/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 diff --git a/src/mesh.F90 b/src/mesh.F90 index daab442..812f12d 100644 --- a/src/mesh.F90 +++ b/src/mesh.F90 @@ -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 ! diff --git a/src/problem.F90 b/src/problem.F90 index 9cb03d3..e7a3fb2 100644 --- a/src/problem.F90 +++ b/src/problem.F90 @@ -195,7 +195,6 @@ module problem check_ref = -1 endif - return !----------------------------------------------------------------------