BLOCKS: Add status argument to allocate/deallocate_metablock().

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

sources/blocks.F90

@@ -604,12 +604,20 @@ module blocks
 ! subroutine arguments
 !
     type(block_meta), pointer, intent(out) :: pmeta
+
+! local variables
+!
+    integer :: status
 !
 !-------------------------------------------------------------------------------
 !
 ! allocate memory for the new meta block
 !
-    call allocate_metablock(pmeta)
+    call allocate_metablock(pmeta, status)
+
+! quit if block couldn't be allocated
+!
+    if (status /= 0) return
 
 ! check if there are any blocks in the meta block list
 !
@@ -668,6 +676,10 @@ module blocks
 !
     type(block_meta), pointer, intent(inout) :: pmeta
 
+! local variables
+!
+    integer :: status
+
 ! local parameters
 !
     character(len=*), parameter :: loc = 'BLOCKS::remove_metablock()'
@@ -702,7 +714,7 @@ module blocks
 
 ! deallocate memory used by the meta block
 !
-      call deallocate_metablock(pmeta)
+      call deallocate_metablock(pmeta, status)
 
     else
 
@@ -873,10 +885,15 @@ module blocks
 !   Arguments:
 !
 !     pmeta  - the pointer associated with the newly allocated meta block;
+!     status - the flag indicating success or failure;
 !
 !===============================================================================
 !
-  subroutine allocate_metablock(pmeta)
+  subroutine allocate_metablock(pmeta, status)
+
+! references
+!
+    use iso_fortran_env, only : error_unit
 
 ! local variables are not implicit by default
 !
@@ -885,10 +902,15 @@ module blocks
 ! subroutine arguments
 !
     type(block_meta), pointer, intent(out) :: pmeta
+    integer                  , intent(out) :: status
 
 ! local variables
 !
     integer :: n, i, j, k
+
+! local parameters
+!
+    character(len=*), parameter :: loc = 'BLOCKS::allocate_metablock()'
 !
 !-------------------------------------------------------------------------------
 !
@@ -900,7 +922,11 @@ module blocks
 
 ! allocate the meta block structure for one object
 !
-    allocate(pmeta)
+    allocate(pmeta, stat = status)
+
+! check if allocation succeeded
+!
+    if (status == 0) then
 
 ! nullify fields pointing to previous and next block on the meta block list
 !
@@ -978,6 +1004,11 @@ module blocks
       pmeta%zmin      = 0.0d+00
       pmeta%zmax      = 1.0d+00
 
+    else ! allocate
+      write(error_unit,"('[',a,']: ',a)") trim(loc)                            &
+                      , "Cannot allocate metablock!"
+    end if ! allocate
+
 #ifdef PROFILE
 ! stop accounting time for the meta block allocation
 !
@@ -1003,7 +1034,7 @@ module blocks
 !
 !===============================================================================
 !
-  subroutine deallocate_metablock(pmeta)
+  subroutine deallocate_metablock(pmeta, status)
 
 ! import external procedures
 !
@@ -1016,6 +1047,7 @@ module blocks
 ! subroutine arguments
 !
     type(block_meta), pointer, intent(inout) :: pmeta
+    integer                  , intent(out)   :: status
 
 ! local variables
 !
@@ -1088,7 +1120,7 @@ module blocks
 
 ! release the memory occupied by the block
 !
-      deallocate(pmeta)
+      deallocate(pmeta, stat = status)
 
 ! nullify the pointer to the deallocated meta block
 !
@@ -1100,6 +1132,7 @@ module blocks
 !
       write(error_unit,"('[',a,']: ',a)") trim(loc)                            &
                       , "Null pointer argument to meta block!"
+      status = 1
 
     end if
 
@@ -3955,6 +3988,10 @@ module blocks
     type(block_meta), pointer, intent(in)  :: pprev
     type(block_meta), pointer, intent(out) :: pmeta
 
+! local variables
+!
+    integer :: status
+
 ! local parameters
 !
     character(len=*), parameter :: loc = 'BLOCKS::insert_metablock_after()'
@@ -3963,7 +4000,11 @@ module blocks
 !
 ! allocate memory for the new meta block
 !
-    call allocate_metablock(pmeta)
+    call allocate_metablock(pmeta, status)
+
+! quit if block couldn't be allocated
+!
+    if (status /= 0) return
 
 ! if pprev is associated, insert the new block after it
 !
@@ -4058,6 +4099,10 @@ module blocks
     type(block_meta), pointer, intent(in)  :: pnext
     type(block_meta), pointer, intent(out) :: pmeta
 
+! local variables
+!
+    integer :: status
+
 ! local parameters
 !
     character(len=*), parameter :: loc = 'BLOCKS::insert_metablock_before()'
@@ -4066,7 +4111,11 @@ module blocks
 !
 ! allocate memory for the new meta block
 !
-    call allocate_metablock(pmeta)
+    call allocate_metablock(pmeta, status)
+
+! quit if block couldn't be allocated
+!
+    if (status /= 0) return
 
 ! if pnext is associated, insert the new block before it
 !