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

BLOCKS: Add status argument to append/remove_metablock().

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2019-02-11 12:34:20 -02:00
parent 4e688b8fcd
commit 9e9c903cc1
3 changed files with 16 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
sources/blocks.F90
View File

@ -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

3
sources/domains.F90
View File

@ -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
! !

3
sources/io.F90
View File

@ -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