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

cmorency at geodynamics.org cmorency at geodynamics.org
Fri Oct 2 07:54:04 PDT 2009


Author: cmorency
Date: 2009-10-02 07:54:04 -0700 (Fri, 02 Oct 2009)
New Revision: 15738

Modified:
   seismo/2D/SPECFEM2D/trunk/specfem2D.F90
Log:
Corrected calculation of reconstructed poroelastic field for adjoint calculation.


Modified: seismo/2D/SPECFEM2D/trunk/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/specfem2D.F90	2009-10-02 00:39:07 UTC (rev 15737)
+++ seismo/2D/SPECFEM2D/trunk/specfem2D.F90	2009-10-02 14:54:04 UTC (rev 15738)
@@ -3020,12 +3020,12 @@
       do ispec = 1,nspec_xmin
 
      if(p_sv)then!P-SV waves
-       do id =1,2
          do i=1,NGLLZ
-     read(35) b_absorb_elastic_left(id,i,ispec,it)
+     read(35) b_absorb_elastic_left(1,i,ispec,it)
          enddo
-       enddo
-       b_absorb_elastic_left(3,:,ispec,it) = b_absorb_elastic_left(2,:,ispec,it)
+         do i=1,NGLLZ
+     read(35) b_absorb_elastic_left(3,i,ispec,it)
+         enddo
        b_absorb_elastic_left(2,:,ispec,it) = ZERO
      else!SH (membrane) waves
          do i=1,NGLLZ
@@ -3043,12 +3043,12 @@
       do ispec = 1,nspec_xmax
 
      if(p_sv)then!P-SV waves
-       do id =1,2
          do i=1,NGLLZ
-     read(36) b_absorb_elastic_right(id,i,ispec,it)
+     read(36) b_absorb_elastic_right(1,i,ispec,it)
          enddo
-       enddo
-       b_absorb_elastic_right(3,:,ispec,it) = b_absorb_elastic_right(2,:,ispec,it)
+         do i=1,NGLLZ
+     read(36) b_absorb_elastic_right(3,i,ispec,it)
+         enddo
        b_absorb_elastic_right(2,:,ispec,it) = ZERO
      else!SH (membrane) waves
          do i=1,NGLLZ
@@ -3066,12 +3066,12 @@
       do ispec = 1,nspec_zmin
 
      if(p_sv)then!P-SV waves
-       do id =1,2
          do i=1,NGLLX
-     read(37) b_absorb_elastic_bottom(id,i,ispec,it)
+     read(37) b_absorb_elastic_bottom(1,i,ispec,it)
          enddo
-       enddo
-       b_absorb_elastic_bottom(3,:,ispec,it) = b_absorb_elastic_bottom(2,:,ispec,it)
+         do i=1,NGLLX
+     read(37) b_absorb_elastic_bottom(3,i,ispec,it)
+         enddo
        b_absorb_elastic_bottom(2,:,ispec,it) = ZERO
      else!SH (membrane) waves
          do i=1,NGLLZ
@@ -3089,12 +3089,12 @@
       do ispec = 1,nspec_zmax
 
      if(p_sv)then!P-SV waves
-       do id =1,2
          do i=1,NGLLX
-     read(38) b_absorb_elastic_top(id,i,ispec,it)
+     read(38) b_absorb_elastic_top(1,i,ispec,it)
          enddo
-       enddo
-       b_absorb_elastic_top(3,:,ispec,it) = b_absorb_elastic_top(2,:,ispec,it)
+         do i=1,NGLLX
+     read(38) b_absorb_elastic_top(3,i,ispec,it)
+         enddo
        b_absorb_elastic_top(2,:,ispec,it) = ZERO
      else!SH (membrane) waves
          do i=1,NGLLZ
@@ -3274,7 +3274,7 @@
    if(any_poroelastic) then
     write(outputname,'(a,i6.6,a)') 'lastframe_poroelastic_s',myrank,'.bin'
     open(unit=55,file='OUTPUT_FILES/'//outputname,status='old',action='read',form='unformatted')
-    write(outputname,'(a,i6.6,a)') 'lastframe_poroelastic_s',myrank,'.bin'
+    write(outputname,'(a,i6.6,a)') 'lastframe_poroelastic_w',myrank,'.bin'
     open(unit=56,file='OUTPUT_FILES/'//outputname,status='old',action='read',form='unformatted')
        do j=1,npoin
       read(55) (b_displs_poroelastic(i,j), i=1,NDIM), &



More information about the CIG-COMMITS mailing list