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

63
sources/mesh.F90
View File

@ -791,7 +791,8 @@ module mesh
! check the refinement criterion of all data blocks at the current process ! 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 ! 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 ! flags. If the MPI is used, the refinement flags are syncronized among all
! processes. ! 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 ! import external procedures and variables
! !
@ -1499,6 +1503,10 @@ module mesh
! !
implicit none implicit none
! subroutine arguments
!
integer, intent(out) :: status
! local pointers ! local pointers
! !
type(block_meta), pointer :: pmeta 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 ! 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 ! iterate over all meta blocks
! !
pmeta => list_meta
do while (associated(pmeta)) do while (associated(pmeta))
! reset the refinement flag of pmeta
!
pmeta%refine = 0 pmeta%refine = 0
! assign pmeta to the next meta block
!
pmeta => pmeta%next pmeta => pmeta%next
end do ! iterate over meta blocks end do ! iterate over meta blocks
! 2) determine the refinement of data block from the current process ! 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 ! iterate over all data blocks
! !
pdata => list_data
do while (associated(pdata)) do while (associated(pdata))
! assign pmeta to the meta block associated with pdata ! assign pmeta to the meta block associated with pdata
@ -1588,10 +1587,7 @@ module mesh
end if ! pmeta associated end if ! pmeta associated
#endif /* DEBUG */ #endif /* DEBUG */
! assign pdata to the next data block
!
pdata => pdata%next pdata => pdata%next
end do ! iterate over data blocks end do ! iterate over data blocks
#ifdef MPI #ifdef MPI
@ -1603,11 +1599,11 @@ module mesh
! allocate a buffer for the refinement flags ! allocate a buffer for the refinement flags
! !
allocate(ibuf(nl)) allocate(ibuf(nl), stat = status)
! check if the buffer was allocated successfully ! check if the buffer was allocated successfully
! !
if (allocated(ibuf)) then if (status == 0) then
! reset the buffer ! reset the buffer
! !
@ -1617,12 +1613,9 @@ module mesh
! !
l = 0 l = 0
! assign pmeta to the first meta block on the list
!
pmeta => list_meta
! iterate over all meta blocks ! iterate over all meta blocks
! !
pmeta => list_meta
do while (associated(pmeta)) do while (associated(pmeta))
! process only leafs ! process only leafs
@ -1639,10 +1632,7 @@ module mesh
end if ! pmeta is a leaf end if ! pmeta is a leaf
! assign pmeta to the next meta block
!
pmeta => pmeta%next pmeta => pmeta%next
end do ! iterate over meta blocks end do ! iterate over meta blocks
! update refinement flags across all processes ! update refinement flags across all processes
@ -1653,12 +1643,9 @@ module mesh
! !
l = 0 l = 0
! assign pmeta to the first meta block on the list
!
pmeta => list_meta
! iterate over all meta blocks ! iterate over all meta blocks
! !
pmeta => list_meta
do while (associated(pmeta)) do while (associated(pmeta))
! process only leafs ! process only leafs
@ -1684,15 +1671,17 @@ module mesh
end if ! pmeta is a leaf end if ! pmeta is a leaf
! assign pmeta to the next meta block
!
pmeta => pmeta%next pmeta => pmeta%next
end do ! iterate over meta blocks end do ! iterate over meta blocks
! deallocate the refinement flag buffer ! 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 else ! buffer couldn't be allocated
write(error_unit,"('[',a,']: ',a)") trim(loc) & write(error_unit,"('[',a,']: ',a)") trim(loc) &