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

BLOCKS: Add status argument to insert_metablock_after/before().

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2019-02-11 12:26:57 -02:00
parent 5caf3f37cf
commit 4e688b8fcd
1 changed files with 29 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
sources/blocks.F90
View File

@ -1466,6 +1466,7 @@ module blocks
! local variables
!
logical, save :: first = .true.
integer :: status
integer :: p , q
integer :: i , j , k
integer :: ip, jp, kp, np
@ -1587,16 +1588,20 @@ module blocks
! insert a new meta block after pmeta and associate it with pchild
!
call insert_metablock_after(pmeta, pchild)
call insert_metablock_after(pmeta, pchild, status)
if (status == 0) then
! set the child configuration number
!
call metablock_set_configuration(pchild, config(q,p))
call metablock_set_configuration(pchild, config(q,p))
! associate the parent's children array element with the freshly created
! meta block
!
pmeta%child(order(q,p))%ptr => pchild
pmeta%child(order(q,p))%ptr => pchild
end if
end do ! nchildren
@ -4009,12 +4014,13 @@ module blocks
!
! Arguments:
!
! pmeta - the pointer associated with the newly appended meta block;
! pprev - the pointer after which the new block has to be inserted;
! pmeta - the pointer associated with the newly appended meta block;
! pprev - the pointer after which the new block has to be inserted;
! status - the flag indicating success or failure;
!
!===============================================================================
!
subroutine insert_metablock_after(pprev, pmeta)
subroutine insert_metablock_after(pprev, pmeta, status)
! import external procedures
!
@ -4028,10 +4034,7 @@ module blocks
!
type(block_meta), pointer, intent(in) :: pprev
type(block_meta), pointer, intent(out) :: pmeta
! local variables
!
integer :: status
integer , intent(out) :: status
! local parameters
!
@ -4061,34 +4064,25 @@ module blocks
if (associated(pprev%next)) pprev%next%prev => pmeta
pprev%next => pmeta
! check if last_meta is associated
!
if (associated(last_meta)) then
! update the last_meta pointer if necessary
!
if (associated(last_meta)) then
if (pprev%id == last_meta%id) last_meta => pmeta
else
! strange situation, pprev is associated, but last_meta not
!
write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "Argument pprev is associated but last_meta is not!"
status = 1
return
end if
else
! if pprev is null and list_meta is associated, there is something wrong
!
else
if (associated(list_meta)) then
! strange situation, pprev is null but list_meta is associated
!
write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "Argument pprev is null but list_meta is associated!"
status = 1
return
else
! pprev and list_meta are nulls, so add the first block to the list by
@ -4120,12 +4114,13 @@ module blocks
!
! Arguments:
!
! pmeta - the pointer associated with the newly appended meta block;
! pnext - the pointer before which the new block has to be inserted;
! pmeta - the pointer associated with the newly appended meta block;
! pnext - the pointer before which the new block has to be inserted;
! status - the flag indicating success or failure;
!
!===============================================================================
!
subroutine insert_metablock_before(pnext, pmeta)
subroutine insert_metablock_before(pnext, pmeta, status)
! import external procedures
!
@ -4139,10 +4134,7 @@ module blocks
!
type(block_meta), pointer, intent(in) :: pnext
type(block_meta), pointer, intent(out) :: pmeta
! local variables
!
integer :: status
integer , intent(out) :: status
! local parameters
!
@ -4172,21 +4164,15 @@ module blocks
if (associated(pnext%prev)) pnext%prev%next => pmeta
pnext%prev => pmeta
! check if list_meta is associated
! update the last_meta pointer if necessary
!
if (associated(list_meta)) then
! update the list_meta pointer if necessary
!
if (pnext%id == list_meta%id) list_meta => pmeta
else
! strange situation, pnext is associated, but list_meta not
!
write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "Argument pnext is associated but list_meta is not!"
status = 1
return
end if
else
@ -4194,12 +4180,10 @@ module blocks
! if pnext is null and last_meta is associated, there is something wrong
!
if (associated(last_meta)) then
! strange situation, pnext is null but last_meta is associated
!
write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "Argument pnext is null but last_meta is associated!"
status = 1
return
else
! pnext and last_meta are nulls, so add the first block to the list by