Merge branch 'master' into binaries

sources/mesh.F90

@@ -1527,128 +1527,100 @@ module mesh
 !
     status = 0
 
-! 1) check if the siblings of the block selected for derefinement, can be
+! 1) the block can be derefined only if all its children are selected for
-!    derefined as well, if not cancel the derefinement of all siblings
+!    the derefined; otherwise reset the derefinement both for the parent
-!
+!    and children;
-! iterate over levels and check sibling derefinement
 !
     do l = 2, toplev
 
       pmeta => list_meta
       do while (associated(pmeta))
 
-        if (pmeta%level == l) then
+        if (pmeta%leaf .and. pmeta%level == l) then
-          if (pmeta%leaf .and. pmeta%refine == -1) then
+          if (pmeta%refine == -1) then
             pparent => pmeta%parent
 
             do p = 1, nchildren
               pchild => pparent%child(p)%ptr
 
               flag(p) = pchild%leaf .and. pchild%refine == -1
-            end do ! over all children
+            end do
 
-! if children can be derefined, set the refine flag of the parent to -1,
+            if (all(flag)) then
-! otherwise, cancel the derefinement of all siblings
-!
-            if (any(flag)) then
               pparent%refine = -1
             else
               do p = 1, nchildren
                 pchild => pparent%child(p)%ptr
 
                 pchild%refine = max(0, pchild%refine)
-              end do ! children
+              end do
-            end if ! ~flag
+            end if
-          end if ! leafs selected for derefinement
+          end if
-        end if ! only block at level l
+        end if
 
         pmeta => pmeta%next
-      end do ! iterate over meta blocks
+      end do
 
-    end do ! levels
+    end do
 
 #ifdef MPI
-! 2) bring all siblings together to the same process
+! 2) bring all siblings to the same process, so we can merge them into a newly
+!    created data block of the parent;
 !
     pmeta => list_meta
 
     do while (associated(pmeta))
 
-! process only parent blocks (not leafs)
-!
       if (.not. pmeta%leaf) then
 
-! check if the first child is selected for derefinement
-!
         if (pmeta%refine == -1) then
 
           pchild => pmeta%child(1)%ptr
 
           pmeta%process = pchild%process
 
-! iterate over the remaining children and if any of them is not on
-! the same process, bring it to the parent's one
-!
           do p = 2, nchildren
-
             pchild => pmeta%child(p)%ptr
 
-! if pchild belongs to a different process move its data block to the process
-! of its parent
-!
             if (pchild%process /= pmeta%process) then
 
-! generate the tag for communication
+              itag = pchild%id
-!
-              itag = pchild%process * nprocs + pmeta%process + nprocs + p + 1
 
-! send the child's data block from its process to the parent's process,
-! and then deallocate it
-!
               if (pchild%process == nproc) then
-
+                call send_array(pmeta%process, itag, pchild%data%uu)
-                call send_array(pmeta%process, itag, pchild%data%uu(:,:,:,:,:))
 
                 call remove_datablock(pchild%data, status)
                 if (status /= 0) then
                   call print_message(loc, "Cannot remove the data block!")
                   go to 100
                 end if
+              end if
 
-              end if ! pchild%process == nproc
-
-! on the parent's process, allocate a newdata block, and associate the data
-! received from a different process
-!
               if (pmeta%process == nproc) then
-
                 call append_datablock(pdata, status)
                 if (status == 0) then
                   call link_blocks(pchild, pdata)
                 else
-                  call print_message(loc, "Cannot append a data block!")
+                  call print_message(loc, "Cannot append a new data block!")
                   go to 100
                 end if
 
-                call receive_array(pchild%process, itag, pdata%uu(:,:,:,:,:))
+                call receive_array(pchild%process, itag, pdata%uu)
+              end if
 
-              end if ! pmeta%process == nproc
-
-! set the current processor of the block
-!
               pchild%process = pmeta%process
 
-            end if ! pchild belongs to a different process
+            end if
-          end do ! children
+          end do
-        end if ! pmeta children are selected for derefinement
+
-      end if ! the block is parent
+        end if
+
+      end if
 
       pmeta => pmeta%next
-    end do ! iterate over meta blocks
+    end do
 #endif /* MPI */
 
-! error entry point
-!
     100 continue
 
 !-------------------------------------------------------------------------------