BLOCKS: Rewrite data block allocate/removal subroutines.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2013-12-23 17:40:49 -02:00
parent bc095863c7
commit 42c39c5736

View File

@ -224,8 +224,9 @@ module blocks
public :: nchild, ndims, nsides, nfaces public :: nchild, ndims, nsides, nfaces
public :: initialize_blocks, finalize_blocks public :: initialize_blocks, finalize_blocks
public :: set_last_id, get_last_id, get_mblocks, get_dblocks, get_nleafs public :: set_last_id, get_last_id, get_mblocks, get_dblocks, get_nleafs
public :: append_metablock, associate_blocks, append_datablock & public :: append_metablock, associate_blocks
, deallocate_datablock public :: allocate_datablock, deallocate_datablock
public :: append_datablock, remove_datablock
public :: metablock_set_id, metablock_set_cpu, metablock_set_refine & public :: metablock_set_id, metablock_set_cpu, metablock_set_refine &
, metablock_set_config, metablock_set_level, metablock_set_position & , metablock_set_config, metablock_set_level, metablock_set_position &
, metablock_set_coord, metablock_set_bounds, metablock_set_leaf , metablock_set_coord, metablock_set_bounds, metablock_set_leaf
@ -1028,46 +1029,62 @@ module blocks
! the pointer to this block ! the pointer to this block
! !
!=============================================================================== !===============================================================================
!
!===============================================================================
!
! subroutine ALLOCATE_DATABLOCK:
! -----------------------------
!
! Subroutine allocates space for one data block and returns a pointer
! associated with it.
!
! Arguments:
!
! pdata - the pointer associated with the created data block;
!
!===============================================================================
! !
subroutine allocate_datablock(pdata) subroutine allocate_datablock(pdata)
! local variables are not implicit by default
!
implicit none implicit none
! output arguments ! subroutine arguments
! !
type(block_data), pointer, intent(out) :: pdata type(block_data), pointer, intent(out) :: pdata
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
! allocate block structure ! allocate the block structure
! !
allocate(pdata) allocate(pdata)
! nullify pointers ! nullify all pointers
! !
nullify(pdata%prev) nullify(pdata%prev)
nullify(pdata%next) nullify(pdata%next)
nullify(pdata%meta) nullify(pdata%meta)
! allocate space for conserved variables ! allocate the space for conserved variables
! !
allocate(pdata%u0(nvars,nx,ny,nz)) allocate(pdata%u0(nvars,nx,ny,nz))
allocate(pdata%u1(nvars,nx,ny,nz)) allocate(pdata%u1(nvars,nx,ny,nz))
! allocate space for primitive variables ! allocate the space for primitive variables
! !
allocate(pdata%q(nvars,nx,ny,nz)) allocate(pdata%q(nvars,nx,ny,nz))
! initiate the array pointer ! initiate the conserved variable pointer
! !
pdata%u => pdata%u0 pdata%u => pdata%u0
! allocate space for the numerical fluxes ! allocate the space for numerical fluxes
! !
if (nflux .gt. 0) allocate(pdata%f(ndims,nflux,nx,ny,nz)) if (nflux > 0) allocate(pdata%f(ndims,nflux,nx,ny,nz))
#ifdef DEBUG #ifdef DEBUG
! allocate space for the refinement values ! allocate the space for the refinement criterion array
! !
allocate(pdata%c(nx,ny,nz)) allocate(pdata%c(nx,ny,nz))
#endif /* DEBUG */ #endif /* DEBUG */
@ -1082,41 +1099,34 @@ module blocks
! !
!=============================================================================== !===============================================================================
! !
! deallocate_datablock: subroutine deallocates space occupied by a given data ! subroutine DEALLOCATE_DATABLOCK:
! block ! -------------------------------
!
! Subroutine deallocates space of the data block associated with the input
! pointer.
!
! Arguments:
!
! pdata - the pointer pointing to the data block for deallocating;
! !
!=============================================================================== !===============================================================================
! !
subroutine deallocate_datablock(pdata) subroutine deallocate_datablock(pdata)
! local variables are not implicit by default
!
implicit none implicit none
! input arguments ! subroutine arguments
! !
type(block_data), pointer, intent(inout) :: pdata type(block_data), pointer, intent(inout) :: pdata
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
!
! check if the input pointer is associated with a data block
! !
if (associated(pdata)) then if (associated(pdata)) then
! if this is the first block in the list, update the list_data pointer
!
if (pdata%meta%id .eq. list_data%meta%id) &
list_data => pdata%next
! if this is the last block in the list, update the last_data pointer
!
if (pdata%meta%id .eq. last_data%meta%id) &
last_data => pdata%prev
! update the pointer of previous and next blocks
!
if (associated(pdata%prev)) &
pdata%prev%next => pdata%next
if (associated(pdata%next)) &
pdata%next%prev => pdata%prev
! deallocate conservative variables ! deallocate conservative variables
! !
if (allocated(pdata%u0)) deallocate(pdata%u0) if (allocated(pdata%u0)) deallocate(pdata%u0)
@ -1131,7 +1141,7 @@ module blocks
if (allocated(pdata%f)) deallocate(pdata%f) if (allocated(pdata%f)) deallocate(pdata%f)
#ifdef DEBUG #ifdef DEBUG
! deallocate the refinement array ! deallocate the refinement critarion array
! !
if (allocated(pdata%c)) deallocate(pdata%c) if (allocated(pdata%c)) deallocate(pdata%c)
#endif /* DEBUG */ #endif /* DEBUG */
@ -1152,7 +1162,7 @@ module blocks
! !
dblocks = dblocks - 1 dblocks = dblocks - 1
end if end if ! pdata associated with a data block
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
@ -1160,29 +1170,38 @@ module blocks
! !
!=============================================================================== !===============================================================================
! !
! append_datablock: subroutine allocates space for one data block and appends it ! subroutine APPEND_DATABLOCK:
! to the data block list ! ---------------------------
!
! Subroutine allocates space for one data block and appends it to the data
! block list returning a pointer associated with it.
!
! Arguments:
!
! pdata - the pointer associated with the created data block;
! !
!=============================================================================== !===============================================================================
! !
subroutine append_datablock(pdata) subroutine append_datablock(pdata)
! local variables are not implicit by default
!
implicit none implicit none
! output arguments ! subroutine arguments
! !
type(block_data), pointer, intent(out) :: pdata type(block_data), pointer, intent(out) :: pdata
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
! allocate block ! allocate the data block
! !
call allocate_datablock(pdata) call allocate_datablock(pdata)
! add to the list ! add the allocated block to the data block list
! !
if (associated(last_data)) then if (associated(last_data)) then
pdata%prev => last_data pdata%prev => last_data
last_data%next => pdata last_data%next => pdata
else else
list_data => pdata list_data => pdata
@ -1198,6 +1217,66 @@ module blocks
! !
!=============================================================================== !===============================================================================
! !
! subroutine REMOVE_DATABLOCK:
! ---------------------------
!
! Subroutine removes a data block associated with the input pointer from
! the data block list, and deallocates space used by this block.
!
! Arguments:
!
! pdata - the pointer pointing to the data block for removing;
!
!===============================================================================
!
subroutine remove_datablock(pdata)
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
type(block_data), pointer, intent(inout) :: pdata
!
!-------------------------------------------------------------------------------
!
! check if the input pointer is associated with a data block
!
if (associated(pdata)) then
! remove from the meta block list if the meta pointer is set
!
if (associated(pdata%meta)) then
! if this is the first block in the list, update the list_data pointer
!
if (pdata%meta%id == list_data%meta%id) list_data => pdata%next
! if this is the last block in the list, update the last_data pointer
!
if (pdata%meta%id == last_data%meta%id) last_data => pdata%prev
! update the pointer of previous and next blocks
!
if (associated(pdata%prev)) pdata%prev%next => pdata%next
if (associated(pdata%next)) pdata%next%prev => pdata%prev
end if ! %meta associated
! deallocate the associated data block
!
call deallocate_datablock(pdata)
end if ! pdata associated with a data block
!-------------------------------------------------------------------------------
!
end subroutine remove_datablock
!
!===============================================================================
!
! datablock_set_dims: subroutine sets the number of variables and dimensions ! datablock_set_dims: subroutine sets the number of variables and dimensions
! for arrays allocated in data blocks ! for arrays allocated in data blocks
! !