[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