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

nlegoff at geodynamics.org nlegoff at geodynamics.org
Wed Jul 30 07:49:37 PDT 2008


Author: nlegoff
Date: 2008-07-30 07:49:37 -0700 (Wed, 30 Jul 2008)
New Revision: 12497

Modified:
   seismo/2D/SPECFEM2D/trunk/specfem2D.F90
Log:
fixed a bug concerning acoustic free surface and Cuthill-McKee : it is now okay to have an acoustic free surface along with a Cuthill-McKee reordering of the elements.


Modified: seismo/2D/SPECFEM2D/trunk/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/specfem2D.F90	2008-07-30 14:09:30 UTC (rev 12496)
+++ seismo/2D/SPECFEM2D/trunk/specfem2D.F90	2008-07-30 14:49:37 UTC (rev 12497)
@@ -356,6 +356,7 @@
   logical, dimension(:), allocatable  :: mask_ispec_inner_outer
 
   integer, dimension(:,:), allocatable  :: acoustic_surface
+  integer :: acoustic_edges_read
   integer, dimension(:,:), allocatable  :: acoustic_edges
 
   integer  :: ixmin, ixmax, izmin, izmax
@@ -819,8 +820,16 @@
   if(nelem_acoustic_surface > 0) then
      if(ipass == 1) allocate(acoustic_edges(4,nelem_acoustic_surface))
       do inum = 1,nelem_acoustic_surface
-        read(IIN,*) acoustic_edges(1,inum), acoustic_edges(2,inum), acoustic_edges(3,inum), &
+        read(IIN,*) acoustic_edges_read, acoustic_edges(2,inum), acoustic_edges(3,inum), &
              acoustic_edges(4,inum)
+        if(ipass == 1) then
+          acoustic_edges(1,inum) = acoustic_edges_read
+        else if(ipass == 2) then
+          acoustic_edges(1,inum) = perm(antecedent_list(acoustic_edges_read))
+        else
+          call exit_MPI('error: maximum number of passes is 2')
+        endif
+
      enddo
      if(ipass == 1) allocate(acoustic_surface(5,nelem_acoustic_surface))
      call construct_acoustic_surface ( nspec, ngnod, knods, nelem_acoustic_surface, &



More information about the cig-commits mailing list