gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

BLOCKS: Add subroutine to prepare the vector of data blocks.

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-12-07 20:49:03 -03:00
parent c6fc8d5194
commit e20cd5de6c
1 changed files with 78 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
sources/blocks.F90
View File

@ -303,13 +303,18 @@ module blocks
type(block_data), pointer, save :: list_data, last_data
type(block_leaf), pointer, save :: list_leaf
! THE VECTOR OF DATA BLOCK POINTERS:
! =================================
!
type(pointer_data), dimension(:), allocatable :: data_blocks
! all variables and subroutines are private by default
!
private
! declare public pointers, structures, and variables
!
public :: pointer_meta, pointer_info
public :: pointer_meta, pointer_data, pointer_info
public :: block_meta, block_data, block_info, block_leaf
public :: list_meta, list_data, list_leaf
public :: ndims, nsides, nchildren, nregs
@ -331,7 +336,8 @@ module blocks
public :: metablock_set_configuration, metablock_set_refinement
public :: metablock_set_position, metablock_set_coordinates
public :: metablock_set_bounds, metablock_set_leaf, metablock_unset_leaf
public :: build_leaf_list
public :: build_leaf_list, build_datablock_list
public :: data_blocks
#ifdef DEBUG
public :: check_neighbors
#endif /* DEBUG */
@ -426,16 +432,29 @@ module blocks
!
subroutine finalize_blocks(status)
use iso_fortran_env, only : error_unit
implicit none
integer, intent(out) :: status
type(block_meta), pointer :: pmeta
character(len=*), parameter :: loc = 'BLOCKS::finalize_blocks()'
!-------------------------------------------------------------------------------
!
status = 0
! deallocate the vector of data blocks
!
if (allocated(data_blocks)) then
deallocate(data_blocks, stat=status)
if (status /= 0) &
write(error_unit,"('[',a,']: ',a)") trim(loc), &
"Could not deallocate the vector of data blocks!"
end if
! remove all metablocks
!
pmeta => last_meta
@ -3545,6 +3564,63 @@ module blocks
!
!===============================================================================
!
! subroutine BUILD_DATABLOCK_LIST:
! -------------------------------
!
! Subroutine builds the list of data blocks data_blocks.
!
! Arguments:
!
! status - the subroutine call status: 0 for success, otherwise failure;
!
!===============================================================================
!
subroutine build_datablock_list(status)
use iso_fortran_env, only : error_unit
implicit none
integer, intent(out) :: status
type(block_data), pointer :: pdata
integer :: l
character(len=*), parameter :: loc = 'BLOCKS::build_datablock_list()'
!-------------------------------------------------------------------------------
!
status = 0
if (allocated(data_blocks)) then
deallocate(data_blocks, stat=status)
if (status /= 0) &
write(error_unit,"('[',a,']: ',a)") trim(loc), &
"Could not deallocate the vector of data blocks!"
end if
allocate(data_blocks(dblocks), stat=status)
if (status == 0) then
l = 0
pdata => list_data
do while (associated(pdata))
l = l + 1
data_blocks(l)%ptr => pdata
pdata => pdata%next
end do
else
write(error_unit,"('[',a,']: ',a)") trim(loc), &
"Could not allocate the vector of data blocks!"
end if
!-------------------------------------------------------------------------------
!
end subroutine build_datablock_list
!
!===============================================================================
!
! subroutine SET_NEIGHBORS_REFINE:
! -------------------------------
!