[cig-commits] r18903 - seismo/2D/SPECFEM2D/trunk/src/specfem2D
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Wed Sep 14 08:53:45 PDT 2011
Author: dkomati1
Date: 2011-09-14 08:53:45 -0700 (Wed, 14 Sep 2011)
New Revision: 18903
Modified:
seismo/2D/SPECFEM2D/trunk/src/specfem2D/noise_tomography.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/paco_beyond_critical.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90
Log:
fixed array dimensions in the plane wave routines (one of the dimensions was increased from 2 to 3 to handle SH waves in addition to P/SV)
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/noise_tomography.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/noise_tomography.f90 2011-09-13 16:06:31 UTC (rev 18902)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/noise_tomography.f90 2011-09-14 15:53:45 UTC (rev 18903)
@@ -497,7 +497,6 @@
!local parameters
integer :: i,j,iglob,ispec
- real(kind=CUSTOM_REAL) :: xx,zz
do ispec = 1, nspec
do j = 1, NGLLZ
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/paco_beyond_critical.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/paco_beyond_critical.f90 2011-09-13 16:06:31 UTC (rev 18902)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/paco_beyond_critical.f90 2011-09-14 15:53:45 UTC (rev 18903)
@@ -36,9 +36,9 @@
double precision, dimension(nbot,NSTEP_global) :: v0x_bot,v0z_bot, t0x_bot,t0z_bot
double precision, dimension(2,nglob) :: coord
- real(kind=CUSTOM_REAL), dimension(2,nglob) :: displ_elastic
- real(kind=CUSTOM_REAL), dimension(2,nglob) :: veloc_elastic
- real(kind=CUSTOM_REAL), dimension(2,nglob) :: accel_elastic
+ real(kind=CUSTOM_REAL), dimension(3,nglob) :: displ_elastic
+ real(kind=CUSTOM_REAL), dimension(3,nglob) :: veloc_elastic
+ real(kind=CUSTOM_REAL), dimension(3,nglob) :: accel_elastic
integer, dimension(:),allocatable :: local_pt
@@ -287,15 +287,15 @@
call paco_convolve_fft(Field_Ux,1,NSTEP_local,dt,NFREC,temp_field,TP,TS)
displ_elastic(1,indice)=temp_field(1)
call paco_convolve_fft(Field_Uz,1,NSTEP_local,dt,NFREC,temp_field,TP,TS)
- displ_elastic(2,indice)=temp_field(1)
+ displ_elastic(3,indice)=temp_field(1)
call paco_convolve_fft(Field_Ux,2,NSTEP_local,dt,NFREC,temp_field,TP,TS)
veloc_elastic(1,indice)=temp_field(1)
call paco_convolve_fft(Field_Uz,2,NSTEP_local,dt,NFREC,temp_field,TP,TS)
- veloc_elastic(2,indice)=temp_field(1)
+ veloc_elastic(3,indice)=temp_field(1)
call paco_convolve_fft(Field_Ux,3,NSTEP_local,dt,NFREC,temp_field,TP,TS)
accel_elastic(1,indice)=temp_field(1)
call paco_convolve_fft(Field_Uz,3,NSTEP_local,dt,NFREC,temp_field,TP,TS)
- accel_elastic(2,indice)=temp_field(1)
+ accel_elastic(3,indice)=temp_field(1)
! absorbing boundaries
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90 2011-09-13 16:06:31 UTC (rev 18902)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90 2011-09-14 15:53:45 UTC (rev 18903)
@@ -699,7 +699,6 @@
integer , dimension(:), allocatable :: left_bound,right_bound,bot_bound
double precision , dimension(:,:), allocatable :: v0x_left,v0z_left,v0x_right,v0z_right,v0x_bot,v0z_bot
double precision , dimension(:,:), allocatable :: t0x_left,t0z_left,t0x_right,t0z_right,t0x_bot,t0z_bot
- real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: accel_paco,veloc_paco,displ_paco
integer count_left,count_right,count_bottom
logical :: over_critical_angle
@@ -2939,32 +2938,17 @@
allocate(t0x_bot(count_bottom,NSTEP))
allocate(t0z_bot(count_bottom,NSTEP))
- allocate(displ_paco(NDIM,nglob))
- allocate(veloc_paco(NDIM,nglob))
- allocate(accel_paco(NDIM,nglob))
-
! call Paco's routine to compute in frequency and convert to time by Fourier transform
call paco_beyond_critical(coord,nglob,deltat,NSTEP,angleforce(1),&
- f0(1),cploc,csloc,TURN_ATTENUATION_ON,QKappa_attenuation(1),source_type(1),v0x_left,v0z_left,&
- v0x_right,v0z_right,v0x_bot,v0z_bot,t0x_left,t0z_left,t0x_right,t0z_right,&
- t0x_bot,t0z_bot,left_bound(1:count_left),right_bound(1:count_right),bot_bound(1:count_bottom)&
- ,count_left,count_right,count_bottom,displ_paco,veloc_paco,accel_paco)
+ f0(1),cploc,csloc,TURN_ATTENUATION_ON,QKappa_attenuation(1),source_type(1),v0x_left,v0z_left, &
+ v0x_right,v0z_right,v0x_bot,v0z_bot,t0x_left,t0z_left,t0x_right,t0z_right, &
+ t0x_bot,t0z_bot,left_bound(1:count_left),right_bound(1:count_right),bot_bound(1:count_bottom), &
+ count_left,count_right,count_bottom,displ_elastic,veloc_elastic,accel_elastic)
- displ_elastic(1,:) = displ_paco(1,:)
- displ_elastic(3,:) = displ_paco(2,:)
- veloc_elastic(1,:) = veloc_paco(1,:)
- veloc_elastic(3,:) = veloc_paco(2,:)
- accel_elastic(1,:) = accel_paco(1,:)
- accel_elastic(3,:) = accel_paco(2,:)
-
deallocate(left_bound)
deallocate(right_bound)
deallocate(bot_bound)
- deallocate(displ_paco)
- deallocate(veloc_paco)
- deallocate(accel_paco)
-
if (myrank == 0) then
write(IOUT,*) '***********'
write(IOUT,*) 'done calculating the initial wave field'
@@ -6090,7 +6074,7 @@
do j = 1, NGLLZ
do i = 1, NGLLX
iglob = ibool(i,j,ispec)
- if (.not. assign_external_model) then
+ if (.not. assign_external_model) then
kappal_ac_global(iglob) = poroelastcoef(3,1,kmato(ispec))
rhol_ac_global(iglob) = density(1,kmato(ispec))
else
@@ -6178,7 +6162,7 @@
do j = 1, NGLLZ
do i = 1, NGLLX
iglob = ibool(i,j,ispec)
- if (.not. assign_external_model) then
+ if (.not. assign_external_model) then
mul_global(iglob) = poroelastcoef(2,1,kmato(ispec))
kappal_global(iglob) = poroelastcoef(3,1,kmato(ispec)) &
- 4._CUSTOM_REAL*mul_global(iglob)/3._CUSTOM_REAL
More information about the CIG-COMMITS
mailing list