[cig-commits] r12484 - seismo/2D/SPECFEM2D/trunk

[dkomati1 at geodynamics.org]

Author: dkomati1
Date: 2008-07-29 07:31:00 -0700 (Tue, 29 Jul 2008)
New Revision: 12484

Modified:
   seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90
   seismo/2D/SPECFEM2D/trunk/specfem2D.F90
Log:
fixed the order in which the ACTUALLY_IMPLEMENT_PERM_WHOLE is tested when implementing the Cuthill-McKee permutation


Modified: seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90	2008-07-29 13:01:39 UTC (rev 12483)
+++ seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90	2008-07-29 14:31:00 UTC (rev 12484)
@@ -466,7 +466,7 @@
   end do
 
   do inum_interface = 1, ninterface_acoustic*2
-  
+
     call MPI_Wait (tab_requests_send_recv_acoustic(inum_interface), status_acoustic, ier)
 
   enddo
@@ -573,15 +573,15 @@
     if ( ier /= MPI_SUCCESS ) then
       call exit_mpi('MPI_Irecv unsuccessful in assemble_MPI_vector_el')
     end if
-    
+
   end do
 
   do inum_interface = 1, ninterface_elastic*2
-  
+
     call MPI_Wait (tab_requests_send_recv_elastic(inum_interface), status_elastic, ier)
 
   enddo
-  
+
   do inum_interface = 1, ninterface_elastic
 
      num_interface = inum_interfaces_elastic(inum_interface)

Modified: seismo/2D/SPECFEM2D/trunk/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/specfem2D.F90	2008-07-29 13:01:39 UTC (rev 12483)
+++ seismo/2D/SPECFEM2D/trunk/specfem2D.F90	2008-07-29 14:31:00 UTC (rev 12484)
@@ -1449,71 +1449,56 @@
 
   allocate(perm(nspec))
 
-  if(ACTUALLY_IMPLEMENT_PERM_OUT) then
+! use identity permutation by default
+  do ispec = 1,nspec
+    perm(ispec) = ispec
+  enddo
 
-  allocate(check_perm(nspec_outer))
-  call get_perm(ibool_outer,perm(1:nspec_outer),LIMIT_MULTI_CUTHILL,nspec_outer,npoin_outer)
+  if(ACTUALLY_IMPLEMENT_PERM_WHOLE) then
+
+    allocate(check_perm(nspec))
+    call get_perm(ibool,perm,LIMIT_MULTI_CUTHILL,nspec,npoin)
 ! check that the permutation obtained is bijective
-  check_perm(:) = -1
-  do ispec = 1,nspec_outer
-    check_perm(perm(ispec)) = ispec
-  enddo
-  if(minval(check_perm) /= 1) stop 'minval check_perm is incorrect for outer'
-  if(maxval(check_perm) /= nspec_outer) stop 'maxval check_perm is incorrect for outer'
-  deallocate(check_perm)
-  deallocate(ibool_outer)
+    check_perm(:) = -1
+    do ispec = 1,nspec
+      check_perm(perm(ispec)) = ispec
+    enddo
+    if(minval(check_perm) /= 1) stop 'minval check_perm is incorrect for whole'
+    if(maxval(check_perm) /= nspec) stop 'maxval check_perm is incorrect for whole'
+    deallocate(check_perm)
 
   else
-! use identity permutation if flag is off
+
+  if(ACTUALLY_IMPLEMENT_PERM_OUT) then
+    allocate(check_perm(nspec_outer))
+    call get_perm(ibool_outer,perm(1:nspec_outer),LIMIT_MULTI_CUTHILL,nspec_outer,npoin_outer)
+! check that the permutation obtained is bijective
+    check_perm(:) = -1
     do ispec = 1,nspec_outer
-      perm(ispec) = ispec
+      check_perm(perm(ispec)) = ispec
     enddo
+    if(minval(check_perm) /= 1) stop 'minval check_perm is incorrect for outer'
+    if(maxval(check_perm) /= nspec_outer) stop 'maxval check_perm is incorrect for outer'
+    deallocate(check_perm)
+    deallocate(ibool_outer)
   endif
 
   if(ACTUALLY_IMPLEMENT_PERM_INN) then
-
-  allocate(check_perm(nspec_inner))
-  call get_perm(ibool_inner,perm(nspec_outer+1:nspec),LIMIT_MULTI_CUTHILL,nspec_inner,npoin_inner)
+    allocate(check_perm(nspec_inner))
+    call get_perm(ibool_inner,perm(nspec_outer+1:nspec),LIMIT_MULTI_CUTHILL,nspec_inner,npoin_inner)
 ! check that the permutation obtained is bijective
-  check_perm(:) = -1
-  do ispec = 1,nspec_inner
-    check_perm(perm(nspec_outer+ispec)) = ispec
-  enddo
-  if(minval(check_perm) /= 1) stop 'minval check_perm is incorrect for inner'
-  if(maxval(check_perm) /= nspec_inner) stop 'maxval check_perm is incorrect for inner'
-  deallocate(check_perm)
-! add the right offset
-  perm(nspec_outer+1:nspec) = perm(nspec_outer+1:nspec) + nspec_outer
-
-  deallocate(ibool_inner)
-
-  else
-! use identity permutation if flag is off
-    do ispec = nspec_outer+1,nspec
-      perm(ispec) = ispec
+    check_perm(:) = -1
+    do ispec = 1,nspec_inner
+      check_perm(perm(nspec_outer+ispec)) = ispec
     enddo
+    if(minval(check_perm) /= 1) stop 'minval check_perm is incorrect for inner'
+    if(maxval(check_perm) /= nspec_inner) stop 'maxval check_perm is incorrect for inner'
+    deallocate(check_perm)
+! add the right offset
+    perm(nspec_outer+1:nspec) = perm(nspec_outer+1:nspec) + nspec_outer
+    deallocate(ibool_inner)
   endif
 
-  if(ACTUALLY_IMPLEMENT_PERM_WHOLE) then
-
-  allocate(check_perm(nspec))
-  call get_perm(ibool,perm(1:nspec),LIMIT_MULTI_CUTHILL,nspec,npoin)
-! check that the permutation obtained is bijective
-  check_perm(:) = -1
-  do ispec = 1,nspec
-    check_perm(perm(ispec)) = ispec
-  enddo
-  if(minval(check_perm) /= 1) stop 'minval check_perm is incorrect for whole'
-  if(maxval(check_perm) /= nspec) stop 'maxval check_perm is incorrect for whole'
-  deallocate(check_perm)
-! add the right offset
-  perm(1:nspec) = perm(1:nspec) + 0
-
-  else
-! use identity permutation if flag is off
-    do ispec = 1,nspec
-      perm(ispec) = ispec
-    enddo
   endif
 
 endif