BLOCKS: Add status argument to append/remove_metablock().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
4e688b8fcd
commit
9e9c903cc1
@ -504,7 +504,7 @@ module blocks
|
|||||||
|
|
||||||
! deallocate the last meta block
|
! deallocate the last meta block
|
||||||
!
|
!
|
||||||
call remove_metablock(pmeta)
|
call remove_metablock(pmeta, status)
|
||||||
|
|
||||||
! assign the pointer to the last block on the meta block list
|
! assign the pointer to the last block on the meta block list
|
||||||
!
|
!
|
||||||
@ -591,11 +591,12 @@ module blocks
|
|||||||
!
|
!
|
||||||
! Arguments:
|
! Arguments:
|
||||||
!
|
!
|
||||||
! pmeta - the pointer associated with the newly appended meta block;
|
! pmeta - the pointer associated with the newly appended meta block;
|
||||||
|
! status - the flag indicating success or failure;
|
||||||
!
|
!
|
||||||
!===============================================================================
|
!===============================================================================
|
||||||
!
|
!
|
||||||
subroutine append_metablock(pmeta)
|
subroutine append_metablock(pmeta, status)
|
||||||
|
|
||||||
! local variables are not implicit by default
|
! local variables are not implicit by default
|
||||||
!
|
!
|
||||||
@ -604,10 +605,7 @@ module blocks
|
|||||||
! subroutine arguments
|
! subroutine arguments
|
||||||
!
|
!
|
||||||
type(block_meta), pointer, intent(out) :: pmeta
|
type(block_meta), pointer, intent(out) :: pmeta
|
||||||
|
integer , intent(out) :: status
|
||||||
! local variables
|
|
||||||
!
|
|
||||||
integer :: status
|
|
||||||
!
|
!
|
||||||
!-------------------------------------------------------------------------------
|
!-------------------------------------------------------------------------------
|
||||||
!
|
!
|
||||||
@ -658,11 +656,12 @@ module blocks
|
|||||||
!
|
!
|
||||||
! Arguments:
|
! Arguments:
|
||||||
!
|
!
|
||||||
! pmeta - the pointer pointing to the meta block which will be removed;
|
! pmeta - the pointer pointing to the meta block which will be removed;
|
||||||
|
! status - the flag indicating success or failure;
|
||||||
!
|
!
|
||||||
!===============================================================================
|
!===============================================================================
|
||||||
!
|
!
|
||||||
subroutine remove_metablock(pmeta)
|
subroutine remove_metablock(pmeta, status)
|
||||||
|
|
||||||
! import external procedures
|
! import external procedures
|
||||||
!
|
!
|
||||||
@ -675,10 +674,7 @@ module blocks
|
|||||||
! subroutine arguments
|
! subroutine arguments
|
||||||
!
|
!
|
||||||
type(block_meta), pointer, intent(inout) :: pmeta
|
type(block_meta), pointer, intent(inout) :: pmeta
|
||||||
|
integer , intent(out) :: status
|
||||||
! local variables
|
|
||||||
!
|
|
||||||
integer :: status
|
|
||||||
|
|
||||||
! local parameters
|
! local parameters
|
||||||
!
|
!
|
||||||
@ -722,6 +718,7 @@ module blocks
|
|||||||
!
|
!
|
||||||
write(error_unit,"('[',a,']: ',a)") trim(loc) &
|
write(error_unit,"('[',a,']: ',a)") trim(loc) &
|
||||||
, "Null pointer argument to meta block!"
|
, "Null pointer argument to meta block!"
|
||||||
|
status = 1
|
||||||
|
|
||||||
end if
|
end if
|
||||||
|
|
||||||
@ -2592,6 +2589,7 @@ module blocks
|
|||||||
|
|
||||||
! local variables
|
! local variables
|
||||||
!
|
!
|
||||||
|
integer :: status
|
||||||
integer :: l , p , q
|
integer :: l , p , q
|
||||||
integer :: i , j , k
|
integer :: i , j , k
|
||||||
integer :: ip, jp, kp
|
integer :: ip, jp, kp
|
||||||
@ -3052,7 +3050,7 @@ module blocks
|
|||||||
|
|
||||||
! remove the child from the meta block list
|
! remove the child from the meta block list
|
||||||
!
|
!
|
||||||
call remove_metablock(pmeta%child(p)%ptr)
|
call remove_metablock(pmeta%child(p)%ptr, status)
|
||||||
|
|
||||||
end do ! nchild
|
end do ! nchild
|
||||||
|
|
||||||
|
@ -185,6 +185,7 @@ module domains
|
|||||||
|
|
||||||
! local variables
|
! local variables
|
||||||
!
|
!
|
||||||
|
integer :: status
|
||||||
integer :: i, j, k, n, p, ic, jc, kc
|
integer :: i, j, k, n, p, ic, jc, kc
|
||||||
real(kind=8) :: xl, xmn, xmx, yl, ymn, ymx, zl, zmn, zmx
|
real(kind=8) :: xl, xmn, xmx, yl, ymn, ymx, zl, zmn, zmx
|
||||||
|
|
||||||
@ -262,7 +263,7 @@ module domains
|
|||||||
|
|
||||||
! append a new metablock
|
! append a new metablock
|
||||||
!
|
!
|
||||||
call append_metablock(block_array(loc(1),loc(2),loc(3))%ptr)
|
call append_metablock(block_array(loc(1),loc(2),loc(3))%ptr, status)
|
||||||
|
|
||||||
! set the configuration type
|
! set the configuration type
|
||||||
!
|
!
|
||||||
|
@ -1994,6 +1994,7 @@ module io
|
|||||||
integer :: ierr, l
|
integer :: ierr, l
|
||||||
integer :: lndims, lmblocks, lnleafs, llast_id
|
integer :: lndims, lmblocks, lnleafs, llast_id
|
||||||
integer :: lncells, lnproc, lnseeds
|
integer :: lncells, lnproc, lnseeds
|
||||||
|
integer :: status
|
||||||
|
|
||||||
! local pointers
|
! local pointers
|
||||||
!
|
!
|
||||||
@ -2080,7 +2081,7 @@ module io
|
|||||||
! allocate all metablocks
|
! allocate all metablocks
|
||||||
!
|
!
|
||||||
do l = 1, lmblocks
|
do l = 1, lmblocks
|
||||||
call append_metablock(pmeta)
|
call append_metablock(pmeta, status)
|
||||||
end do
|
end do
|
||||||
|
|
||||||
! check if the number of created metablocks is equal to lbmcloks
|
! check if the number of created metablocks is equal to lbmcloks
|
||||||
|
Loading…
x
Reference in New Issue
Block a user