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

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>

sources/blocks.F90

@@ -504,7 +504,7 @@ module blocks
 
 ! 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
 !
@@ -591,11 +591,12 @@ module blocks
 !
 !   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
 !
@@ -604,10 +605,7 @@ module blocks
 ! subroutine arguments
 !
     type(block_meta), pointer, intent(out) :: pmeta
-
-! local variables
-!
-    integer :: status
+    integer                  , intent(out) :: status
 !
 !-------------------------------------------------------------------------------
 !
@@ -658,11 +656,12 @@ module blocks
 !
 !   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
 !
@@ -675,10 +674,7 @@ module blocks
 ! subroutine arguments
 !
     type(block_meta), pointer, intent(inout) :: pmeta
-
-! local variables
-!
-    integer :: status
+    integer                  , intent(out)   :: status
 
 ! local parameters
 !
@@ -722,6 +718,7 @@ module blocks
 !
       write(error_unit,"('[',a,']: ',a)") trim(loc)                            &
                       , "Null pointer argument to meta block!"
+      status = 1
 
     end if
 
@@ -2592,6 +2589,7 @@ module blocks
 
 ! local variables
 !
+    integer       :: status
     integer       :: l , p , q
     integer       :: i , j , k
     integer       :: ip, jp, kp
@@ -3052,7 +3050,7 @@ module blocks
 
 ! 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
 

sources/domains.F90

@@ -185,6 +185,7 @@ module domains
 
 ! local variables
 !
+    integer      :: status
     integer      :: i, j, k, n, p, ic, jc, kc
     real(kind=8) :: xl, xmn, xmx, yl, ymn, ymx, zl, zmn, zmx
 
@@ -262,7 +263,7 @@ module domains
 
 ! 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
 !

sources/io.F90

@@ -1994,6 +1994,7 @@ module io
     integer        :: ierr, l
     integer        :: lndims, lmblocks, lnleafs, llast_id
     integer        :: lncells, lnproc, lnseeds
+    integer        :: status
 
 ! local pointers
 !
@@ -2080,7 +2081,7 @@ module io
 ! allocate all metablocks
 !
     do l = 1, lmblocks
-      call append_metablock(pmeta)
+      call append_metablock(pmeta, status)
     end do
 
 ! check if the number of created metablocks is equal to lbmcloks