[cig-commits] r12375 - seismo/3D/SPECFEM3D_GLOBE/trunk

[dkomati1 at geodynamics.org]

Author: dkomati1
Date: 2008-07-04 15:34:43 -0700 (Fri, 04 Jul 2008)
New Revision: 12375

Modified:
   seismo/3D/SPECFEM3D_GLOBE/trunk/get_perm_cuthill_mckee.f90
Log:
added checks and stop statements if the routine detects that some elements are disconnected or that the mesh is composed of disconnected subsets


Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/get_perm_cuthill_mckee.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/get_perm_cuthill_mckee.f90	2008-07-03 22:46:50 UTC (rev 12374)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/get_perm_cuthill_mckee.f90	2008-07-04 22:34:43 UTC (rev 12375)
@@ -114,7 +114,8 @@
         istart = xadj(i)
         istop = xadj(i+1) - 1
         number_of_neighbors = istop-istart+1
-        if(number_of_neighbors < 1 .or. number_of_neighbors > MAX_NUMBER_OF_NEIGHBORS) stop 'incorrect number of neighbors'
+        if(number_of_neighbors < 1) stop 'error: your mesh seems to have at least one element not connected to any other'
+        if(number_of_neighbors > MAX_NUMBER_OF_NEIGHBORS) stop 'error: your mesh seems to have an unlikely high valence'
     enddo
     deallocate(ne,np)
 
@@ -644,6 +645,18 @@
 !--------------------------------------------------------------- Local Variables
   integer i, j, ideg, lbegin, lvlend, lvsize, nxt, nbr, node
 
+!! DK DK added a test to detect disconnected subsets in the mesh
+!! DK DK (in which case Cuthill-McKee fails and should be turned off)
+  if(root > nbnodes+1) stop 'error: root > nbnodes+1 in Cuthill-McKee'
+  if(root < 1) then
+    print *,'error: root < 1 in Cuthill-McKee; you probably have a mesh composed of'
+    print *,'two disconnected subsets of elements, in which case Cuthill-McKee fails and should be turned off.'
+    print *,'please set PERFORM_CUTHILL_MCKEE = .false. in constants.h and recompile.'
+    print *,'please also doublecheck that you indeed want to run two separate meshes simultaneously,'
+    print *,'which is extremely unusual (but formally not incorrect).'
+    stop 'fatal error in Cuthill-McKee'
+  endif
+
 ! The sign of xadj(I) is used to indicate if node i has been considered
   xadj(root) = -xadj(root)
   level(1)   = root