From e7c546980f4b4d66cd636fb80867d5c917c424db Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Tue, 12 Feb 2019 10:41:48 -0200
Subject: [PATCH] MESH: Add status argument to check_data_block_refinement().

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
 sources/mesh.F90 | 65 ++++++++++++++++++++----------------------------
 1 file changed, 27 insertions(+), 38 deletions(-)

diff --git a/sources/mesh.F90 b/sources/mesh.F90
index b0b4274..d8f1b1a 100644
--- a/sources/mesh.F90
+++ b/sources/mesh.F90
@@ -791,7 +791,8 @@ module mesh
 
 ! check the refinement criterion of all data blocks at the current process
 !
-    call check_data_block_refinement()
+    call check_data_block_refinement(status)
+    if (status /= 0) go to 100
 
 ! update neighbor refinement flags, if they need to be refined as well
 !
@@ -1474,10 +1475,13 @@ module mesh
 !   flags. If the MPI is used, the refinement flags are syncronized among all
 !   processes.
 !
+!   Arguments:
+!
+!     status - the subroutine call status: 0 for success, otherwise failure;
 !
 !===============================================================================
 !
-  subroutine check_data_block_refinement()
+  subroutine check_data_block_refinement(status)
 
 ! import external procedures and variables
 !
@@ -1499,6 +1503,10 @@ module mesh
 !
     implicit none
 
+! subroutine arguments
+!
+    integer, intent(out) :: status
+
 ! local pointers
 !
     type(block_meta), pointer :: pmeta
@@ -1521,34 +1529,25 @@ module mesh
 
 !-------------------------------------------------------------------------------
 !
+! reset the status flag
+!
+    status = 0
+
 ! 1) reset the refinement flag for all meta blocks
 !
-! assign pmeta to the first meta block on the list
-!
-    pmeta => list_meta
-
 ! iterate over all meta blocks
 !
+    pmeta => list_meta
     do while (associated(pmeta))
-
-! reset the refinement flag of pmeta
-!
       pmeta%refine = 0
-
-! assign pmeta to the next meta block
-!
       pmeta => pmeta%next
-
     end do ! iterate over meta blocks
 
 ! 2) determine the refinement of data block from the current process
 !
-! assign pdata to the first data block on the list
-!
-    pdata => list_data
-
 ! iterate over all data blocks
 !
+    pdata => list_data
     do while (associated(pdata))
 
 ! assign pmeta to the meta block associated with pdata
@@ -1588,10 +1587,7 @@ module mesh
       end if ! pmeta associated
 #endif /* DEBUG */
 
-! assign pdata to the next data block
-!
       pdata => pdata%next
-
    end do ! iterate over data blocks
 
 #ifdef MPI
@@ -1603,11 +1599,11 @@ module mesh
 
 ! allocate a buffer for the refinement flags
 !
-    allocate(ibuf(nl))
+    allocate(ibuf(nl), stat = status)
 
 ! check if the buffer was allocated successfully
 !
-    if (allocated(ibuf)) then
+    if (status == 0) then
 
 ! reset the buffer
 !
@@ -1617,12 +1613,9 @@ module mesh
 !
       l = 0
 
-! assign pmeta to the first meta block on the list
-!
-      pmeta => list_meta
-
 ! iterate over all meta blocks
 !
+      pmeta => list_meta
       do while (associated(pmeta))
 
 ! process only leafs
@@ -1639,10 +1632,7 @@ module mesh
 
         end if ! pmeta is a leaf
 
-! assign pmeta to the next meta block
-!
         pmeta => pmeta%next
-
       end do ! iterate over meta blocks
 
 ! update refinement flags across all processes
@@ -1653,12 +1643,9 @@ module mesh
 !
       l = 0
 
-! assign pmeta to the first meta block on the list
-!
-      pmeta => list_meta
-
 ! iterate over all meta blocks
 !
+      pmeta => list_meta
       do while (associated(pmeta))
 
 ! process only leafs
@@ -1684,19 +1671,21 @@ module mesh
 
         end if ! pmeta is a leaf
 
-! assign pmeta to the next meta block
-!
         pmeta => pmeta%next
-
       end do ! iterate over meta blocks
 
 ! deallocate the refinement flag buffer
 !
-      deallocate(ibuf)
+      deallocate(ibuf, stat = status)
+
+      if (status /= 0) then
+        write(error_unit,"('[',a,']: ',a)") trim(loc)                          &
+                        , "Refinement flag buffer could not be deallocated!"
+      end if
 
     else ! buffer couldn't be allocated
       write(error_unit,"('[',a,']: ',a)") trim(loc)                            &
-                     , "Refinement flag buffer could not be allocated!"
+                      , "Refinement flag buffer could not be allocated!"
     end if ! buffer couldn't be allocated
 #endif /* MPI */