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

MESH: Add status argument to check_data_block_refinement().

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2019-02-12 10:41:48 -02:00
parent 721cf8efae
commit e7c546980f
1 changed files with 27 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
sources/mesh.F90
View File

@ -791,7 +791,8 @@ module mesh
! check the refinement criterion of all data blocks at the current process
!
call check_data_block_refinement()
call check_data_block_refinement(status)
if (status /= 0) go to 100
! update neighbor refinement flags, if they need to be refined as well
!
@ -1474,10 +1475,13 @@ module mesh
! flags. If the MPI is used, the refinement flags are syncronized among all
! processes.
!
! Arguments:
!
! status - the subroutine call status: 0 for success, otherwise failure;
!
!===============================================================================
!
subroutine check_data_block_refinement()
subroutine check_data_block_refinement(status)
! import external procedures and variables
!
@ -1499,6 +1503,10 @@ module mesh
!
implicit none
! subroutine arguments
!
integer, intent(out) :: status
! local pointers
!
type(block_meta), pointer :: pmeta
@ -1521,34 +1529,25 @@ module mesh
!-------------------------------------------------------------------------------
!
! reset the status flag
!
status = 0
! 1) reset the refinement flag for all meta blocks
!
! assign pmeta to the first meta block on the list
!
pmeta => list_meta
! iterate over all meta blocks
!
pmeta => list_meta
do while (associated(pmeta))
! reset the refinement flag of pmeta
!
pmeta%refine = 0
! assign pmeta to the next meta block
!
pmeta => pmeta%next
end do ! iterate over meta blocks
! 2) determine the refinement of data block from the current process
!
! assign pdata to the first data block on the list
!
pdata => list_data
! iterate over all data blocks
!
pdata => list_data
do while (associated(pdata))
! assign pmeta to the meta block associated with pdata
@ -1588,10 +1587,7 @@ module mesh
end if ! pmeta associated
#endif /* DEBUG */
! assign pdata to the next data block
!
pdata => pdata%next
end do ! iterate over data blocks
#ifdef MPI
@ -1603,11 +1599,11 @@ module mesh
! allocate a buffer for the refinement flags
!
allocate(ibuf(nl))
allocate(ibuf(nl), stat = status)
! check if the buffer was allocated successfully
!
if (allocated(ibuf)) then
if (status == 0) then
! reset the buffer
!
@ -1617,12 +1613,9 @@ module mesh
!
l = 0
! assign pmeta to the first meta block on the list
!
pmeta => list_meta
! iterate over all meta blocks
!
pmeta => list_meta
do while (associated(pmeta))
! process only leafs
@ -1639,10 +1632,7 @@ module mesh
end if ! pmeta is a leaf
! assign pmeta to the next meta block
!
pmeta => pmeta%next
end do ! iterate over meta blocks
! update refinement flags across all processes
@ -1653,12 +1643,9 @@ module mesh
!
l = 0
! assign pmeta to the first meta block on the list
!
pmeta => list_meta
! iterate over all meta blocks
!
pmeta => list_meta
do while (associated(pmeta))
! process only leafs
@ -1684,19 +1671,21 @@ module mesh
end if ! pmeta is a leaf
! assign pmeta to the next meta block
!
pmeta => pmeta%next
end do ! iterate over meta blocks
! deallocate the refinement flag buffer
!
deallocate(ibuf)
deallocate(ibuf, stat = status)
if (status /= 0) then
write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "Refinement flag buffer could not be deallocated!"
end if
else ! buffer couldn't be allocated
write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "Refinement flag buffer could not be allocated!"
, "Refinement flag buffer could not be allocated!"
end if ! buffer couldn't be allocated
#endif /* MPI */