2008-11-05 22:16:24 -06:00
|
|
|
!!*****************************************************************************
|
2008-11-04 21:00:50 -06:00
|
|
|
!!
|
|
|
|
!! module: blocks - handling adaptive mesh structure
|
|
|
|
!!
|
|
|
|
!! Copyright (C) 2008 Grzegorz Kowal <kowal@astro.wisc.edu>
|
|
|
|
!!
|
2008-11-05 22:16:24 -06:00
|
|
|
!!*****************************************************************************
|
2008-11-04 21:00:50 -06:00
|
|
|
!!
|
|
|
|
!! 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/>.
|
|
|
|
!!
|
2008-11-05 22:16:24 -06:00
|
|
|
!!*****************************************************************************
|
2008-11-04 21:00:50 -06:00
|
|
|
!!
|
|
|
|
!
|
|
|
|
module blocks
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
! parameters
|
|
|
|
!
|
|
|
|
#ifdef R3D
|
|
|
|
integer(kind=4), parameter :: ndims = 3
|
|
|
|
#else /* R3D */
|
|
|
|
integer(kind=4), parameter :: ndims = 2
|
|
|
|
#endif /* R3D */
|
|
|
|
integer(kind=4), parameter :: nchild = 2**ndims
|
|
|
|
|
|
|
|
! define block type
|
|
|
|
!
|
|
|
|
type block
|
|
|
|
type(block), pointer :: next, prev
|
|
|
|
|
|
|
|
integer(kind=4) :: id, level, parent
|
|
|
|
integer(kind=4) :: neigh(ndims,2), child(nchild)
|
|
|
|
|
|
|
|
real :: xmin, xmax, ymin, ymax, zmin, zmax
|
|
|
|
|
2008-11-07 00:10:09 -06:00
|
|
|
real, dimension(:,:,:), allocatable :: dn, mx, my, mz
|
2008-11-04 21:00:50 -06:00
|
|
|
#ifndef ISO
|
2008-11-07 00:10:09 -06:00
|
|
|
real, dimension(:,:,:), allocatable :: en
|
2008-11-04 21:00:50 -06:00
|
|
|
#endif /* !ISO */
|
|
|
|
#ifdef MHD
|
2008-11-07 00:10:09 -06:00
|
|
|
real, dimension(:,:,:), allocatable :: bx, by, bz
|
2008-11-04 21:00:50 -06:00
|
|
|
#endif /* MHD */
|
|
|
|
end type block
|
|
|
|
|
|
|
|
! stored pointers
|
|
|
|
!
|
|
|
|
type(block), pointer, save :: pfirst, plast
|
2008-11-07 00:10:09 -06:00
|
|
|
integer(kind=4) , save :: nblocks
|
2008-11-04 21:00:50 -06:00
|
|
|
|
|
|
|
contains
|
|
|
|
!
|
2008-11-05 22:16:24 -06:00
|
|
|
!======================================================================
|
2008-11-04 21:00:50 -06:00
|
|
|
!
|
2008-11-07 00:10:09 -06:00
|
|
|
! allocate_block: subroutine allocates space for one block and returns
|
|
|
|
! pointer to this block
|
|
|
|
!
|
|
|
|
!======================================================================
|
|
|
|
!
|
|
|
|
subroutine allocate_block(pblock)
|
|
|
|
|
|
|
|
use config, only : ngrids
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
! output arguments
|
|
|
|
!
|
|
|
|
type(block), pointer, intent(out) :: pblock
|
|
|
|
!
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
! allocate block structure
|
|
|
|
!
|
|
|
|
allocate(pblock)
|
|
|
|
|
|
|
|
! allocate space for variables
|
|
|
|
!
|
|
|
|
if (ndims .eq. 2) then
|
|
|
|
allocate(pblock%dn(ngrids,ngrids,1))
|
|
|
|
allocate(pblock%mx(ngrids,ngrids,1))
|
|
|
|
allocate(pblock%my(ngrids,ngrids,1))
|
|
|
|
allocate(pblock%mz(ngrids,ngrids,1))
|
|
|
|
#ifndef ISO
|
|
|
|
allocate(pblock%en(ngrids,ngrids,1))
|
|
|
|
#endif /* ISO */
|
|
|
|
#ifdef MHD
|
|
|
|
allocate(pblock%bx(ngrids,ngrids,1))
|
|
|
|
allocate(pblock%by(ngrids,ngrids,1))
|
|
|
|
allocate(pblock%bz(ngrids,ngrids,1))
|
|
|
|
#endif /* MHD */
|
|
|
|
endif
|
|
|
|
if (ndims .eq. 3) then
|
|
|
|
allocate(pblock%dn(ngrids,ngrids,ngrids))
|
|
|
|
allocate(pblock%mx(ngrids,ngrids,ngrids))
|
|
|
|
allocate(pblock%my(ngrids,ngrids,ngrids))
|
|
|
|
allocate(pblock%mz(ngrids,ngrids,ngrids))
|
|
|
|
#ifndef ISO
|
|
|
|
allocate(pblock%en(ngrids,ngrids,ngrids))
|
|
|
|
#endif /* !ISO */
|
|
|
|
#ifdef MHD
|
|
|
|
allocate(pblock%bx(ngrids,ngrids,ngrids))
|
|
|
|
allocate(pblock%by(ngrids,ngrids,ngrids))
|
|
|
|
allocate(pblock%bz(ngrids,ngrids,ngrids))
|
|
|
|
#endif /* MHD */
|
|
|
|
endif
|
|
|
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
end subroutine allocate_block
|
|
|
|
!
|
|
|
|
!======================================================================
|
|
|
|
!
|
|
|
|
! deallocate_block: subroutine deallocates space ocuppied by a given
|
|
|
|
! block
|
|
|
|
!
|
|
|
|
!======================================================================
|
|
|
|
!
|
|
|
|
subroutine deallocate_block(pblock)
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
! input arguments
|
|
|
|
!
|
|
|
|
type(block), pointer, intent(inout) :: pblock
|
|
|
|
!
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
! deallocate variables
|
|
|
|
!
|
|
|
|
deallocate(pblock%dn)
|
|
|
|
deallocate(pblock%mx)
|
|
|
|
deallocate(pblock%my)
|
|
|
|
deallocate(pblock%mz)
|
|
|
|
#ifndef ISO
|
|
|
|
deallocate(pblock%en)
|
|
|
|
#endif /* !ISO */
|
|
|
|
#ifdef MHD
|
|
|
|
deallocate(pblock%bx)
|
|
|
|
deallocate(pblock%by)
|
|
|
|
deallocate(pblock%bz)
|
|
|
|
#endif /* MHD */
|
|
|
|
|
|
|
|
! free and nullify the block
|
|
|
|
!
|
|
|
|
deallocate(pblock)
|
|
|
|
nullify(pblock)
|
|
|
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
end subroutine deallocate_block
|
|
|
|
!
|
|
|
|
!======================================================================
|
|
|
|
!
|
2008-11-04 21:00:50 -06:00
|
|
|
! init_blocks: subroutine initializes the structure of blocks
|
|
|
|
!
|
2008-11-05 22:16:24 -06:00
|
|
|
!======================================================================
|
2008-11-04 21:00:50 -06:00
|
|
|
!
|
|
|
|
subroutine init_blocks
|
|
|
|
|
2008-11-07 00:10:09 -06:00
|
|
|
use config, only : iblocks, jblocks, kblocks
|
|
|
|
|
2008-11-04 21:00:50 -06:00
|
|
|
implicit none
|
|
|
|
|
|
|
|
! pointers
|
|
|
|
!
|
|
|
|
type(block), pointer :: pcurr
|
|
|
|
!
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
! first check if block list is empty
|
|
|
|
!
|
|
|
|
if (associated(pfirst)) then
|
|
|
|
write(*,*) 'ERROR: Block list already associated!'
|
|
|
|
endif
|
|
|
|
|
|
|
|
! nullify all pointers
|
|
|
|
!
|
|
|
|
nullify(pfirst)
|
|
|
|
|
2008-11-07 00:10:09 -06:00
|
|
|
! reset number of blocks
|
|
|
|
!
|
|
|
|
nblocks = 0
|
|
|
|
|
2008-11-04 21:00:50 -06:00
|
|
|
! create the first block
|
|
|
|
!
|
2008-11-07 00:10:09 -06:00
|
|
|
call allocate_block(pcurr)
|
2008-11-04 21:00:50 -06:00
|
|
|
|
2008-11-05 21:07:03 -06:00
|
|
|
! fill block structure
|
|
|
|
!
|
|
|
|
pcurr%id = 1
|
|
|
|
pcurr%level = 1
|
|
|
|
pcurr%parent = -1
|
|
|
|
|
|
|
|
pcurr%neigh(:,:) = -1
|
2008-11-05 22:16:24 -06:00
|
|
|
pcurr%child(:) = -1
|
2008-11-05 21:07:03 -06:00
|
|
|
|
2008-11-04 21:00:50 -06:00
|
|
|
! nullify the prev and next fields
|
|
|
|
!
|
|
|
|
nullify(pcurr%prev)
|
|
|
|
nullify(pcurr%next)
|
|
|
|
|
|
|
|
! add the block to the list
|
|
|
|
!
|
|
|
|
pfirst => pcurr
|
|
|
|
|
2008-11-05 22:16:24 -06:00
|
|
|
!----------------------------------------------------------------------
|
|
|
|
!
|
2008-11-04 21:00:50 -06:00
|
|
|
end subroutine init_blocks
|
|
|
|
!
|
2008-11-05 22:16:24 -06:00
|
|
|
!======================================================================
|
2008-11-04 21:00:50 -06:00
|
|
|
!
|
|
|
|
! clear_blocks: subroutine clears the structure of blocks
|
|
|
|
!
|
2008-11-05 22:16:24 -06:00
|
|
|
!======================================================================
|
2008-11-04 21:00:50 -06:00
|
|
|
!
|
|
|
|
subroutine clear_blocks
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
! pointers
|
|
|
|
!
|
|
|
|
type(block), pointer :: pcurr
|
|
|
|
!
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
! until list is free, reiterate over all chunks
|
|
|
|
!
|
|
|
|
do while(associated(pfirst))
|
|
|
|
|
|
|
|
! assign temporary pointer to the next chunk
|
|
|
|
!
|
|
|
|
pcurr => pfirst%next
|
|
|
|
|
|
|
|
! deallocate the content of current block
|
|
|
|
!
|
|
|
|
|
|
|
|
! deallocate and nullify the current block
|
|
|
|
!
|
2008-11-07 00:10:09 -06:00
|
|
|
call deallocate_block(pfirst)
|
2008-11-04 21:00:50 -06:00
|
|
|
|
|
|
|
! assign pointer to the current chunk
|
|
|
|
!
|
|
|
|
pfirst => pcurr
|
|
|
|
|
|
|
|
end do
|
|
|
|
|
2008-11-05 22:16:24 -06:00
|
|
|
!----------------------------------------------------------------------
|
|
|
|
!
|
2008-11-04 21:00:50 -06:00
|
|
|
end subroutine clear_blocks
|
|
|
|
|
2008-11-05 22:16:24 -06:00
|
|
|
!======================================================================
|
|
|
|
!
|
2008-11-04 21:00:50 -06:00
|
|
|
end module
|