[cig-commits] r22967 - in seismo/3D/SPECFEM3D/trunk/src: generate_databases shared specfem3D
xie.zhinan at geodynamics.org
xie.zhinan at geodynamics.org
Tue Oct 22 02:55:50 PDT 2013
Author: xie.zhinan
Date: 2013-10-22 02:55:50 -0700 (Tue, 22 Oct 2013)
New Revision: 22967
Modified:
seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_mass_matrices.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases_par.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/memory_eval.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/pml_set_local_dampingcoeff.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/save_arrays_solver.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/save_arrays_solver_adios.F90
seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_acoustic_el.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_viscoelastic_ac.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_Dev.F90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_calling_routine.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_noDev.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_Dev.F90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/finalize_simulation.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/model_update.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_allocate_arrays.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_accel_contribution.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_memory_variables.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_par.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.F90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases_adios.F90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D_par.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/update_displacement_scheme.f90
Log:
commit the first version of CPML with varying alpha profile
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_mass_matrices.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_mass_matrices.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_mass_matrices.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -59,29 +59,6 @@
! returns elastic mass matrix
if( PML_CONDITIONS ) then
- if(ACOUSTIC_SIMULATION)then
- allocate(rmass_elastic_interface(nglob),stat=ier)
- if(ier /= 0) stop 'error allocating array rmass'
- rmass_elastic_interface(:) = 0._CUSTOM_REAL
- do ispec=1,nspec
- if( ispec_is_elastic(ispec) ) then
- do k=1,NGLLZ; do j=1,NGLLY; do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
- weight = wxgll(i)*wygll(j)*wzgll(k)
- jacobianl = jacobianstore(i,j,k,ispec)
-
- if(CUSTOM_REAL == SIZE_REAL) then
- rmass_elastic_interface(iglob) = rmass_elastic_interface(iglob) + &
- sngl( dble(jacobianl) * weight * dble(rhostore(i,j,k,ispec)) )
- else
- rmass_elastic_interface(iglob) = rmass_elastic_interface(iglob) + &
- jacobianl * weight * rhostore(i,j,k,ispec)
- endif
- enddo;enddo;enddo
- endif
- enddo
- endif
-
call create_mass_matrices_pml_elastic(nspec,ibool)
else
do ispec=1,nspec
@@ -115,36 +92,9 @@
allocate(rmass_acoustic(nglob),stat=ier); if(ier /= 0) stop 'error allocating array rmass_acoustic'
rmass_acoustic(:) = 0._CUSTOM_REAL
- allocate(rmass_acoustic_interface(nglob),stat=ier); if(ier /= 0) stop 'error allocating array rmass_acoustic'
- rmass_acoustic_interface(:) = 0._CUSTOM_REAL
-
! returns acoustic mass matrix
if( PML_CONDITIONS ) then
call create_mass_matrices_pml_acoustic(nspec,ibool)
-
- do ispec=1,nspec
- if( ispec_is_acoustic(ispec) ) then
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
-
- weight = wxgll(i)*wygll(j)*wzgll(k)
- jacobianl = jacobianstore(i,j,k,ispec)
-
- ! distinguish between single and double precision for reals
- if(CUSTOM_REAL == SIZE_REAL) then
- rmass_acoustic_interface(iglob) = rmass_acoustic_interface(iglob) + &
- sngl( dble(jacobianl) * weight / dble(kappastore(i,j,k,ispec)) )
- else
- rmass_acoustic_interface(iglob) = rmass_acoustic_interface(iglob) + &
- jacobianl * weight / kappastore(i,j,k,ispec)
- endif
- enddo
- enddo
- enddo
- endif
- enddo
else
do ispec=1,nspec
if( ispec_is_acoustic(ispec) ) then
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -344,7 +344,6 @@
if( ACOUSTIC_SIMULATION) then
deallocate(rmass_acoustic)
- deallocate(rmass_acoustic_interface)
endif
if( ELASTIC_SIMULATION ) then
@@ -364,17 +363,6 @@
endif
endif
- if(PML_CONDITIONS)then
- if( ELASTIC_SIMULATION ) then
- if(PML_CONDITIONS)then
- if(ACOUSTIC_SIMULATION)then
- write(IOUT)rmass_elastic_interface
- endif
- endif
- endif
- endif
-
-
end subroutine create_regions_mesh
!
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases_par.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases_par.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases_par.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -150,7 +150,7 @@
! auxiliary parameters arrays
real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: K_store_x, K_store_y, K_store_z
- real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: alpha_store
+ real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: alpha_store_x,alpha_store_y,alpha_store_z
! array recording the points on interface shared by PML and interior computational domain
logical, dimension(:), allocatable :: mask_ibool_interior_domain
@@ -212,10 +212,6 @@
real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmass,rmass_acoustic,&
rmass_solid_poroelastic,rmass_fluid_poroelastic
-! mass matrix for interface
- real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmass_acoustic_interface
- real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmass_elastic_interface
-
! mass matrix contributions
real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmassx,rmassy,rmassz
real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmassz_acoustic
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/memory_eval.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/memory_eval.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/memory_eval.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -94,19 +94,19 @@
! is_CPML
memory_size = memory_size + NSPEC_AB*dble(SIZE_LOGICAL)
- ! d_store_x,d_store_y,d_store_z,d_store_x,d_store_y,d_store_z,alpha_store
- memory_size = memory_size + 7.d0*dble(NGLLX)*dble(NGLLY)*dble(NGLLZ)*nspec_cpml*dble(CUSTOM_REAL)
+ ! d_store_x,d_store_y,d_store_z,d_store_x,d_store_y,d_store_z,alpha_store_x,alpha_store_y,alpha_store_z
+ memory_size = memory_size + 9.d0*dble(NGLLX)*dble(NGLLY)*dble(NGLLZ)*nspec_cpml*dble(CUSTOM_REAL)
! PML_dux_dxl,PML_dux_dyl,PML_dux_dzl,
! PML_duy_dxl,PML_duy_dyl,PML_duy_dzl,
! PML_duz_dxl,PML_duz_dyl,PML_duz_dzl,
- ! PML_dux_dxl_new,PML_dux_dyl_new,PML_dux_dzl_new,
- ! PML_duy_dxl_new,PML_duy_dyl_new,PML_duy_dzl_new,
- ! PML_duz_dxl_new,PML_duz_dyl_new,PML_duz_dzl_new
+ ! PML_dux_dxl_old,PML_dux_dyl_old,PML_dux_dzl_old,
+ ! PML_duy_dxl_old,PML_duy_dyl_old,PML_duy_dzl_old,
+ ! PML_duz_dxl_old,PML_duz_dyl_old,PML_duz_dzl_old
memory_size = memory_size + 18.d0*dble(NGLLX)*dble(NGLLY)*dble(NGLLZ)*nspec_cpml*dble(CUSTOM_REAL)
! PML_dpotential_dxl,PML_dpotential_dyl,PML_dpotential_dzl
- ! PML_dpotential_dxl_new,PML_dpotential_dyl_new,PML_dpotential_dzl_new
+ ! PML_dpotential_dxl_old,PML_dpotential_dyl_old,PML_dpotential_dzl_old
memory_size = memory_size + 6.d0*dble(NGLLX)*dble(NGLLY)*dble(NGLLZ)*nspec_cpml*dble(CUSTOM_REAL)
! rmemory_dux_dxl_x,rmemory_dux_dyl_x,rmemory_dux_dzl_x,rmemory_duy_dxl_x,
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/pml_set_local_dampingcoeff.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/pml_set_local_dampingcoeff.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/pml_set_local_dampingcoeff.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -31,8 +31,8 @@
! calculates damping profiles and auxiliary coefficients on C-PML points
use generate_databases_par, only: ibool,NGLOB_AB,d_store_x,d_store_y,d_store_z, &
- K_store_x,K_store_y,K_store_z,alpha_store,CPML_to_spec, &
- CPML_width_x,CPML_width_y,CPML_width_z,NPOWER,K_MAX_PML, &
+ K_store_x,K_store_y,K_store_z,alpha_store_x,alpha_store_y,alpha_store_z,CPML_to_spec, &
+ CPML_width_x,CPML_width_y,CPML_width_z,NPOWER,&
CUSTOM_REAL,SIZE_REAL,NGLLX,NGLLY,NGLLZ,nspec_cpml,PML_INSTEAD_OF_FREE_SURFACE, &
IMAIN,FOUR_THIRDS,CPML_REGIONS,f0_FOR_PML,PI, &
CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY,CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY,CPML_XYZ,&
@@ -54,7 +54,7 @@
! JC JC: Remove the parameter definition here and make the calculation of ALPHA_MAX_PML automatic
! by recovering the value of hdur in FORCESOLUTION/CMTSOLUTION
real(kind=CUSTOM_REAL) :: ALPHA_MAX_PML
-
+ real(kind=CUSTOM_REAL), parameter :: K_MAX_PML = 1.d0
real(kind=CUSTOM_REAL) :: pml_damping_profile_l,dist,vp
real(kind=CUSTOM_REAL) :: xoriginleft,xoriginright,yoriginfront,yoriginback,zoriginbottom,zorigintop
real(kind=CUSTOM_REAL) :: abscissa_in_PML_x,abscissa_in_PML_y,abscissa_in_PML_z
@@ -88,8 +88,12 @@
if(ier /= 0) stop 'error allocating array K_store_y'
allocate(K_store_z(NGLLX,NGLLY,NGLLZ,nspec_cpml),stat=ier)
if(ier /= 0) stop 'error allocating array K_store_z'
- allocate(alpha_store(NGLLX,NGLLY,NGLLZ,nspec_cpml),stat=ier)
- if(ier /= 0) stop 'error allocating array alpha_store'
+ allocate(alpha_store_x(NGLLX,NGLLY,NGLLZ,nspec_cpml),stat=ier)
+ if(ier /= 0) stop 'error allocating array alpha_store_x'
+ allocate(alpha_store_y(NGLLX,NGLLY,NGLLZ,nspec_cpml),stat=ier)
+ if(ier /= 0) stop 'error allocating array alpha_store_y'
+ allocate(alpha_store_z(NGLLX,NGLLY,NGLLZ,nspec_cpml),stat=ier)
+ if(ier /= 0) stop 'error allocating array alpha_store_z'
d_store_x = 0._CUSTOM_REAL
d_store_y = 0._CUSTOM_REAL
@@ -99,7 +103,9 @@
K_store_y = 0._CUSTOM_REAL
K_store_z = 0._CUSTOM_REAL
- alpha_store = 0._CUSTOM_REAL
+ alpha_store_x = 0._CUSTOM_REAL
+ alpha_store_y = 0._CUSTOM_REAL
+ alpha_store_z = 0._CUSTOM_REAL
! from Festa and Vilotte (2005)
ALPHA_MAX_PML = PI*f0_FOR_PML
@@ -114,21 +120,21 @@
z_max = maxval(zstore(:))
if(CUSTOM_REAL == SIZE_REAL) then
- x_min_all = 10.e30
- y_min_all = 10.e30
- z_min_all = 10.e30
+ x_min_all = 10.e30_CUSTOM_REAL
+ y_min_all = 10.e30_CUSTOM_REAL
+ z_min_all = 10.e30_CUSTOM_REAL
- x_max_all = -10.e30
- y_max_all = -10.e30
- z_max_all = -10.e30
+ x_max_all = -10.e30_CUSTOM_REAL
+ y_max_all = -10.e30_CUSTOM_REAL
+ z_max_all = -10.e30_CUSTOM_REAL
else
- x_min_all = 10.d30
- y_min_all = 10.d30
- z_min_all = 10.d30
+ x_min_all = 10.e30_CUSTOM_REAL
+ y_min_all = 10.e30_CUSTOM_REAL
+ z_min_all = 10.e30_CUSTOM_REAL
- x_max_all = -10.d30
- y_max_all = -10.d30
- z_max_all = -10.d30
+ x_max_all = -10.e30_CUSTOM_REAL
+ y_max_all = -10.e30_CUSTOM_REAL
+ z_max_all = -10.e30_CUSTOM_REAL
endif
call min_all_all_cr(x_min,x_min_all)
@@ -163,7 +169,8 @@
ispec = CPML_to_spec(ispec_CPML)
do k=1,NGLLZ; do j=1,NGLLY; do i=1,NGLLX
iglob = ibool(i,j,k,ispec)
- if(CPML_regions(ispec_CPML) == CPML_X_ONLY) then
+ if(CPML_regions(ispec_CPML) == CPML_X_ONLY .or. CPML_regions(ispec_CPML) == CPML_XY_ONLY .or. &
+ CPML_regions(ispec_CPML) == CPML_XZ_ONLY .or. CPML_regions(ispec_CPML) == CPML_XYZ) then
if(xstore(iglob) - x_origin > 0._CUSTOM_REAL)then
if(xstore(iglob) - x_origin <= CPML_x_right - x_origin)then
CPML_x_right = xstore(iglob)
@@ -175,7 +182,8 @@
endif
endif
- if(CPML_regions(ispec_CPML) == CPML_Y_ONLY ) then
+ if(CPML_regions(ispec_CPML) == CPML_Y_ONLY .or. CPML_regions(ispec_CPML) == CPML_XY_ONLY .or. &
+ CPML_regions(ispec_CPML) == CPML_YZ_ONLY .or. CPML_regions(ispec_CPML) == CPML_XYZ) then
if(ystore(iglob) - y_origin > 0._CUSTOM_REAL)then
if(ystore(iglob) - y_origin <= CPML_y_front - y_origin)then
CPML_y_front = ystore(iglob)
@@ -187,7 +195,8 @@
endif
endif
- if(CPML_regions(ispec_CPML) == CPML_Z_ONLY ) then
+ if(CPML_regions(ispec_CPML) == CPML_Z_ONLY .or. CPML_regions(ispec_CPML) == CPML_YZ_ONLY .or. &
+ CPML_regions(ispec_CPML) == CPML_XZ_ONLY .or. CPML_regions(ispec_CPML) == CPML_XYZ) then
if(zstore(iglob) - z_origin > 0._CUSTOM_REAL)then
if(zstore(iglob) - z_origin <= CPML_z_top - z_origin)then
CPML_z_top = zstore(iglob)
@@ -307,7 +316,7 @@
! gets damping profile at the C-PML element's GLL point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! avoid d_x to be less than zero
@@ -324,7 +333,7 @@
! gets damping profile at the C-PML grid point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -337,17 +346,19 @@
!! DK DK define an alias for y and z variable names (which are the same)
! stores damping profiles and auxiliary coefficients at the C-PML element's GLL points
+ if(alpha_x < 0._CUSTOM_REAL) stop "there is error in mesh of CPML-layer x"
K_store_x(i,j,k,ispec_CPML) = K_x
d_store_x(i,j,k,ispec_CPML) = d_x
+ alpha_store_x(i,j,k,ispec_CPML) = alpha_x
K_store_y(i,j,k,ispec_CPML) = 1._CUSTOM_REAL
d_store_y(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
+ alpha_store_y(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
K_store_z(i,j,k,ispec_CPML) = 1._CUSTOM_REAL
d_store_z(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
+ alpha_store_z(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
- alpha_store(i,j,k,ispec_CPML) = alpha_x
-
else if( CPML_regions(ispec_CPML) == CPML_Y_ONLY ) then
!------------------------------------------------------------------------------
!---------------------------- Y-surface C-PML ---------------------------------
@@ -362,7 +373,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_y < 0._CUSTOM_REAL .or. K_y < 1._CUSTOM_REAL ) then
@@ -378,7 +389,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_y < 0._CUSTOM_REAL .or. K_y < 1._CUSTOM_REAL ) then
@@ -392,17 +403,19 @@
!! DK DK define an alias for y and z variable names (which are the same)
! stores damping profiles and auxiliary coefficients at the C-PML element's GLL points
+ if(alpha_y < 0._CUSTOM_REAL) stop "there is error in mesh of CPML-layer y"
K_store_x(i,j,k,ispec_CPML) = 1._CUSTOM_REAL
d_store_x(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
+ alpha_store_x(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
K_store_y(i,j,k,ispec_CPML) = K_y
d_store_y(i,j,k,ispec_CPML) = d_y
+ alpha_store_y(i,j,k,ispec_CPML) = alpha_y
K_store_z(i,j,k,ispec_CPML) = 1._CUSTOM_REAL
d_store_z(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
+ alpha_store_z(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
- alpha_store(i,j,k,ispec_CPML) = alpha_y
-
else if( CPML_regions(ispec_CPML) == CPML_Z_ONLY ) then
!------------------------------------------------------------------------------
!---------------------------- Z-surface C-PML ---------------------------------
@@ -418,7 +431,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_z < 0._CUSTOM_REAL .or. K_z < 1._CUSTOM_REAL ) then
@@ -435,7 +448,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_z < 0._CUSTOM_REAL .or. K_z < 1._CUSTOM_REAL ) then
@@ -448,17 +461,19 @@
!! DK DK define an alias for y and z variable names (which are the same)
! stores damping profiles and auxiliary coefficients at the C-PML element's GLL points
+ if(alpha_z < 0._CUSTOM_REAL) stop "there is error in mesh of CPML-layer z"
K_store_x(i,j,k,ispec_CPML) = 1._CUSTOM_REAL
d_store_x(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
+ alpha_store_x(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
K_store_y(i,j,k,ispec_CPML) = 1._CUSTOM_REAL
d_store_y(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
+ alpha_store_y(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
K_store_z(i,j,k,ispec_CPML) = K_z
d_store_z(i,j,k,ispec_CPML) = d_z
+ alpha_store_z(i,j,k,ispec_CPML) = alpha_z
- alpha_store(i,j,k,ispec_CPML) = alpha_z
-
else if( CPML_regions(ispec_CPML) == CPML_XY_ONLY ) then
!------------------------------------------------------------------------------
!---------------------------- XY-edge C-PML -----------------------------------
@@ -473,7 +488,7 @@
! gets damping profile at the C-PML element's GLL point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -484,7 +499,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -504,7 +519,7 @@
! gets damping profile at the C-PML element's GLL point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -515,7 +530,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -535,7 +550,7 @@
! gets damping profile at the C-PML element's GLL point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -546,7 +561,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -566,7 +581,7 @@
! gets damping profile at the C-PML element's GLL point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -577,7 +592,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -594,18 +609,22 @@
!! DK DK define an alias for y and z variable names (which are the same)
! stores damping profiles and auxiliary coefficients at the C-PML element's GLL points
+ if(alpha_x < 0._CUSTOM_REAL .or. alpha_y < 0._CUSTOM_REAL)then
+ stop "there is error in mesh of CPML-layer xy"
+ endif
+
K_store_x(i,j,k,ispec_CPML) = K_x
d_store_x(i,j,k,ispec_CPML) = d_x
+ alpha_store_x(i,j,k,ispec_CPML) = alpha_x
K_store_y(i,j,k,ispec_CPML) = K_y
d_store_y(i,j,k,ispec_CPML) = d_y
+ alpha_store_y(i,j,k,ispec_CPML) = alpha_y
-
K_store_z(i,j,k,ispec_CPML) = 1._CUSTOM_REAL
d_store_z(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
+ alpha_store_z(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
- alpha_store(i,j,k,ispec_CPML) = ALPHA_MAX_PML / 2._CUSTOM_REAL
-
else if( CPML_regions(ispec_CPML) == CPML_XZ_ONLY ) then
!------------------------------------------------------------------------------
!---------------------------- XZ-edge C-PML -----------------------------------
@@ -621,7 +640,7 @@
! gets damping profile at the C-PML element's GLL point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -632,7 +651,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -653,7 +672,7 @@
! gets damping profile at the C-PML element's GLL point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -664,7 +683,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -685,7 +704,7 @@
! gets damping profile at the C-PML element's GLL point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -696,7 +715,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -717,7 +736,7 @@
! gets damping profile at the C-PML element's GLL point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -728,7 +747,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -744,17 +763,22 @@
!! DK DK define an alias for y and z variable names (which are the same)
! stores damping profiles and auxiliary coefficients at the C-PML element's GLL points
+ if(alpha_x < 0._CUSTOM_REAL .or. alpha_z < 0._CUSTOM_REAL)then
+ stop "there is error in mesh of CPML-layer xz"
+ endif
+
K_store_x(i,j,k,ispec_CPML) = K_x
d_store_x(i,j,k,ispec_CPML) = d_x
+ alpha_store_x(i,j,k,ispec_CPML) = alpha_x
K_store_y(i,j,k,ispec_CPML) = 1._CUSTOM_REAL
d_store_y(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
+ alpha_store_y(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
K_store_z(i,j,k,ispec_CPML) = K_z
d_store_z(i,j,k,ispec_CPML) = d_z
+ alpha_store_z(i,j,k,ispec_CPML) = alpha_z
- alpha_store(i,j,k,ispec_CPML) = ALPHA_MAX_PML / 2._CUSTOM_REAL
-
else if( CPML_regions(ispec_CPML) == CPML_YZ_ONLY ) then
!------------------------------------------------------------------------------
!---------------------------- YZ-edge C-PML -----------------------------------
@@ -770,7 +794,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -781,7 +805,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_y < 0._CUSTOM_REAL .or. K_y < 1._CUSTOM_REAL ) then
@@ -802,7 +826,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -813,7 +837,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_y < 0._CUSTOM_REAL .or. K_y < 1._CUSTOM_REAL ) then
@@ -834,7 +858,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -845,7 +869,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_y < 0._CUSTOM_REAL .or. K_y < 1._CUSTOM_REAL ) then
@@ -866,7 +890,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -877,7 +901,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_y < 0._CUSTOM_REAL .or. K_y < 1._CUSTOM_REAL ) then
@@ -893,17 +917,21 @@
endif
!! DK DK define an alias for y and z variable names (which are the same)
+ if(alpha_y < 0._CUSTOM_REAL .or. alpha_z < 0._CUSTOM_REAL)then
+ stop "there is error in mesh of CPML-layer yz"
+ endif
K_store_x(i,j,k,ispec_CPML) = 1._CUSTOM_REAL
d_store_x(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
+ alpha_store_x(i,j,k,ispec_CPML) = 0._CUSTOM_REAL
K_store_y(i,j,k,ispec_CPML) = K_y
d_store_y(i,j,k,ispec_CPML) = d_y
+ alpha_store_y(i,j,k,ispec_CPML) = alpha_y
K_store_z(i,j,k,ispec_CPML) = K_z
d_store_z(i,j,k,ispec_CPML) = d_z
+ alpha_store_z(i,j,k,ispec_CPML) = alpha_z
- alpha_store(i,j,k,ispec_CPML) = ALPHA_MAX_PML / 2._CUSTOM_REAL
-
else if( CPML_regions(ispec_CPML) == CPML_XYZ ) then
!------------------------------------------------------------------------------
!---------------------------- XYZ-corner C-PML --------------------------------
@@ -921,7 +949,7 @@
! gets damping profile at the C-PML grid point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -932,7 +960,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -943,7 +971,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -970,7 +998,7 @@
! gets damping profile at the C-PML grid point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -981,7 +1009,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -992,7 +1020,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -1019,7 +1047,7 @@
! gets damping profile at the C-PML element's GLL point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -1030,7 +1058,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
@@ -1042,7 +1070,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -1069,7 +1097,7 @@
! gets damping profile at the C-PML element's GLL point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
@@ -1081,7 +1109,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
@@ -1093,7 +1121,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -1120,7 +1148,7 @@
! gets damping profile at the C-PML grid point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -1131,7 +1159,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -1142,7 +1170,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -1169,7 +1197,7 @@
! gets damping profile at the C-PML grid point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -1180,7 +1208,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -1191,7 +1219,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -1218,7 +1246,7 @@
! gets damping profile at the C-PML element's GLL point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -1229,7 +1257,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -1240,7 +1268,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -1267,7 +1295,7 @@
! gets damping profile at the C-PML element's GLL point
d_x = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_x)
- alpha_x = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_x = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_x = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -1278,7 +1306,7 @@
! gets damping profile at the C-PML element's GLL point
d_y = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_y)
- alpha_y = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_y = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_y = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
! gets abscissa of current grid point along the damping profile
@@ -1289,7 +1317,7 @@
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
- alpha_z = ALPHA_MAX_PML / 2._CUSTOM_REAL
+ alpha_z = ALPHA_MAX_PML * (1._CUSTOM_REAL - dist)
K_z = 1._CUSTOM_REAL + (K_MAX_PML - 1._CUSTOM_REAL) * dist**NPOWER
if( d_x < 0._CUSTOM_REAL .or. K_x < 1._CUSTOM_REAL ) then
@@ -1309,16 +1337,22 @@
endif
!! DK DK define an alias for y and z variable names (which are the same)
+ if(alpha_x < 0._CUSTOM_REAL .or. alpha_y < 0._CUSTOM_REAL .or. alpha_z < 0._CUSTOM_REAL)then
+ stop "there is error in mesh of CPML-layer xyz"
+ endif
+
K_store_x(i,j,k,ispec_CPML) = K_x
d_store_x(i,j,k,ispec_CPML) = d_x
+ alpha_store_x(i,j,k,ispec_CPML) = alpha_x
K_store_y(i,j,k,ispec_CPML) = K_y
d_store_y(i,j,k,ispec_CPML) = d_y
+ alpha_store_y(i,j,k,ispec_CPML) = alpha_y
K_store_z(i,j,k,ispec_CPML) = K_z
d_store_z(i,j,k,ispec_CPML) = d_z
+ alpha_store_z(i,j,k,ispec_CPML) = alpha_z
- alpha_store(i,j,k,ispec_CPML) = ALPHA_MAX_PML / 2._CUSTOM_REAL
endif
enddo
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/save_arrays_solver.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/save_arrays_solver.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/save_arrays_solver.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -34,7 +34,8 @@
use generate_databases_par, only: nspec_cpml,CPML_width_x,CPML_width_y,CPML_width_z,CPML_to_spec,&
CPML_regions,is_CPML,nspec_cpml_tot, &
- d_store_x,d_store_y,d_store_z,k_store_x,k_store_y,k_store_z,alpha_store, &
+ d_store_x,d_store_y,d_store_z,k_store_x,k_store_y,k_store_z,&
+ alpha_store_x,alpha_store_y,alpha_store_z, &
nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top,PML_CONDITIONS,&
!for adjoint tomography
@@ -103,7 +104,6 @@
! acoustic
if( ACOUSTIC_SIMULATION ) then
write(IOUT) rmass_acoustic
- write(IOUT) rmass_acoustic_interface
endif
! this array is needed for acoustic simulations but also for elastic simulations with CPML,
@@ -113,11 +113,6 @@
! elastic
if( ELASTIC_SIMULATION ) then
write(IOUT) rmass
- if(PML_CONDITIONS)then
- if(ACOUSTIC_SIMULATION)then
- write(IOUT)rmass_elastic_interface
- endif
- endif
if( APPROXIMATE_OCEAN_LOAD) then
write(IOUT) rmass_ocean_load
endif
@@ -157,7 +152,9 @@
write(IOUT) k_store_x
write(IOUT) k_store_y
write(IOUT) k_store_z
- write(IOUT) alpha_store
+ write(IOUT) alpha_store_x
+ write(IOUT) alpha_store_y
+ write(IOUT) alpha_store_z
! --------------------------------------------------------------------------------------------
! for adjoint tomography
! save the array stored the points on interface between PML and interior computational domain
@@ -360,7 +357,9 @@
deallocate(k_store_x,stat=ier); if( ier /= 0 ) stop 'error deallocating array d_store_x'
deallocate(k_store_y,stat=ier); if( ier /= 0 ) stop 'error deallocating array d_store_y'
deallocate(k_store_z,stat=ier); if( ier /= 0 ) stop 'error deallocating array d_store_z'
- deallocate(alpha_store,stat=ier); if( ier /= 0 ) stop 'error deallocating array alpha_store'
+ deallocate(alpha_store_x,stat=ier); if( ier /= 0 ) stop 'error deallocating array alpha_store_x'
+ deallocate(alpha_store_y,stat=ier); if( ier /= 0 ) stop 'error deallocating array alpha_store_y'
+ deallocate(alpha_store_z,stat=ier); if( ier /= 0 ) stop 'error deallocating array alpha_store_z'
if((SIMULATION_TYPE == 1 .and. SAVE_FORWARD) .or. SIMULATION_TYPE == 3) then
deallocate(mask_ibool_interior_domain,stat=ier)
if(ier /= 0) stop 'error deallocating array mask_ibool_interior_domain'
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/save_arrays_solver_adios.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/save_arrays_solver_adios.F90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/save_arrays_solver_adios.F90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -315,9 +315,6 @@
call define_adios_global_array1D(group, groupsize, &
local_dim, "", &
STRINGIFY_VAR(rmass_acoustic))
- call define_adios_global_array1D(group, groupsize, &
- local_dim, "", &
- STRINGIFY_VAR(rmass_acoustic_interface))
endif
! elastic
@@ -325,14 +322,7 @@
local_dim = nglob_wmax
call define_adios_global_array1D(group, groupsize, &
local_dim, "", STRINGIFY_VAR(rmass))
- if(PML_CONDITIONS)then
- if(ACOUSTIC_SIMULATION)then
- local_dim = nglob_wmax
- call define_adios_global_array1D(group, groupsize, &
- local_dim, "", &
- STRINGIFY_VAR(rmass_elastic_interface))
- endif
- endif
+
if( APPROXIMATE_OCEAN_LOAD) then
local_dim = nglob_ocean_wmax
call define_adios_global_array1D(group, groupsize, &
@@ -832,8 +822,6 @@
local_dim = nglob_wmax
call write_adios_global_1d_array(handle, myrank, sizeprocs, local_dim, &
STRINGIFY_VAR(rmass_acoustic))
- call write_adios_global_1d_array(handle, myrank, sizeprocs, local_dim, &
- STRINGIFY_VAR(rmass_acoustic_interface))
endif
! elastic
@@ -841,14 +829,6 @@
local_dim = nglob_wmax
call write_adios_global_1d_array(handle, myrank, sizeprocs, &
local_dim, STRINGIFY_VAR(rmass))
- if(PML_CONDITIONS)then
- if(ACOUSTIC_SIMULATION)then
- local_dim = nglob_wmax
- call write_adios_global_1d_array(handle, myrank, sizeprocs, &
- local_dim, &
- STRINGIFY_VAR(rmass_elastic_interface))
- endif
- endif
if( APPROXIMATE_OCEAN_LOAD) then
local_dim = nglob_ocean_wmax
call write_adios_global_1d_array(handle, myrank, sizeprocs, local_dim, &
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in 2013-10-22 09:55:50 UTC (rev 22967)
@@ -54,7 +54,7 @@
logical, parameter :: APPLY_HEURISTIC_RULE = .true.
! use inlined products of Deville et al. (2002) to speedup the calculations to compute internal forces
- logical, parameter :: USE_DEVILLE_PRODUCTS = .true.
+ logical, parameter :: USE_DEVILLE_PRODUCTS = .false.
! number of GLL points in each direction of an element (degree plus one)
integer, parameter :: NGLLX = 5
@@ -161,7 +161,6 @@
!!
!!-----------------------------------------------------------
real(kind=CUSTOM_REAL), parameter :: NPOWER = 1.d0
- real(kind=CUSTOM_REAL), parameter :: K_MAX_PML = 1.d0 ! (Martin and Komatitsch, Geophys. J. Int. 2009)
! C-PML theoretical reflection coefficient
! (INRIA research report section 6.1: http://hal.inria.fr/docs/00/07/32/19/PDF/RR-3471.pdf)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_acoustic_el.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_acoustic_el.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_acoustic_el.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -34,23 +34,21 @@
coupling_ac_el_jacobian2Dw, &
ispec_is_inner,phase_is_inner,&
PML_CONDITIONS,spec_to_CPML,is_CPML,&
- potential_dot_dot_acoustic_interface,veloc,rmemory_coupling_ac_el_displ,&
- SIMULATION_TYPE,backward_simulation,accel_interface)
+ rmemory_coupling_ac_el_displ,&
+ SIMULATION_TYPE,backward_simulation)
! returns the updated pressure array: potential_dot_dot_acoustic
-
+ use pml_par, only: NSPEC_CPML
implicit none
include 'constants.h'
integer :: NSPEC_AB,NGLOB_AB
! displacement and pressure
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: displ,veloc
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_dot_acoustic,&
- potential_dot_dot_acoustic_interface
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: displ
+ real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_dot_acoustic
integer :: SIMULATION_TYPE
logical :: backward_simulation
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: accel_interface
! global indexing
integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
@@ -98,20 +96,18 @@
iglob = ibool(i,j,k,ispec)
! elastic displacement on global point
- if(PML_CONDITIONS)then
+ if(PML_CONDITIONS .and. NSPEC_CPML > 0)then
if(.not. backward_simulation)then
if(is_CPML(ispec))then
if(SIMULATION_TYPE == 1)then
ispec_CPML = spec_to_CPML(ispec)
call pml_compute_memory_variables_acoustic_elastic(ispec_CPML,iface,iglob,i,j,k,&
- displ_x,displ_y,displ_z,displ,veloc,&
+ displ_x,displ_y,displ_z,displ,&
num_coupling_ac_el_faces,rmemory_coupling_ac_el_displ)
endif
if(SIMULATION_TYPE == 3)then
- displ_x = -accel_interface(1,iglob)
- displ_y = -accel_interface(1,iglob)
- displ_z = -accel_interface(1,iglob)
+!left blank for change
endif
else
@@ -158,13 +154,6 @@
! calculating the coupling on the elastic side for the acceleration...
potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) + jacobianw*displ_n
- if(PML_CONDITIONS)then
- if(is_CPML(ispec))then
- potential_dot_dot_acoustic_interface(iglob) = potential_dot_dot_acoustic_interface(iglob) &
- + jacobianw*displ_n
- endif
- endif
-
enddo ! igll
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_viscoelastic_ac.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_viscoelastic_ac.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_viscoelastic_ac.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -33,13 +33,14 @@
coupling_ac_el_normal, &
coupling_ac_el_jacobian2Dw, &
ispec_is_inner,phase_is_inner,&
- PML_CONDITIONS,is_CPML,potential_dot_dot_acoustic_interface,&
- SIMULATION_TYPE,backward_simulation,accel_interface,&
- rmemory_coupling_el_ac_potential,spec_to_CPML, &
- potential_acoustic,potential_dot_acoustic)
+ PML_CONDITIONS,&
+ SIMULATION_TYPE,backward_simulation,&
+ potential_acoustic)
! returns the updated acceleration array: accel
+ use pml_par,only : rmemory_coupling_el_ac_potential,rmemory_coupling_el_ac_potential_dot_dot,is_CPML,spec_to_CPML,&
+ potential_acoustic_old,potential_dot_dot_acoustic_old,NSPEC_CPML
implicit none
include 'constants.h'
@@ -48,8 +49,7 @@
! displacement and pressure
real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: accel
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_dot_acoustic,&
- potential_acoustic,potential_dot_acoustic
+ real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_dot_acoustic,potential_acoustic
! global indexing
integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
@@ -74,14 +74,8 @@
! CPML
integer :: ispec_CPML
- integer :: spec_to_CPML(NSPEC_AB)
logical :: PML_CONDITIONS
- logical :: is_CPML(NSPEC_AB)
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: accel_interface
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,num_coupling_ac_el_faces,2) :: rmemory_coupling_el_ac_potential
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_dot_acoustic_interface
-
! loops on all coupling faces
do iface = 1,num_coupling_ac_el_faces
@@ -103,17 +97,21 @@
iglob = ibool(i,j,k,ispec)
! acoustic pressure on global point
- if(PML_CONDITIONS)then
+ if(PML_CONDITIONS .and. NSPEC_CPML > 0)then
if(.not. backward_simulation)then
if(is_CPML(ispec))then
if(SIMULATION_TYPE == 1)then
- pressure = - potential_dot_dot_acoustic_interface(iglob)
+ ispec_CPML = spec_to_CPML(ispec)
+ call pml_compute_memory_variables_elastic_acoustic(ispec_CPML,iface,iglob,i,j,k,&
+ pressure,potential_dot_dot_acoustic,potential_dot_dot_acoustic_old,&
+ num_coupling_ac_el_faces,rmemory_coupling_el_ac_potential_dot_dot)
+ pressure = - pressure
endif
if(SIMULATION_TYPE == 3)then
ispec_CPML = spec_to_CPML(ispec)
call pml_compute_memory_variables_elastic_acoustic(ispec_CPML,iface,iglob,i,j,k,&
- pressure,potential_acoustic,potential_dot_acoustic,&
+ pressure,potential_acoustic,potential_acoustic_old,&
num_coupling_ac_el_faces,rmemory_coupling_el_ac_potential)
endif
else
@@ -153,12 +151,6 @@
accel(2,iglob) = accel(2,iglob) + jacobianw*ny*pressure
accel(3,iglob) = accel(3,iglob) + jacobianw*nz*pressure
- if(SIMULATION_TYPE == 3)then
- accel_interface(1,iglob) = accel_interface(1,iglob) + jacobianw*nx*pressure
- accel_interface(2,iglob) = accel_interface(2,iglob) + jacobianw*ny*pressure
- accel_interface(3,iglob) = accel_interface(3,iglob) + jacobianw*nz*pressure
- endif
-
enddo ! igll
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_Dev.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_Dev.F90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_Dev.F90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -27,13 +27,13 @@
! for acoustic solver
subroutine compute_forces_acoustic_Dev(iphase,NSPEC_AB,NGLOB_AB, &
- potential_acoustic,potential_dot_dot_acoustic, &
+ potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic, &
xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
hprime_xx,hprime_xxT,hprimewgll_xx,hprimewgll_xxT, &
wgllwgll_xy_3D,wgllwgll_xz_3D,wgllwgll_yz_3D, &
rhostore,jacobian,ibool, &
num_phase_ispec_acoustic,nspec_inner_acoustic,nspec_outer_acoustic,&
- phase_ispec_inner_acoustic)
+ phase_ispec_inner_acoustic,backward_simulation)
! computes forces for acoustic elements
!
@@ -41,7 +41,12 @@
! p = - Chi_dot_dot
!
use specfem_par,only: CUSTOM_REAL,NGLLX,NGLLY,NGLLZ,TINYVAL_SNGL, &
- m1,m2,NGLLCUBE
+ m1,m2,NGLLCUBE,PML_CONDITIONS
+ use pml_par, only: is_CPML, spec_to_CPML, NSPEC_CPML, &
+ PML_dpotential_dxl,PML_dpotential_dyl,PML_dpotential_dzl,&
+ PML_dpotential_dxl_old,PML_dpotential_dyl_old,PML_dpotential_dzl_old,&
+ potential_dot_dot_acoustic_CPML,rmemory_dpotential_dxl,rmemory_dpotential_dyl,&
+ rmemory_dpotential_dzl,rmemory_potential_acoustic,potential_acoustic_old
implicit none
@@ -49,7 +54,7 @@
! acoustic potentials
real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: &
- potential_acoustic,potential_dot_dot_acoustic
+ potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic
! arrays with mesh parameters per slice
integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
@@ -68,7 +73,13 @@
integer :: num_phase_ispec_acoustic,nspec_inner_acoustic,nspec_outer_acoustic
integer, dimension(num_phase_ispec_acoustic,2) :: phase_ispec_inner_acoustic
+! CPML adjoint
+ logical :: backward_simulation
+
+ integer :: ispec_CPML
+
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: tempx1,tempx2,tempx3
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: tempx1_old,tempx2_old,tempx3_old
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: newtempx1,newtempx2,newtempx3
real(kind=CUSTOM_REAL) :: xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl,jacobianl
@@ -79,21 +90,30 @@
! manually inline the calls to the Deville et al. (2002) routines
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: chi_elem
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: chi_elem_old
real(kind=CUSTOM_REAL), dimension(NGLLX,m2) :: B1_m1_m2_5points
real(kind=CUSTOM_REAL), dimension(m1,m2) :: C1_m1_m2_5points
+ real(kind=CUSTOM_REAL), dimension(NGLLX,m2) :: B1_m1_m2_5points_old
+ real(kind=CUSTOM_REAL), dimension(m1,m2) :: C1_m1_m2_5points_old
real(kind=CUSTOM_REAL), dimension(m1,m2) :: E1_m1_m2_5points
equivalence(chi_elem,B1_m1_m2_5points)
equivalence(tempx1,C1_m1_m2_5points)
+ equivalence(chi_elem_old,B1_m1_m2_5points_old)
+ equivalence(tempx1_old,C1_m1_m2_5points_old)
equivalence(newtempx1,E1_m1_m2_5points)
real(kind=CUSTOM_REAL), dimension(m2,NGLLX) :: A1_mxm_m2_m1_5points
real(kind=CUSTOM_REAL), dimension(m2,m1) :: C1_mxm_m2_m1_5points
+ real(kind=CUSTOM_REAL), dimension(m2,NGLLX) :: A1_mxm_m2_m1_5points_old
+ real(kind=CUSTOM_REAL), dimension(m2,m1) :: C1_mxm_m2_m1_5points_old
real(kind=CUSTOM_REAL), dimension(m2,m1) :: E1_mxm_m2_m1_5points
equivalence(chi_elem,A1_mxm_m2_m1_5points)
equivalence(tempx3,C1_mxm_m2_m1_5points)
+ equivalence(chi_elem_old,A1_mxm_m2_m1_5points_old)
+ equivalence(tempx3_old,C1_mxm_m2_m1_5points_old)
equivalence(newtempx3,E1_mxm_m2_m1_5points)
#ifdef FORCE_VECTORIZATION
@@ -163,7 +183,122 @@
enddo
enddo
+ if(PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
+ ! do not merge this second line with the first using an ".and." statement
+ ! because array is_CPML() is unallocated when PML_CONDITIONS is false
+
+ if(is_CPML(ispec)) then
+ ! gets values for element
#ifndef FORCE_VECTORIZATION
+ do k=1,NGLLZ
+ do j=1,NGLLY
+ do i=1,NGLLX
+ chi_elem_old(i,j,k) = potential_acoustic_old(ibool(i,j,k,ispec))
+ enddo
+ enddo
+ enddo
+#else
+ ! this will (purposely) give out-of-bound array accesses if run through range checking,
+ ! thus use only for production runs with no bound checking
+ do ijk = 1,NGLLCUBE
+ chi_elem_old(ijk,1,1) = potential_acoustic_old(ibool(ijk,1,1,ispec))
+ enddo
+#endif
+
+ ! subroutines adapted from Deville, Fischer and Mund, High-order methods
+ ! for incompressible fluid flow, Cambridge University Press (2002),
+ ! pages 386 and 389 and Figure 8.3.1
+ do j=1,m2
+ do i=1,m1
+ C1_m1_m2_5points_old(i,j) = hprime_xx(i,1)*B1_m1_m2_5points_old(1,j) + &
+ hprime_xx(i,2)*B1_m1_m2_5points_old(2,j) + &
+ hprime_xx(i,3)*B1_m1_m2_5points_old(3,j) + &
+ hprime_xx(i,4)*B1_m1_m2_5points_old(4,j) + &
+ hprime_xx(i,5)*B1_m1_m2_5points_old(5,j)
+ enddo
+ enddo
+
+ do k = 1,NGLLX
+ do j=1,m1
+ do i=1,m1
+ tempx2_old(i,j,k) = chi_elem_old(i,1,k)*hprime_xxT(1,j) + &
+ chi_elem_old(i,2,k)*hprime_xxT(2,j) + &
+ chi_elem_old(i,3,k)*hprime_xxT(3,j) + &
+ chi_elem_old(i,4,k)*hprime_xxT(4,j) + &
+ chi_elem_old(i,5,k)*hprime_xxT(5,j)
+ enddo
+ enddo
+ enddo
+
+ do j=1,m1
+ do i=1,m2
+ C1_mxm_m2_m1_5points_old(i,j) = A1_mxm_m2_m1_5points_old(i,1)*hprime_xxT(1,j) + &
+ A1_mxm_m2_m1_5points_old(i,2)*hprime_xxT(2,j) + &
+ A1_mxm_m2_m1_5points_old(i,3)*hprime_xxT(3,j) + &
+ A1_mxm_m2_m1_5points_old(i,4)*hprime_xxT(4,j) + &
+ A1_mxm_m2_m1_5points_old(i,5)*hprime_xxT(5,j)
+ enddo
+ enddo
+
+#ifndef FORCE_VECTORIZATION
+ do k=1,NGLLZ
+ do j=1,NGLLY
+ do i=1,NGLLX
+
+ ! get derivatives of potential with respect to x, y and z
+ xixl = xix(i,j,k,ispec)
+ xiyl = xiy(i,j,k,ispec)
+ xizl = xiz(i,j,k,ispec)
+ etaxl = etax(i,j,k,ispec)
+ etayl = etay(i,j,k,ispec)
+ etazl = etaz(i,j,k,ispec)
+ gammaxl = gammax(i,j,k,ispec)
+ gammayl = gammay(i,j,k,ispec)
+ gammazl = gammaz(i,j,k,ispec)
+ jacobianl = jacobian(i,j,k,ispec)
+
+ ! derivatives of potential
+ PML_dpotential_dxl(i,j,k) = xixl*tempx1(i,j,k) + etaxl*tempx2(i,j,k) + gammaxl*tempx3(i,j,k)
+ PML_dpotential_dyl(i,j,k) = xiyl*tempx1(i,j,k) + etayl*tempx2(i,j,k) + gammayl*tempx3(i,j,k)
+ PML_dpotential_dzl(i,j,k) = xizl*tempx1(i,j,k) + etazl*tempx2(i,j,k) + gammazl*tempx3(i,j,k)
+
+ PML_dpotential_dxl_old(i,j,k) = xixl*tempx1_old(i,j,k) + etaxl*tempx2_old(i,j,k) + gammaxl*tempx3_old(i,j,k)
+ PML_dpotential_dyl_old(i,j,k) = xiyl*tempx1_old(i,j,k) + etayl*tempx2_old(i,j,k) + gammayl*tempx3_old(i,j,k)
+ PML_dpotential_dzl_old(i,j,k) = xizl*tempx1_old(i,j,k) + etazl*tempx2_old(i,j,k) + gammazl*tempx3_old(i,j,k)
+
+ enddo
+ enddo
+ enddo
+#else
+ do ijk = 1,NGLLCUBE
+ ! get derivatives of potential with respect to x, y and z
+ xixl = xix(ijk,1,1,ispec)
+ xiyl = xiy(ijk,1,1,ispec)
+ xizl = xiz(ijk,1,1,ispec)
+ etaxl = etax(ijk,1,1,ispec)
+ etayl = etay(ijk,1,1,ispec)
+ etazl = etaz(ijk,1,1,ispec)
+ gammaxl = gammax(ijk,1,1,ispec)
+ gammayl = gammay(ijk,1,1,ispec)
+ gammazl = gammaz(ijk,1,1,ispec)
+ jacobianl = jacobian(ijk,1,1,ispec)
+
+ ! derivatives of potential
+ PML_dpotential_dxl(ijk,1,1) = xixl*tempx1(ijk,1,1) + etaxl*tempx2(ijk,1,1) + gammaxl*tempx3(ijk,1,1)
+ PML_dpotential_dyl(ijk,1,1) = xiyl*tempx1(ijk,1,1) + etayl*tempx2(ijk,1,1) + gammayl*tempx3(ijk,1,1)
+ PML_dpotential_dzl(ijk,1,1) = xizl*tempx1(ijk,1,1) + etazl*tempx2(ijk,1,1) + gammazl*tempx3(ijk,1,1)
+
+ PML_dpotential_dxl_old(ijk,1,1) = xixl*tempx1_old(ijk,1,1) + etaxl*tempx2_old(ijk,1,1) + gammaxl*tempx3_old(ijk,1,1)
+ PML_dpotential_dyl_old(ijk,1,1) = xiyl*tempx1_old(ijk,1,1) + etayl*tempx2_old(ijk,1,1) + gammayl*tempx3_old(ijk,1,1)
+ PML_dpotential_dzl_old(ijk,1,1) = xizl*tempx1_old(ijk,1,1) + etazl*tempx2_old(ijk,1,1) + gammazl*tempx3_old(ijk,1,1)
+
+ enddo
+#endif
+
+ endif
+ endif
+
+#ifndef FORCE_VECTORIZATION
do k=1,NGLLZ
do j=1,NGLLY
do i=1,NGLLX
@@ -232,6 +367,22 @@
enddo
#endif
+ if (PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
+ ! do not merge this second line with the first using an ".and." statement
+ ! because array is_CPML() is unallocated when PML_CONDITIONS is false
+ if(is_CPML(ispec)) then
+ tempx1 = 0._CUSTOM_REAL; tempx2 = 0._CUSTOM_REAL; tempx3 = 0._CUSTOM_REAL
+ ispec_CPML = spec_to_CPML(ispec)
+ ! sets C-PML elastic memory variables to compute stress sigma and form dot product with test vector
+ call pml_compute_memory_variables_acoustic(ispec,ispec_CPML,tempx1,tempx2,tempx3,&
+ rmemory_dpotential_dxl,rmemory_dpotential_dyl,rmemory_dpotential_dzl)
+
+ ! calculates contribution from each C-PML element to update acceleration
+ call pml_compute_accel_contribution_acoustic(ispec,ispec_CPML,potential_acoustic,&
+ potential_dot_acoustic,rmemory_potential_acoustic)
+ endif
+ endif
+
! subroutines adapted from Deville, Fischer and Mund, High-order methods
! for incompressible fluid flow, Cambridge University Press (2002),
! pages 386 and 389 and Figure 8.3.1
@@ -267,7 +418,6 @@
enddo
enddo
-
! second double-loop over GLL to compute all the terms
#ifndef FORCE_VECTORIZATION
do k = 1,NGLLZ
@@ -276,7 +426,6 @@
! sum contributions from each element to the global values
iglob = ibool(i,j,k,ispec)
-
potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) - (wgllwgll_yz_3D(i,j,k)*newtempx1(i,j,k) &
+ wgllwgll_xz_3D(i,j,k)*newtempx2(i,j,k) + wgllwgll_xy_3D(i,j,k)*newtempx3(i,j,k))
@@ -290,12 +439,38 @@
!DIR$ IVDEP
do ijk = 1,NGLLCUBE
! sum contributions from each element to the global values
- iglob = ibool(ijk,1,1,ispec)
- potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) - (wgllwgll_yz_3D(ijk,1,1)*newtempx1(ijk,1,1) &
+ iglob = ibool(ijk,1,1,ispec)
+ potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) - (wgllwgll_yz_3D(ijk,1,1)*newtempx1(ijk,1,1) &
+ wgllwgll_xz_3D(ijk,1,1)*newtempx2(ijk,1,1) + wgllwgll_xy_3D(ijk,1,1)*newtempx3(ijk,1,1))
enddo
#endif
+ ! updates potential_dot_dot_acoustic with contribution from each C-PML element
+ if (PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
+ ! do not merge this second line with the first using an ".and." statement
+ ! because array is_CPML() is unallocated when PML_CONDITIONS is false
+ if(is_CPML(ispec)) then
+#ifndef FORCE_VECTORIZATION
+ do k = 1,NGLLZ
+ do j = 1,NGLLZ
+ do i = 1,NGLLX
+ iglob = ibool(i,j,k,ispec)
+ potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) - &
+ potential_dot_dot_acoustic_CPML(i,j,k)
+ enddo
+ enddo
+ enddo
+#else
+ do ijk = 1,NGLLCUBE
+ ! sum contributions from each element to the global values
+ iglob = ibool(ijk,1,1,ispec)
+ potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) - potential_dot_dot_acoustic_CPML(ijk,1,1)
+ enddo
+#endif
+ endif
+ endif
+
+
enddo ! end of loop over all spectral elements
! The outer boundary condition to use for PML elements in fluid layers is Neumann for the potential
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_calling_routine.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_calling_routine.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_calling_routine.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -58,7 +58,7 @@
use specfem_par_elastic
use specfem_par_poroelastic
use pml_par,only: spec_to_CPML,is_CPML,rmemory_coupling_ac_el_displ,nglob_interface_PML_acoustic,&
- b_PML_potential,b_reclen_PML_potential
+ b_PML_potential,b_reclen_PML_potential,potential_dot_dot_acoustic_old,potential_acoustic_old
implicit none
! local parameters
@@ -71,12 +71,6 @@
ibool,free_surface_ijk,free_surface_ispec, &
num_free_surface_faces,ispec_is_acoustic)
- if(PML_CONDITIONS)then
- if(ELASTIC_SIMULATION ) then
- potential_dot_dot_acoustic_interface = 0.0
- endif
- endif
-
! distinguishes two runs: for elements on MPI interfaces, and elements within the partitions
do iphase=1,2
@@ -91,13 +85,13 @@
if(USE_DEVILLE_PRODUCTS) then
! uses Deville (2002) optimizations
call compute_forces_acoustic_Dev(iphase,NSPEC_AB,NGLOB_AB, &
- potential_acoustic,potential_dot_dot_acoustic, &
+ potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic, &
xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
hprime_xx,hprime_xxT,hprimewgll_xx,hprimewgll_xxT, &
wgllwgll_xy_3D,wgllwgll_xz_3D,wgllwgll_yz_3D, &
rhostore,jacobian,ibool, &
num_phase_ispec_acoustic,nspec_inner_acoustic,nspec_outer_acoustic,&
- phase_ispec_inner_acoustic)
+ phase_ispec_inner_acoustic,.false.)
else
call compute_forces_acoustic_noDev(iphase,NSPEC_AB,NGLOB_AB, &
potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic, &
@@ -105,10 +99,9 @@
hprime_xx,hprime_yy,hprime_zz, &
hprimewgll_xx,hprimewgll_yy,hprimewgll_zz, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- rhostore,jacobian,ibool,deltat, &
+ rhostore,jacobian,ibool, &
num_phase_ispec_acoustic,nspec_inner_acoustic,nspec_outer_acoustic,&
- phase_ispec_inner_acoustic,ELASTIC_SIMULATION,&
- .false.,potential_dot_dot_acoustic_interface)
+ phase_ispec_inner_acoustic,.false.)
endif
! ! Stacey absorbing boundary conditions
@@ -135,8 +128,8 @@
coupling_ac_el_jacobian2Dw, &
ispec_is_inner,phase_is_inner,&
PML_CONDITIONS,spec_to_CPML,is_CPML,&
- potential_dot_dot_acoustic_interface,veloc,rmemory_coupling_ac_el_displ,&
- SIMULATION_TYPE,.false.,accel_interface)
+ rmemory_coupling_ac_el_displ,&
+ SIMULATION_TYPE,.false.)
else
! handles adjoint runs coupling between adjoint potential and adjoint elastic wavefield
@@ -149,8 +142,8 @@
coupling_ac_el_jacobian2Dw, &
ispec_is_inner,phase_is_inner,&
PML_CONDITIONS,spec_to_CPML,is_CPML,&
- potential_dot_dot_acoustic_interface,veloc,rmemory_coupling_ac_el_displ,&
- SIMULATION_TYPE,.false.,accel_interface)
+ rmemory_coupling_ac_el_displ,&
+ SIMULATION_TYPE,.false.)
endif
endif
endif
@@ -207,13 +200,6 @@
! divides pressure with mass matrix
potential_dot_dot_acoustic(:) = potential_dot_dot_acoustic(:) * rmass_acoustic(:)
- if(PML_CONDITIONS)then
- if(ELASTIC_SIMULATION ) then
- potential_dot_dot_acoustic_interface(:) = potential_dot_dot_acoustic_interface(:) * &
- rmass_acoustic_interface(:)
- endif
- endif
-
! The outer boundary condition to use for PML elements in fluid layers is Neumann for the potential
! because we need Dirichlet conditions for the displacement vector, which means Neumann for the potential.
! Thus, there is nothing to enforce explicitly here.
@@ -244,7 +230,8 @@
potential_dot_acoustic(iglob) = 0.0
potential_acoustic(iglob) = 0.0
if(ELASTIC_SIMULATION ) then
- potential_dot_dot_acoustic_interface(iglob) = 0.0
+ potential_dot_dot_acoustic_old(iglob) = 0.0
+ potential_acoustic_old(iglob) = 0.0
endif
enddo
endif ! ispec_is_acoustic
@@ -360,13 +347,13 @@
if(USE_DEVILLE_PRODUCTS) then
! uses Deville (2002) optimizations
call compute_forces_acoustic_Dev(iphase,NSPEC_ADJOINT,NGLOB_ADJOINT, &
- b_potential_acoustic,b_potential_dot_dot_acoustic, &
+ b_potential_acoustic,b_potential_dot_acoustic,b_potential_dot_dot_acoustic, &
xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
hprime_xx,hprime_xxT,hprimewgll_xx,hprimewgll_xxT, &
wgllwgll_xy_3D,wgllwgll_xz_3D,wgllwgll_yz_3D, &
rhostore,jacobian,ibool, &
num_phase_ispec_acoustic,nspec_inner_acoustic,nspec_outer_acoustic,&
- phase_ispec_inner_acoustic)
+ phase_ispec_inner_acoustic,.true.)
else
call compute_forces_acoustic_noDev(iphase,NSPEC_ADJOINT,NGLOB_ADJOINT, &
b_potential_acoustic,b_potential_dot_acoustic,b_potential_dot_dot_acoustic, &
@@ -374,10 +361,9 @@
hprime_xx,hprime_yy,hprime_zz, &
hprimewgll_xx,hprimewgll_yy,hprimewgll_zz, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- rhostore,jacobian,ibool,deltat, &
+ rhostore,jacobian,ibool, &
num_phase_ispec_acoustic,nspec_inner_acoustic,nspec_outer_acoustic,&
- phase_ispec_inner_acoustic,ELASTIC_SIMULATION,&
- .true.,potential_dot_dot_acoustic_interface)
+ phase_ispec_inner_acoustic,.true.)
endif
! ! Stacey absorbing boundary conditions
@@ -403,8 +389,8 @@
coupling_ac_el_jacobian2Dw, &
ispec_is_inner,phase_is_inner,&
PML_CONDITIONS,spec_to_CPML,is_CPML,&
- potential_dot_dot_acoustic_interface,veloc,rmemory_coupling_ac_el_displ,&
- SIMULATION_TYPE,.true.,accel_interface)
+ rmemory_coupling_ac_el_displ,&
+ SIMULATION_TYPE,.true.)
endif
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_noDev.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_noDev.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_noDev.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -32,10 +32,9 @@
hprime_xx,hprime_yy,hprime_zz, &
hprimewgll_xx,hprimewgll_yy,hprimewgll_zz, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- rhostore,jacobian,ibool,deltat, &
+ rhostore,jacobian,ibool, &
num_phase_ispec_acoustic,nspec_inner_acoustic,nspec_outer_acoustic,&
- phase_ispec_inner_acoustic,ELASTIC_SIMULATION,&
- backward_simulation,potential_dot_dot_acoustic_interface)
+ phase_ispec_inner_acoustic,backward_simulation)
! computes forces for acoustic elements
!
@@ -44,11 +43,11 @@
!
use specfem_par,only: CUSTOM_REAL,NGLLX,NGLLY,NGLLZ,TINYVAL_SNGL,&
PML_CONDITIONS
- use pml_par, only: is_CPML, spec_to_CPML, &
+ use pml_par, only: is_CPML, spec_to_CPML, NSPEC_CPML, &
PML_dpotential_dxl,PML_dpotential_dyl,PML_dpotential_dzl,&
- PML_dpotential_dxl_new,PML_dpotential_dyl_new,PML_dpotential_dzl_new,&
+ PML_dpotential_dxl_old,PML_dpotential_dyl_old,PML_dpotential_dzl_old,&
potential_dot_dot_acoustic_CPML,rmemory_dpotential_dxl,rmemory_dpotential_dyl,&
- rmemory_dpotential_dzl,rmemory_potential_acoustic
+ rmemory_dpotential_dzl,rmemory_potential_acoustic,potential_acoustic_old
implicit none
@@ -58,9 +57,6 @@
real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: &
potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic
-! time step
- real(kind=CUSTOM_REAL) :: deltat
-
! arrays with mesh parameters per slice
integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: &
@@ -81,10 +77,6 @@
integer :: num_phase_ispec_acoustic,nspec_inner_acoustic,nspec_outer_acoustic
integer, dimension(num_phase_ispec_acoustic,2) :: phase_ispec_inner_acoustic
-! CPML fluid-solid interface
- logical :: ELASTIC_SIMULATION
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_dot_acoustic_interface
-
! CPML adjoint
logical :: backward_simulation
@@ -94,11 +86,11 @@
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: chi_elem
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: temp1,temp2,temp3
real(kind=CUSTOM_REAL) :: temp1l,temp2l,temp3l
- real(kind=CUSTOM_REAL) :: temp1l_new,temp2l_new,temp3l_new
+ real(kind=CUSTOM_REAL) :: temp1l_old,temp2l_old,temp3l_old
real(kind=CUSTOM_REAL) :: xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl,jacobianl
real(kind=CUSTOM_REAL) :: dpotentialdxl,dpotentialdyl,dpotentialdzl
- real(kind=CUSTOM_REAL) :: dpotentialdxl_new,dpotentialdyl_new,dpotentialdzl_new
+ real(kind=CUSTOM_REAL) :: dpotentialdxl_old,dpotentialdyl_old,dpotentialdzl_old
real(kind=CUSTOM_REAL) :: rho_invl
integer :: ispec,iglob,i,j,k,l,ispec_p,num_elements
@@ -143,30 +135,30 @@
temp3l = temp3l + chi_elem(i,j,l)*hprime_zz(k,l)
enddo
- if (PML_CONDITIONS .and. (.not. backward_simulation)) then
+ if (PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
! do not merge this second line with the first using an ".and." statement
! because array is_CPML() is unallocated when PML_CONDITIONS is false
if(is_CPML(ispec)) then
- temp1l_new = temp1l
- temp2l_new = temp2l
- temp3l_new = temp3l
+ temp1l_old = 0._CUSTOM_REAL
+ temp2l_old = 0._CUSTOM_REAL
+ temp3l_old = 0._CUSTOM_REAL
do l=1,NGLLX
hp1 = hprime_xx(i,l)
iglob = ibool(l,j,k,ispec)
- temp1l_new = temp1l_new + deltat*potential_dot_acoustic(iglob)*hp1
+ temp1l_old = temp1l_old + potential_acoustic_old(iglob)*hp1
!!! can merge these loops because NGLLX = NGLLY = NGLLZ enddo
!!! can merge these loops because NGLLX = NGLLY = NGLLZ do l=1,NGLLY
hp2 = hprime_yy(j,l)
iglob = ibool(i,l,k,ispec)
- temp2l_new = temp2l_new + deltat*potential_dot_acoustic(iglob)*hp2
+ temp2l_old = temp2l_old + potential_acoustic_old(iglob)*hp2
!!! can merge these loops because NGLLX = NGLLY = NGLLZ enddo
!!! can merge these loops because NGLLX = NGLLY = NGLLZ do l=1,NGLLZ
hp3 = hprime_zz(k,l)
iglob = ibool(i,j,l,ispec)
- temp3l_new = temp3l_new + deltat*potential_dot_acoustic(iglob)*hp3
+ temp3l_old = temp3l_old + potential_acoustic_old(iglob)*hp3
enddo
endif
endif
@@ -189,23 +181,22 @@
dpotentialdzl = xizl*temp1l + etazl*temp2l + gammazl*temp3l
! stores derivatives of ux, uy and uz with respect to x, y and z
- if (PML_CONDITIONS .and. (.not. backward_simulation)) then
+ if (PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
! do not merge this second line with the first using an ".and." statement
! because array is_CPML() is unallocated when PML_CONDITIONS is false
if(is_CPML(ispec)) then
- ispec_CPML = spec_to_CPML(ispec)
PML_dpotential_dxl(i,j,k) = dpotentialdxl
PML_dpotential_dyl(i,j,k) = dpotentialdyl
PML_dpotential_dzl(i,j,k) = dpotentialdzl
- dpotentialdxl_new = xixl*temp1l_new + etaxl*temp2l_new + gammaxl*temp3l_new
- dpotentialdyl_new = xiyl*temp1l_new + etayl*temp2l_new + gammayl*temp3l_new
- dpotentialdzl_new = xizl*temp1l_new + etazl*temp2l_new + gammazl*temp3l_new
+ dpotentialdxl_old = xixl*temp1l_old + etaxl*temp2l_old + gammaxl*temp3l_old
+ dpotentialdyl_old = xiyl*temp1l_old + etayl*temp2l_old + gammayl*temp3l_old
+ dpotentialdzl_old = xizl*temp1l_old + etazl*temp2l_old + gammazl*temp3l_old
- PML_dpotential_dxl_new(i,j,k) = dpotentialdxl_new
- PML_dpotential_dyl_new(i,j,k) = dpotentialdyl_new
- PML_dpotential_dzl_new(i,j,k) = dpotentialdzl_new
+ PML_dpotential_dxl_old(i,j,k) = dpotentialdxl_old
+ PML_dpotential_dyl_old(i,j,k) = dpotentialdyl_old
+ PML_dpotential_dzl_old(i,j,k) = dpotentialdzl_old
endif
endif
@@ -224,10 +215,12 @@
enddo
enddo
- if (PML_CONDITIONS .and. (.not. backward_simulation)) then
+ if (PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
! do not merge this second line with the first using an ".and." statement
! because array is_CPML() is unallocated when PML_CONDITIONS is false
if(is_CPML(ispec)) then
+ ispec_CPML = spec_to_CPML(ispec)
+
! sets C-PML elastic memory variables to compute stress sigma and form dot product with test vector
call pml_compute_memory_variables_acoustic(ispec,ispec_CPML,temp1,temp2,temp3,&
rmemory_dpotential_dxl,rmemory_dpotential_dyl,rmemory_dpotential_dzl)
@@ -261,23 +254,28 @@
potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) - ( temp1l + temp2l + temp3l )
- ! updates potential_dot_dot_acoustic with contribution from each C-PML element
- if (PML_CONDITIONS .and. (.not. backward_simulation)) then
- ! do not merge this second line with the first using an ".and." statement
- ! because array is_CPML() is unallocated when PML_CONDITIONS is false
- if(is_CPML(ispec)) then
- if(ELASTIC_SIMULATION)then
- potential_dot_dot_acoustic_interface(iglob) = potential_dot_dot_acoustic(iglob)
- endif
- potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) - &
- potential_dot_dot_acoustic_CPML(i,j,k)
- endif
- endif
-
enddo
enddo
enddo
+ if (PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
+ ! do not merge this second line with the first using an ".and." statement
+ ! because array is_CPML() is unallocated when PML_CONDITIONS is false
+ if(is_CPML(ispec)) then
+
+ do k = 1,NGLLZ
+ do j = 1,NGLLY
+ do i = 1,NGLLX
+ iglob = ibool(i,j,k,ispec)
+ potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) - &
+ potential_dot_dot_acoustic_CPML(i,j,k)
+
+ enddo
+ enddo
+ enddo
+ endif
+ endif
+
enddo ! end of loop over all spectral elements
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_Dev.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_Dev.F90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_Dev.F90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -33,7 +33,7 @@
hprimewgll_xx,hprimewgll_xxT, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
kappastore,mustore,jacobian,ibool, &
- ATTENUATION,deltat, &
+ ATTENUATION,deltat,PML_CONDITIONS, &
one_minus_sum_beta,factor_common,&
one_minus_sum_beta_kappa,factor_common_kappa,&
alphaval,betaval,gammaval,&
@@ -52,7 +52,7 @@
dsdx_top,dsdx_bot, &
ispec2D_moho_top,ispec2D_moho_bot, &
num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic,&
- phase_ispec_inner_elastic)
+ phase_ispec_inner_elastic,backward_simulation)
! computes elastic tensor term
@@ -62,6 +62,19 @@
ONE_THIRD,FOUR_THIRDS,m1,m2,IOUT
use fault_solver_dynamic, only : Kelvin_Voigt_eta
use specfem_par, only : FULL_ATTENUATION_SOLID
+ use pml_par, only: is_CPML, spec_to_CPML, accel_elastic_CPML,NSPEC_CPML,CPML_regions, &
+ PML_dux_dxl, PML_dux_dyl, PML_dux_dzl, PML_duy_dxl, PML_duy_dyl, PML_duy_dzl, &
+ PML_duz_dxl, PML_duz_dyl, PML_duz_dzl, &
+ PML_dux_dxl_old, PML_dux_dyl_old, PML_dux_dzl_old, &
+ PML_duy_dxl_old, PML_duy_dyl_old, PML_duy_dzl_old, &
+ PML_duz_dxl_old, PML_duz_dyl_old, PML_duz_dzl_old, &
+ rmemory_dux_dxl_x, rmemory_duy_dyl_x, rmemory_duz_dzl_x, &
+ rmemory_dux_dyl_x, rmemory_dux_dzl_x, rmemory_duz_dxl_x, rmemory_duy_dxl_x, &
+ rmemory_dux_dxl_y, rmemory_duz_dzl_y, rmemory_duy_dyl_y, &
+ rmemory_duy_dxl_y, rmemory_duy_dzl_y, rmemory_duz_dyl_y, rmemory_dux_dyl_y, &
+ rmemory_dux_dxl_z, rmemory_duy_dyl_z, rmemory_duz_dzl_z, &
+ rmemory_duz_dxl_z, rmemory_duz_dyl_z, rmemory_duy_dzl_z, rmemory_dux_dzl_z, &
+ rmemory_displ_elastic,displ_old
implicit none
@@ -197,6 +210,12 @@
equivalence(tempy3_att,C2_mxm_m2_m1_5points_att)
equivalence(tempz3_att,C3_mxm_m2_m1_5points_att)
+! C-PML absorbing boundary conditions
+ logical :: PML_CONDITIONS
+ integer :: ispec_CPML
+! CPML adjoint
+ logical :: backward_simulation
+
! local attenuation parameters
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: epsilondev_trace_loc,epsilondev_xx_loc, &
epsilondev_yy_loc, epsilondev_xy_loc, epsilondev_xz_loc, epsilondev_yz_loc
@@ -294,6 +313,21 @@
enddo
enddo
enddo
+ else if(PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
+ ! do not merge this second line with the first using an ".and." statement
+ ! because array is_CPML() is unallocated when PML_CONDITIONS is false
+ if(is_CPML(ispec)) then
+ do k=1,NGLLZ
+ do j=1,NGLLY
+ do i=1,NGLLX
+ iglob = ibool(i,j,k,ispec)
+ dummyx_loc_att(i,j,k) = displ_old(1,iglob)
+ dummyy_loc_att(i,j,k) = displ_old(2,iglob)
+ dummyz_loc_att(i,j,k) = displ_old(3,iglob)
+ enddo
+ enddo
+ enddo
+ endif
endif
! subroutines adapted from Deville, Fischer and Mund, High-order methods
@@ -346,6 +380,35 @@
hprime_xx(i,5)*B3_m1_m2_5points_att(5,j)
enddo
enddo
+ else if(PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
+ ! do not merge this second line with the first using an ".and." statement
+ ! because array is_CPML() is unallocated when PML_CONDITIONS is false
+ if(is_CPML(ispec)) then
+ do j=1,m2
+ do i=1,m1
+ C1_m1_m2_5points_att(i,j) = &
+ hprime_xx(i,1)*B1_m1_m2_5points_att(1,j) + &
+ hprime_xx(i,2)*B1_m1_m2_5points_att(2,j) + &
+ hprime_xx(i,3)*B1_m1_m2_5points_att(3,j) + &
+ hprime_xx(i,4)*B1_m1_m2_5points_att(4,j) + &
+ hprime_xx(i,5)*B1_m1_m2_5points_att(5,j)
+
+ C2_m1_m2_5points_att(i,j) = &
+ hprime_xx(i,1)*B2_m1_m2_5points_att(1,j) + &
+ hprime_xx(i,2)*B2_m1_m2_5points_att(2,j) + &
+ hprime_xx(i,3)*B2_m1_m2_5points_att(3,j) + &
+ hprime_xx(i,4)*B2_m1_m2_5points_att(4,j) + &
+ hprime_xx(i,5)*B2_m1_m2_5points_att(5,j)
+
+ C3_m1_m2_5points_att(i,j) = &
+ hprime_xx(i,1)*B3_m1_m2_5points_att(1,j) + &
+ hprime_xx(i,2)*B3_m1_m2_5points_att(2,j) + &
+ hprime_xx(i,3)*B3_m1_m2_5points_att(3,j) + &
+ hprime_xx(i,4)*B3_m1_m2_5points_att(4,j) + &
+ hprime_xx(i,5)*B3_m1_m2_5points_att(5,j)
+ enddo
+ enddo
+ endif
endif
! call mxm_m1_m1_5points(dummyx_loc(1,1,k),dummyy_loc(1,1,k),dummyz_loc(1,1,k), &
@@ -402,6 +465,39 @@
enddo
enddo
enddo
+ else if(PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
+ ! do not merge this second line with the first using an ".and." statement
+ ! because array is_CPML() is unallocated when PML_CONDITIONS is false
+ ! temporary variables used for fixing attenuation in a consistent way
+ if(is_CPML(ispec)) then
+ do j=1,m1
+ do i=1,m1
+ ! for efficiency it is better to leave this loop on k inside, it leads to slightly faster code
+ do k = 1,NGLLX
+ tempx2_att(i,j,k) = &
+ dummyx_loc_att(i,1,k)*hprime_xxT(1,j) + &
+ dummyx_loc_att(i,2,k)*hprime_xxT(2,j) + &
+ dummyx_loc_att(i,3,k)*hprime_xxT(3,j) + &
+ dummyx_loc_att(i,4,k)*hprime_xxT(4,j) + &
+ dummyx_loc_att(i,5,k)*hprime_xxT(5,j)
+
+ tempy2_att(i,j,k) = &
+ dummyy_loc_att(i,1,k)*hprime_xxT(1,j) + &
+ dummyy_loc_att(i,2,k)*hprime_xxT(2,j) + &
+ dummyy_loc_att(i,3,k)*hprime_xxT(3,j) + &
+ dummyy_loc_att(i,4,k)*hprime_xxT(4,j) + &
+ dummyy_loc_att(i,5,k)*hprime_xxT(5,j)
+
+ tempz2_att(i,j,k) = &
+ dummyz_loc_att(i,1,k)*hprime_xxT(1,j) + &
+ dummyz_loc_att(i,2,k)*hprime_xxT(2,j) + &
+ dummyz_loc_att(i,3,k)*hprime_xxT(3,j) + &
+ dummyz_loc_att(i,4,k)*hprime_xxT(4,j) + &
+ dummyz_loc_att(i,5,k)*hprime_xxT(5,j)
+ enddo
+ enddo
+ enddo
+ endif
endif
! call mxm_m2_m1_5points(dummyx_loc,dummyy_loc,dummyz_loc,tempx3,tempy3,tempz3)
@@ -451,6 +547,35 @@
A3_mxm_m2_m1_5points_att(i,5)*hprime_xxT(5,j)
enddo
enddo
+ else if(PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
+ ! do not merge this second line with the first using an ".and." statement
+ ! because array is_CPML() is unallocated when PML_CONDITIONS is false
+ if(is_CPML(ispec)) then
+ do j=1,m1
+ do i=1,m2
+ C1_mxm_m2_m1_5points_att(i,j) = &
+ A1_mxm_m2_m1_5points_att(i,1)*hprime_xxT(1,j) + &
+ A1_mxm_m2_m1_5points_att(i,2)*hprime_xxT(2,j) + &
+ A1_mxm_m2_m1_5points_att(i,3)*hprime_xxT(3,j) + &
+ A1_mxm_m2_m1_5points_att(i,4)*hprime_xxT(4,j) + &
+ A1_mxm_m2_m1_5points_att(i,5)*hprime_xxT(5,j)
+
+ C2_mxm_m2_m1_5points_att(i,j) = &
+ A2_mxm_m2_m1_5points_att(i,1)*hprime_xxT(1,j) + &
+ A2_mxm_m2_m1_5points_att(i,2)*hprime_xxT(2,j) + &
+ A2_mxm_m2_m1_5points_att(i,3)*hprime_xxT(3,j) + &
+ A2_mxm_m2_m1_5points_att(i,4)*hprime_xxT(4,j) + &
+ A2_mxm_m2_m1_5points_att(i,5)*hprime_xxT(5,j)
+
+ C3_mxm_m2_m1_5points_att(i,j) = &
+ A3_mxm_m2_m1_5points_att(i,1)*hprime_xxT(1,j) + &
+ A3_mxm_m2_m1_5points_att(i,2)*hprime_xxT(2,j) + &
+ A3_mxm_m2_m1_5points_att(i,3)*hprime_xxT(3,j) + &
+ A3_mxm_m2_m1_5points_att(i,4)*hprime_xxT(4,j) + &
+ A3_mxm_m2_m1_5points_att(i,5)*hprime_xxT(5,j)
+ enddo
+ enddo
+ endif
endif
do k=1,NGLLZ
@@ -542,6 +667,43 @@
epsilondev_xy_loc(i,j,k) = 0.5 * duxdyl_plus_duydxl_att
epsilondev_xz_loc(i,j,k) = 0.5 * duzdxl_plus_duxdzl_att
epsilondev_yz_loc(i,j,k) = 0.5 * duzdyl_plus_duydzl_att
+ else if(PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
+ ! do not merge this second line with the first using an ".and." statement
+ ! because array is_CPML() is unallocated when PML_CONDITIONS is false
+ if(is_CPML(ispec)) then
+ PML_dux_dxl(i,j,k) = duxdxl
+ PML_dux_dyl(i,j,k) = duxdyl
+ PML_dux_dzl(i,j,k) = duxdzl
+
+ PML_duy_dxl(i,j,k) = duydxl
+ PML_duy_dyl(i,j,k) = duydyl
+ PML_duy_dzl(i,j,k) = duydzl
+
+ PML_duz_dxl(i,j,k) = duzdxl
+ PML_duz_dyl(i,j,k) = duzdyl
+ PML_duz_dzl(i,j,k) = duzdzl
+
+ PML_dux_dxl_old(i,j,k) = &
+ xixl*tempx1_att(i,j,k) + etaxl*tempx2_att(i,j,k) + gammaxl*tempx3_att(i,j,k)
+ PML_dux_dyl_old(i,j,k) = &
+ xiyl*tempx1_att(i,j,k) + etayl*tempx2_att(i,j,k) + gammayl*tempx3_att(i,j,k)
+ PML_dux_dzl_old(i,j,k) = &
+ xizl*tempx1_att(i,j,k) + etazl*tempx2_att(i,j,k) + gammazl*tempx3_att(i,j,k)
+
+ PML_duy_dxl_old(i,j,k) = &
+ xixl*tempy1_att(i,j,k) + etaxl*tempy2_att(i,j,k) + gammaxl*tempy3_att(i,j,k)
+ PML_duy_dyl_old(i,j,k) = &
+ xiyl*tempy1_att(i,j,k) + etayl*tempy2_att(i,j,k) + gammayl*tempy3_att(i,j,k)
+ PML_duy_dzl_old(i,j,k) = &
+ xizl*tempy1_att(i,j,k) + etazl*tempy2_att(i,j,k) + gammazl*tempy3_att(i,j,k)
+
+ PML_duz_dxl_old(i,j,k) = &
+ xixl*tempz1_att(i,j,k) + etaxl*tempz2_att(i,j,k) + gammaxl*tempz3_att(i,j,k)
+ PML_duz_dyl_old(i,j,k) = &
+ xiyl*tempz1_att(i,j,k) + etayl*tempz2_att(i,j,k) + gammayl*tempz3_att(i,j,k)
+ PML_duz_dzl_old(i,j,k) = &
+ xizl*tempz1_att(i,j,k) + etazl*tempz2_att(i,j,k) + gammazl*tempz3_att(i,j,k)
+ endif
else
! computes deviatoric strain attenuation and/or for kernel calculations
if (COMPUTE_AND_STORE_STRAIN) then
@@ -725,6 +887,26 @@
enddo
enddo
+ if (PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
+ ! do not merge this second line with the first using an ".and." statement
+ ! because array is_CPML() is unallocated when PML_CONDITIONS is false
+ if(is_CPML(ispec)) then
+ ispec_CPML = spec_to_CPML(ispec)
+ ! sets C-PML elastic memory variables to compute stress sigma and form dot product with test vector
+ call pml_compute_memory_variables_elastic(ispec,ispec_CPML,tempx1,tempy1,tempz1,tempx2,tempy2,tempz2, &
+ tempx3,tempy3,tempz3, &
+ rmemory_dux_dxl_x, rmemory_duy_dyl_x, rmemory_duz_dzl_x, &
+ rmemory_dux_dyl_x, rmemory_dux_dzl_x, rmemory_duz_dxl_x, rmemory_duy_dxl_x, &
+ rmemory_dux_dxl_y, rmemory_duz_dzl_y, rmemory_duy_dyl_y, &
+ rmemory_duy_dxl_y, rmemory_duy_dzl_y, rmemory_duz_dyl_y, rmemory_dux_dyl_y, &
+ rmemory_dux_dxl_z, rmemory_duy_dyl_z, rmemory_duz_dzl_z, &
+ rmemory_duz_dxl_z, rmemory_duz_dyl_z, rmemory_duy_dzl_z, rmemory_dux_dzl_z)
+
+ ! calculates contribution from each C-PML element to update acceleration
+ call pml_compute_accel_contribution_elastic(ispec,ispec_CPML,displ,veloc,rmemory_displ_elastic)
+ endif
+ endif
+
! subroutines adapted from Deville, Fischer and Mund, High-order methods
! for incompressible fluid flow, Cambridge University Press (2002),
! pages 386 and 389 and Figure 8.3.1
@@ -869,6 +1051,24 @@
enddo
enddo
+ if (PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
+ ! do not merge this second line with the first using an ".and." statement
+ ! because array is_CPML() is unallocated when PML_CONDITIONS is false
+ if(is_CPML(ispec)) then
+
+ do k = 1,NGLLZ
+ do j = 1,NGLLY
+ do i = 1,NGLLX
+ iglob = ibool(i,j,k,ispec)
+ accel(1,iglob) = accel(1,iglob) - accel_elastic_CPML(1,i,j,k)
+ accel(2,iglob) = accel(2,iglob) - accel_elastic_CPML(2,i,j,k)
+ accel(3,iglob) = accel(3,iglob) - accel_elastic_CPML(3,i,j,k)
+ enddo
+ enddo
+ enddo
+ endif
+ endif
+
! save deviatoric strain for Runge-Kutta scheme
if ( COMPUTE_AND_STORE_STRAIN ) then
if(FULL_ATTENUATION_SOLID) epsilondev_trace(:,:,:,ispec) = epsilondev_trace_loc(:,:,:)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -85,8 +85,7 @@
dsdx_top,dsdx_bot, &
ispec2D_moho_top,ispec2D_moho_bot, &
num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic, &
- phase_ispec_inner_elastic,.false., &
- accel_interface,ACOUSTIC_SIMULATION)
+ phase_ispec_inner_elastic,.false.)
endif
@@ -118,11 +117,9 @@
coupling_ac_el_normal, &
coupling_ac_el_jacobian2Dw, &
ispec_is_inner,phase_is_inner,&
- PML_CONDITIONS,is_CPML,potential_dot_dot_acoustic_interface,&
+ PML_CONDITIONS,&
SIMULATION_TYPE,.false., &
- accel_interface,&
- rmemory_coupling_el_ac_potential,spec_to_CPML,&
- potential_acoustic,potential_dot_acoustic)
+ potential_acoustic)
else
@@ -135,11 +132,9 @@
coupling_ac_el_normal, &
coupling_ac_el_jacobian2Dw, &
ispec_is_inner,phase_is_inner,&
- PML_CONDITIONS,is_CPML,potential_dot_dot_acoustic_interface,&
+ PML_CONDITIONS,&
SIMULATION_TYPE,.false., &
- accel_interface,&
- rmemory_coupling_el_ac_potential,spec_to_CPML,&
- potential_acoustic,potential_dot_acoustic)
+ potential_acoustic)
endif
@@ -212,16 +207,6 @@
accel(2,:) = accel(2,:)*rmassy(:)
accel(3,:) = accel(3,:)*rmassz(:)
- if(SIMULATION_TYPE == 3)then
- if(PML_CONDITIONS)then
- if(ACOUSTIC_SIMULATION)then
- accel_interface(1,:) = accel_interface(1,:)*rmass_elastic_interface(:)
- accel_interface(2,:) = accel_interface(2,:)*rmass_elastic_interface(:)
- accel_interface(3,:) = accel_interface(3,:)*rmass_elastic_interface(:)
- endif
- endif
- endif
-
! updates acceleration with ocean load term
if(APPROXIMATE_OCEAN_LOAD) then
call compute_coupling_ocean(NSPEC_AB,NGLOB_AB, &
@@ -250,13 +235,8 @@
accel(:,iglob) = 0.0
veloc(:,iglob) = 0.0
displ(:,iglob) = 0.0
+ displ_old(:,iglob) = 0.0
- if(SIMULATION_TYPE ==3)then
- if(ACOUSTIC_SIMULATION)then
- accel_interface(:,iglob) = 0.0
- endif
- endif
-
enddo
endif ! ispec_is_elastic
!!! endif
@@ -362,8 +342,7 @@
b_dsdx_top,b_dsdx_bot, &
ispec2D_moho_top,ispec2D_moho_bot, &
num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic, &
- phase_ispec_inner_elastic,.true., &
- accel_interface,ACOUSTIC_SIMULATION)
+ phase_ispec_inner_elastic,.true.)
endif
@@ -390,11 +369,9 @@
coupling_ac_el_normal, &
coupling_ac_el_jacobian2Dw, &
ispec_is_inner,phase_is_inner,&
- PML_CONDITIONS,is_CPML,potential_dot_dot_acoustic_interface,&
+ PML_CONDITIONS,&
SIMULATION_TYPE,.true., &
- accel_interface,&
- rmemory_coupling_el_ac_potential,spec_to_CPML,&
- potential_acoustic,potential_dot_acoustic)
+ potential_acoustic)
endif ! num_coupling_ac_el_faces
endif
@@ -490,6 +467,7 @@
use specfem_par
use specfem_par_elastic
+ use specfem_par_acoustic
implicit none
@@ -542,7 +520,7 @@
hprime_xx,hprime_xxT,hprimewgll_xx,hprimewgll_xxT, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
kappastore,mustore,jacobian,ibool, &
- ATTENUATION,deltat, &
+ ATTENUATION,deltat,PML_CONDITIONS, &
one_minus_sum_beta,factor_common, &
one_minus_sum_beta_kappa,factor_common_kappa, &
alphaval,betaval,gammaval, &
@@ -561,7 +539,7 @@
dsdx_top,dsdx_bot, &
ispec2D_moho_top,ispec2D_moho_bot, &
num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic,&
- phase_ispec_inner_elastic )
+ phase_ispec_inner_elastic,.false.)
#endif
case default
@@ -583,6 +561,7 @@
use specfem_par
use specfem_par_elastic
+ use specfem_par_acoustic
implicit none
@@ -597,7 +576,7 @@
hprime_xx,hprime_xxT,hprimewgll_xx,hprimewgll_xxT, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
kappastore,mustore,jacobian,ibool, &
- ATTENUATION,deltat, &
+ ATTENUATION,deltat,PML_CONDITIONS, &
one_minus_sum_beta,factor_common, &
one_minus_sum_beta_kappa,factor_common_kappa, &
b_alphaval,b_betaval,b_gammaval, &
@@ -616,7 +595,7 @@
b_dsdx_top,b_dsdx_bot, &
ispec2D_moho_top,ispec2D_moho_bot, &
num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic,&
- phase_ispec_inner_elastic )
+ phase_ispec_inner_elastic,.true.)
case default
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -50,29 +50,28 @@
dsdx_top,dsdx_bot, &
ispec2D_moho_top,ispec2D_moho_bot, &
num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic, &
- phase_ispec_inner_elastic,backward_simulation,accel_interface,ACOUSTIC_SIMULATION)
+ phase_ispec_inner_elastic,backward_simulation)
use constants, only: CUSTOM_REAL,NGLLX,NGLLY,NGLLZ,NDIM,N_SLS,SAVE_MOHO_MESH,ONE_THIRD,FOUR_THIRDS
- use pml_par, only: is_CPML, spec_to_CPML, accel_elastic_CPML, &
+ use pml_par, only: is_CPML, spec_to_CPML, accel_elastic_CPML,NSPEC_CPML,CPML_regions, &
PML_dux_dxl, PML_dux_dyl, PML_dux_dzl, PML_duy_dxl, PML_duy_dyl, PML_duy_dzl, &
PML_duz_dxl, PML_duz_dyl, PML_duz_dzl, &
- PML_dux_dxl_new, PML_dux_dyl_new, PML_dux_dzl_new, &
- PML_duy_dxl_new, PML_duy_dyl_new, PML_duy_dzl_new, &
- PML_duz_dxl_new, PML_duz_dyl_new, PML_duz_dzl_new, &
+ PML_dux_dxl_old, PML_dux_dyl_old, PML_dux_dzl_old, &
+ PML_duy_dxl_old, PML_duy_dyl_old, PML_duy_dzl_old, &
+ PML_duz_dxl_old, PML_duz_dyl_old, PML_duz_dzl_old, &
rmemory_dux_dxl_x, rmemory_duy_dyl_x, rmemory_duz_dzl_x, &
rmemory_dux_dyl_x, rmemory_dux_dzl_x, rmemory_duz_dxl_x, rmemory_duy_dxl_x, &
rmemory_dux_dxl_y, rmemory_duz_dzl_y, rmemory_duy_dyl_y, &
rmemory_duy_dxl_y, rmemory_duy_dzl_y, rmemory_duz_dyl_y, rmemory_dux_dyl_y, &
rmemory_dux_dxl_z, rmemory_duy_dyl_z, rmemory_duz_dzl_z, &
rmemory_duz_dxl_z, rmemory_duz_dyl_z, rmemory_duy_dzl_z, rmemory_dux_dzl_z, &
- rmemory_displ_elastic
+ rmemory_displ_elastic,displ_old
use fault_solver_dynamic, only : Kelvin_Voigt_eta
use specfem_par, only : FULL_ATTENUATION_SOLID
implicit none
integer :: NSPEC_AB,NGLOB_AB
- logical :: ACOUSTIC_SIMULATION
! displacement, velocity and acceleration
real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: displ,veloc,accel
@@ -139,7 +138,6 @@
! C-PML absorbing boundary conditions
logical :: PML_CONDITIONS
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: accel_interface
! CPML adjoint
logical :: backward_simulation
@@ -260,7 +258,7 @@
enddo
enddo
enddo
- else if(PML_CONDITIONS .and. (.not. backward_simulation)) then
+ else if(PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
! do not merge this second line with the first using an ".and." statement
! because array is_CPML() is unallocated when PML_CONDITIONS is false
if(is_CPML(ispec)) then
@@ -268,9 +266,9 @@
do j=1,NGLLY
do i=1,NGLLX
iglob = ibool(i,j,k,ispec)
- dummyx_loc_att(i,j,k) = deltat*veloc(1,iglob)
- dummyy_loc_att(i,j,k) = deltat*veloc(2,iglob)
- dummyz_loc_att(i,j,k) = deltat*veloc(3,iglob)
+ dummyx_loc_att(i,j,k) = displ_old(1,iglob)
+ dummyy_loc_att(i,j,k) = displ_old(2,iglob)
+ dummyz_loc_att(i,j,k) = displ_old(3,iglob)
enddo
enddo
enddo
@@ -346,21 +344,21 @@
tempz3_att(i,j,k) = tempz3_att(i,j,k) + dummyz_loc_att(i,j,l)*hp3
enddo
- else if(PML_CONDITIONS .and. (.not. backward_simulation)) then
+ else if(PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
! do not merge this second line with the first using an ".and." statement
! because array is_CPML() is unallocated when PML_CONDITIONS is false
if(is_CPML(ispec)) then
- tempx1_att(i,j,k) = tempx1(i,j,k)
- tempx2_att(i,j,k) = tempx2(i,j,k)
- tempx3_att(i,j,k) = tempx3(i,j,k)
+ tempx1_att(i,j,k) = 0._CUSTOM_REAL
+ tempx2_att(i,j,k) = 0._CUSTOM_REAL
+ tempx3_att(i,j,k) = 0._CUSTOM_REAL
- tempy1_att(i,j,k) = tempy1(i,j,k)
- tempy2_att(i,j,k) = tempy2(i,j,k)
- tempy3_att(i,j,k) = tempy3(i,j,k)
+ tempy1_att(i,j,k) = 0._CUSTOM_REAL
+ tempy2_att(i,j,k) = 0._CUSTOM_REAL
+ tempy3_att(i,j,k) = 0._CUSTOM_REAL
- tempz1_att(i,j,k) = tempz1(i,j,k)
- tempz2_att(i,j,k) = tempz2(i,j,k)
- tempz3_att(i,j,k) = tempz3(i,j,k)
+ tempz1_att(i,j,k) = 0._CUSTOM_REAL
+ tempz2_att(i,j,k) = 0._CUSTOM_REAL
+ tempz3_att(i,j,k) = 0._CUSTOM_REAL
! use first order Taylor expansion of displacement for local storage of stresses
! at this current time step, to fix attenuation in a consistent way
@@ -410,7 +408,7 @@
duzdzl = xizl*tempz1(i,j,k) + etazl*tempz2(i,j,k) + gammazl*tempz3(i,j,k)
! stores derivatives of ux, uy and uz with respect to x, y and z
- if (PML_CONDITIONS .and. (.not. backward_simulation)) then
+ if (PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
! do not merge this second line with the first using an ".and." statement
! because array is_CPML() is unallocated when PML_CONDITIONS is false
if(is_CPML(ispec)) then
@@ -492,29 +490,29 @@
epsilondev_xz_loc(i,j,k) = 0.5 * duzdxl_plus_duxdzl_att
epsilondev_yz_loc(i,j,k) = 0.5 * duzdyl_plus_duydzl_att
- else if(PML_CONDITIONS .and. (.not. backward_simulation)) then
+ else if(PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
! do not merge this second line with the first using an ".and." statement
! because array is_CPML() is unallocated when PML_CONDITIONS is false
if(is_CPML(ispec)) then
- PML_dux_dxl_new(i,j,k) = &
+ PML_dux_dxl_old(i,j,k) = &
xixl*tempx1_att(i,j,k) + etaxl*tempx2_att(i,j,k) + gammaxl*tempx3_att(i,j,k)
- PML_dux_dyl_new(i,j,k) = &
+ PML_dux_dyl_old(i,j,k) = &
xiyl*tempx1_att(i,j,k) + etayl*tempx2_att(i,j,k) + gammayl*tempx3_att(i,j,k)
- PML_dux_dzl_new(i,j,k) = &
+ PML_dux_dzl_old(i,j,k) = &
xizl*tempx1_att(i,j,k) + etazl*tempx2_att(i,j,k) + gammazl*tempx3_att(i,j,k)
- PML_duy_dxl_new(i,j,k) = &
+ PML_duy_dxl_old(i,j,k) = &
xixl*tempy1_att(i,j,k) + etaxl*tempy2_att(i,j,k) + gammaxl*tempy3_att(i,j,k)
- PML_duy_dyl_new(i,j,k) = &
+ PML_duy_dyl_old(i,j,k) = &
xiyl*tempy1_att(i,j,k) + etayl*tempy2_att(i,j,k) + gammayl*tempy3_att(i,j,k)
- PML_duy_dzl_new(i,j,k) = &
+ PML_duy_dzl_old(i,j,k) = &
xizl*tempy1_att(i,j,k) + etazl*tempy2_att(i,j,k) + gammazl*tempy3_att(i,j,k)
- PML_duz_dxl_new(i,j,k) = &
+ PML_duz_dxl_old(i,j,k) = &
xixl*tempz1_att(i,j,k) + etaxl*tempz2_att(i,j,k) + gammaxl*tempz3_att(i,j,k)
- PML_duz_dyl_new(i,j,k) = &
+ PML_duz_dyl_old(i,j,k) = &
xiyl*tempz1_att(i,j,k) + etayl*tempz2_att(i,j,k) + gammayl*tempz3_att(i,j,k)
- PML_duz_dzl_new(i,j,k) = &
+ PML_duz_dzl_old(i,j,k) = &
xizl*tempz1_att(i,j,k) + etazl*tempz2_att(i,j,k) + gammazl*tempz3_att(i,j,k)
endif
@@ -686,7 +684,7 @@
!! DK DK that when PML_CONDITIONS is on then you do not compute the tempx, tempy, tempz arrays
!! DK DK (even in non-PML elements!!), even though such arrays are needed below;
!! DK DK shouldn't there be at least a "if (is_CPML(ispec))" test as well here, or something like that?
- if (PML_CONDITIONS .and. (.not. backward_simulation)) then
+ if (PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
! do not merge this second line with the first using an ".and." statement
! because array is_CPML() is unallocated when PML_CONDITIONS is false
if(.not.is_CPML(ispec)) then
@@ -731,7 +729,7 @@
enddo
enddo
- if (PML_CONDITIONS .and. (.not. backward_simulation)) then
+ if (PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
! do not merge this second line with the first using an ".and." statement
! because array is_CPML() is unallocated when PML_CONDITIONS is false
if(is_CPML(ispec)) then
@@ -799,22 +797,6 @@
accel(3,iglob) = accel(3,iglob) - fac1*newtempz1(i,j,k) - &
fac2*newtempz2(i,j,k) - fac3*newtempz3(i,j,k)
- ! updates acceleration with contribution from each C-PML element
- if (PML_CONDITIONS .and. (.not. backward_simulation)) then
- ! do not merge this second line with the first using an ".and." statement
- ! because array is_CPML() is unallocated when PML_CONDITIONS is false
- if(is_CPML(ispec)) then
- if(SIMULATION_TYPE == 3)then
- if(ACOUSTIC_SIMULATION)then
- accel_interface(:,iglob) = accel(:,iglob)
- endif
- endif
- accel(1,iglob) = accel(1,iglob) - accel_elastic_CPML(1,i,j,k)
- accel(2,iglob) = accel(2,iglob) - accel_elastic_CPML(2,i,j,k)
- accel(3,iglob) = accel(3,iglob) - accel_elastic_CPML(3,i,j,k)
- endif
- endif
-
! update memory variables based upon the Runge-Kutta scheme
if(ATTENUATION) then
@@ -872,6 +854,24 @@
enddo
enddo
+ if (PML_CONDITIONS .and. (.not. backward_simulation) .and. NSPEC_CPML > 0) then
+ ! do not merge this second line with the first using an ".and." statement
+ ! because array is_CPML() is unallocated when PML_CONDITIONS is false
+ if(is_CPML(ispec)) then
+
+ do k = 1,NGLLZ
+ do j = 1,NGLLY
+ do i = 1,NGLLX
+ iglob = ibool(i,j,k,ispec)
+ accel(1,iglob) = accel(1,iglob) - accel_elastic_CPML(1,i,j,k)
+ accel(2,iglob) = accel(2,iglob) - accel_elastic_CPML(2,i,j,k)
+ accel(3,iglob) = accel(3,iglob) - accel_elastic_CPML(3,i,j,k)
+ enddo
+ enddo
+ enddo
+ endif
+ endif
+
! save deviatoric strain for Runge-Kutta scheme
if ( COMPUTE_AND_STORE_STRAIN ) then
if(FULL_ATTENUATION_SOLID) epsilondev_trace(:,:,:,ispec) = epsilondev_trace_loc(:,:,:)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/finalize_simulation.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/finalize_simulation.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/finalize_simulation.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -70,13 +70,13 @@
write(IOUT) accel
if (ATTENUATION) then
- if(FULL_ATTENUATION_SOLID) write(IOUT) R_trace !ZN
+ if(FULL_ATTENUATION_SOLID) write(IOUT) R_trace
write(IOUT) R_xx
write(IOUT) R_yy
write(IOUT) R_xy
write(IOUT) R_xz
write(IOUT) R_yz
- if(FULL_ATTENUATION_SOLID) write(IOUT) epsilondev_trace !ZN
+ if(FULL_ATTENUATION_SOLID) write(IOUT) epsilondev_trace
write(IOUT) epsilondev_xx
write(IOUT) epsilondev_yy
write(IOUT) epsilondev_xy
@@ -199,11 +199,14 @@
deallocate(k_store_x)
deallocate(k_store_y)
deallocate(k_store_z)
- deallocate(alpha_store)
+ deallocate(alpha_store_x)
+ deallocate(alpha_store_y)
+ deallocate(alpha_store_z)
deallocate(spec_to_CPML)
deallocate(CPML_type)
if( ELASTIC_SIMULATION ) then
+ deallocate(displ_old)
deallocate(PML_dux_dxl)
deallocate(PML_dux_dyl)
deallocate(PML_dux_dzl)
@@ -213,15 +216,15 @@
deallocate(PML_duz_dxl)
deallocate(PML_duz_dyl)
deallocate(PML_duz_dzl)
- deallocate(PML_dux_dxl_new)
- deallocate(PML_dux_dyl_new)
- deallocate(PML_dux_dzl_new)
- deallocate(PML_duy_dxl_new)
- deallocate(PML_duy_dyl_new)
- deallocate(PML_duy_dzl_new)
- deallocate(PML_duz_dxl_new)
- deallocate(PML_duz_dyl_new)
- deallocate(PML_duz_dzl_new)
+ deallocate(PML_dux_dxl_old)
+ deallocate(PML_dux_dyl_old)
+ deallocate(PML_dux_dzl_old)
+ deallocate(PML_duy_dxl_old)
+ deallocate(PML_duy_dyl_old)
+ deallocate(PML_duy_dzl_old)
+ deallocate(PML_duz_dxl_old)
+ deallocate(PML_duz_dyl_old)
+ deallocate(PML_duz_dzl_old)
deallocate(rmemory_dux_dxl_x)
deallocate(rmemory_dux_dyl_x)
deallocate(rmemory_dux_dzl_x)
@@ -248,12 +251,13 @@
endif
if( ACOUSTIC_SIMULATION ) then
+ deallocate(potential_acoustic_old)
deallocate(PML_dpotential_dxl)
deallocate(PML_dpotential_dyl)
deallocate(PML_dpotential_dzl)
- deallocate(PML_dpotential_dxl_new)
- deallocate(PML_dpotential_dyl_new)
- deallocate(PML_dpotential_dzl_new)
+ deallocate(PML_dpotential_dxl_old)
+ deallocate(PML_dpotential_dyl_old)
+ deallocate(PML_dpotential_dzl_old)
deallocate(rmemory_dpotential_dxl)
deallocate(rmemory_dpotential_dyl)
deallocate(rmemory_dpotential_dzl)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -57,12 +57,14 @@
ADIOS_FOR_MESH, ADIOS_FOR_FORWARD_ARRAYS, &
ADIOS_FOR_KERNELS)
-!! DK DK added this for now (March 2013) because CPML is not yet implemented for USE_DEVILLE_PRODUCTS;
+!! DK DK added this for now (March 2013) because CPML is not yet implemented for fluid-solid coupling;
!! DK DK we will soon add it (in a month or so)
- if(PML_CONDITIONS .and. USE_DEVILLE_PRODUCTS) &
- stop 'CPML not implemented for USE_DEVILLE_PRODUCTS for now, set USE_DEVILLE_PRODUCTS to false in constants.h&
- & and recompile; we will add support for this soon; exiting for now...'
+ if(PML_CONDITIONS .and. ELASTIC_SIMULATION .and. ACOUSTIC_SIMULATION) &
+ stop 'It is still under test for this case'
+ if(PML_CONDITIONS .and. (SAVE_FORWARD .or. SIMULATION_TYPE==3)) &
+ stop 'It is still under test for adjoint simulation'
+
! GPU_MODE is in par_file
call read_gpu_mode(GPU_MODE,GRAVITY)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/model_update.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/model_update.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/model_update.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -932,7 +932,7 @@
if( ATTENUATION ) then
call get_attenuation_model(myrank,NSPEC,USE_OLSEN_ATTENUATION,OLSEN_ATTENUATION_RATIO, &
- mustore_new,rho_vs_new,kappastore_new,rho_vp_new,qmu_attenuation_store, & !ZN
+ mustore_new,rho_vs_new,kappastore_new,rho_vp_new,qmu_attenuation_store, &
ispec_is_elastic,min_resolved_period,prname_new,FULL_ATTENUATION_SOLID)
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_allocate_arrays.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_allocate_arrays.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_allocate_arrays.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -29,7 +29,7 @@
subroutine pml_allocate_arrays()
use pml_par
- use specfem_par, only: NSPEC_AB,PML_CONDITIONS,SIMULATION_TYPE,SAVE_FORWARD,NSTEP,myrank,prname !
+ use specfem_par, only: NSPEC_AB,NGLOB_AB,PML_CONDITIONS,SIMULATION_TYPE,SAVE_FORWARD,NSTEP,myrank,prname !
use constants, only: NDIM,NGLLX,NGLLY,NGLLZ
use specfem_par_acoustic, only: ACOUSTIC_SIMULATION,num_coupling_ac_el_faces
use specfem_par_elastic, only: ELASTIC_SIMULATION
@@ -49,6 +49,9 @@
if(ier /= 0) stop 'error allocating array CPML_type'
if( ELASTIC_SIMULATION) then
+ ! store the displ field at n-1 time step
+ allocate(displ_old(3,NGLOB_AB),stat=ier)
+ if(ier /= 0) stop 'error allocating displ_old array'
! stores derivatives of ux, uy and uz with respect to x, y and z
allocate(PML_dux_dxl(NGLLX,NGLLY,NGLLZ),stat=ier)
if(ier /= 0) stop 'error allocating PML_dux_dxl array'
@@ -69,31 +72,31 @@
allocate(PML_duz_dzl(NGLLX,NGLLY,NGLLZ),stat=ier)
if(ier /= 0) stop 'error allocating PML_duz_dzl array'
- allocate(PML_dux_dxl_new(NGLLX,NGLLY,NGLLZ),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dux_dxl_new array'
- allocate(PML_dux_dyl_new(NGLLX,NGLLY,NGLLZ),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dux_dyl_new array'
- allocate(PML_dux_dzl_new(NGLLX,NGLLY,NGLLZ),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dux_dzl_new array'
- allocate(PML_duy_dxl_new(NGLLX,NGLLY,NGLLZ),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duy_dxl_new array'
- allocate(PML_duy_dyl_new(NGLLX,NGLLY,NGLLZ),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duy_dyl_new array'
- allocate(PML_duy_dzl_new(NGLLX,NGLLY,NGLLZ),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duy_dzl_new array'
- allocate(PML_duz_dxl_new(NGLLX,NGLLY,NGLLZ),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duz_dxl_new array'
- allocate(PML_duz_dyl_new(NGLLX,NGLLY,NGLLZ),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duz_dyl_new array'
- allocate(PML_duz_dzl_new(NGLLX,NGLLY,NGLLZ),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duz_dzl_new array'
+ allocate(PML_dux_dxl_old(NGLLX,NGLLY,NGLLZ),stat=ier)
+ if(ier /= 0) stop 'error allocating PML_dux_dxl_old array'
+ allocate(PML_dux_dyl_old(NGLLX,NGLLY,NGLLZ),stat=ier)
+ if(ier /= 0) stop 'error allocating PML_dux_dyl_old array'
+ allocate(PML_dux_dzl_old(NGLLX,NGLLY,NGLLZ),stat=ier)
+ if(ier /= 0) stop 'error allocating PML_dux_dzl_old array'
+ allocate(PML_duy_dxl_old(NGLLX,NGLLY,NGLLZ),stat=ier)
+ if(ier /= 0) stop 'error allocating PML_duy_dxl_old array'
+ allocate(PML_duy_dyl_old(NGLLX,NGLLY,NGLLZ),stat=ier)
+ if(ier /= 0) stop 'error allocating PML_duy_dyl_old array'
+ allocate(PML_duy_dzl_old(NGLLX,NGLLY,NGLLZ),stat=ier)
+ if(ier /= 0) stop 'error allocating PML_duy_dzl_old array'
+ allocate(PML_duz_dxl_old(NGLLX,NGLLY,NGLLZ),stat=ier)
+ if(ier /= 0) stop 'error allocating PML_duz_dxl_old array'
+ allocate(PML_duz_dyl_old(NGLLX,NGLLY,NGLLZ),stat=ier)
+ if(ier /= 0) stop 'error allocating PML_duz_dyl_old array'
+ allocate(PML_duz_dzl_old(NGLLX,NGLLY,NGLLZ),stat=ier)
+ if(ier /= 0) stop 'error allocating PML_duz_dzl_old array'
! stores C-PML memory variables
- allocate(rmemory_dux_dxl_x(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2),stat=ier)
+ allocate(rmemory_dux_dxl_x(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_dux_dxl_x array'
- allocate(rmemory_dux_dyl_x(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2),stat=ier)
+ allocate(rmemory_dux_dyl_x(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_dux_dyl_x array'
- allocate(rmemory_dux_dzl_x(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2),stat=ier)
+ allocate(rmemory_dux_dzl_x(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_dux_dzl_x array'
allocate(rmemory_duy_dxl_x(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_duy_dxl_x array'
@@ -108,11 +111,11 @@
if(ier /= 0) stop 'error allocating rmemory_dux_dxl_y array'
allocate(rmemory_dux_dyl_y(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_dux_dyl_y array'
- allocate(rmemory_duy_dxl_y(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2),stat=ier)
+ allocate(rmemory_duy_dxl_y(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_duy_dxl_y array'
- allocate(rmemory_duy_dyl_y(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2),stat=ier)
+ allocate(rmemory_duy_dyl_y(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_duy_dyl_y array'
- allocate(rmemory_duy_dzl_y(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2),stat=ier)
+ allocate(rmemory_duy_dzl_y(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_duy_dzl_y array'
allocate(rmemory_duz_dyl_y(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_duz_dyl_y array'
@@ -127,11 +130,11 @@
if(ier /= 0) stop 'error allocating rmemory_duy_dyl_z array'
allocate(rmemory_duy_dzl_z(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_duy_dzl_z array'
- allocate(rmemory_duz_dxl_z(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2),stat=ier)
+ allocate(rmemory_duz_dxl_z(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_duz_dxl_z array'
- allocate(rmemory_duz_dyl_z(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2),stat=ier)
+ allocate(rmemory_duz_dyl_z(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_duz_dyl_z array'
- allocate(rmemory_duz_dzl_z(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2),stat=ier)
+ allocate(rmemory_duz_dzl_z(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_duz_dzl_z array'
! stores C-PML memory variables needed for displacement
@@ -144,6 +147,14 @@
endif
if( ACOUSTIC_SIMULATION) then
+ ! store the potential acoustic field at n-1 time step
+ allocate(potential_acoustic_old(NGLOB_AB),stat=ier)
+ if(ier /= 0) stop 'error allocating potential_acoustic_old array'
+
+ ! store the potential acoustic field at n-1 time step
+ allocate(potential_dot_dot_acoustic_old(NGLOB_AB),stat=ier)
+ if(ier /= 0) stop 'error allocating potential_dot_dot_acoustic_old array'
+
! stores derivatives of potential with respect to x, y and z
allocate(PML_dpotential_dxl(NGLLX,NGLLY,NGLLZ),stat=ier)
if(ier /= 0) stop 'error allocating PML_dpotential_dxl array'
@@ -152,19 +163,19 @@
allocate(PML_dpotential_dzl(NGLLX,NGLLY,NGLLZ),stat=ier)
if(ier /= 0) stop 'error allocating PML_dpotential_dxl array'
- allocate(PML_dpotential_dxl_new(NGLLX,NGLLY,NGLLZ),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dpotential_dxl_new array'
- allocate(PML_dpotential_dyl_new(NGLLX,NGLLY,NGLLZ),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dpotential_dxl_new array'
- allocate(PML_dpotential_dzl_new(NGLLX,NGLLY,NGLLZ),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dpotential_dxl_new array'
+ allocate(PML_dpotential_dxl_old(NGLLX,NGLLY,NGLLZ),stat=ier)
+ if(ier /= 0) stop 'error allocating PML_dpotential_dxl_old array'
+ allocate(PML_dpotential_dyl_old(NGLLX,NGLLY,NGLLZ),stat=ier)
+ if(ier /= 0) stop 'error allocating PML_dpotential_dxl_old array'
+ allocate(PML_dpotential_dzl_old(NGLLX,NGLLY,NGLLZ),stat=ier)
+ if(ier /= 0) stop 'error allocating PML_dpotential_dxl_old array'
! stores C-PML memory variables
- allocate(rmemory_dpotential_dxl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2),stat=ier)
+ allocate(rmemory_dpotential_dxl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_dpotential_dxl array'
- allocate(rmemory_dpotential_dyl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2),stat=ier)
+ allocate(rmemory_dpotential_dyl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_dpotential_dyl array'
- allocate(rmemory_dpotential_dzl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2),stat=ier)
+ allocate(rmemory_dpotential_dzl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_dpotential_dzl array'
! stores C-PML memory variables needed for potential
@@ -180,6 +191,8 @@
if(ACOUSTIC_SIMULATION .and. ELASTIC_SIMULATION)then
allocate(rmemory_coupling_ac_el_displ(3,NGLLX,NGLLY,NGLLZ,num_coupling_ac_el_faces,2),stat=ier)
if(ier /= 0) stop 'error allocating rmemory_coupling_ac_el_displ array'
+ allocate(rmemory_coupling_el_ac_potential_dot_dot(NGLLX,NGLLY,NGLLZ,num_coupling_ac_el_faces,2),stat=ier)
+ if(ier /= 0) stop 'error allocating rmemory_coupling_el_ac_potential_dot_dot array'
endif
if(SIMULATION_TYPE == 3)then
@@ -194,6 +207,8 @@
CPML_type(:) = 0
if( ELASTIC_SIMULATION) then
+ displ_old(:,:) = 0._CUSTOM_REAL
+
PML_dux_dxl(:,:,:) = 0._CUSTOM_REAL
PML_dux_dyl(:,:,:) = 0._CUSTOM_REAL
PML_dux_dzl(:,:,:) = 0._CUSTOM_REAL
@@ -204,15 +219,15 @@
PML_duz_dyl(:,:,:) = 0._CUSTOM_REAL
PML_duz_dzl(:,:,:) = 0._CUSTOM_REAL
- PML_dux_dxl_new(:,:,:) = 0._CUSTOM_REAL
- PML_dux_dyl_new(:,:,:) = 0._CUSTOM_REAL
- PML_dux_dzl_new(:,:,:) = 0._CUSTOM_REAL
- PML_duy_dxl_new(:,:,:) = 0._CUSTOM_REAL
- PML_duy_dyl_new(:,:,:) = 0._CUSTOM_REAL
- PML_duy_dzl_new(:,:,:) = 0._CUSTOM_REAL
- PML_duz_dxl_new(:,:,:) = 0._CUSTOM_REAL
- PML_duz_dyl_new(:,:,:) = 0._CUSTOM_REAL
- PML_duz_dzl_new(:,:,:) = 0._CUSTOM_REAL
+ PML_dux_dxl_old(:,:,:) = 0._CUSTOM_REAL
+ PML_dux_dyl_old(:,:,:) = 0._CUSTOM_REAL
+ PML_dux_dzl_old(:,:,:) = 0._CUSTOM_REAL
+ PML_duy_dxl_old(:,:,:) = 0._CUSTOM_REAL
+ PML_duy_dyl_old(:,:,:) = 0._CUSTOM_REAL
+ PML_duy_dzl_old(:,:,:) = 0._CUSTOM_REAL
+ PML_duz_dxl_old(:,:,:) = 0._CUSTOM_REAL
+ PML_duz_dyl_old(:,:,:) = 0._CUSTOM_REAL
+ PML_duz_dzl_old(:,:,:) = 0._CUSTOM_REAL
rmemory_dux_dxl_x(:,:,:,:,:) = 0._CUSTOM_REAL
rmemory_dux_dyl_x(:,:,:,:,:) = 0._CUSTOM_REAL
@@ -243,13 +258,15 @@
endif
if( ACOUSTIC_SIMULATION) then
+ potential_acoustic_old(:) = 0._CUSTOM_REAL
+ potential_dot_dot_acoustic_old(:) = 0._CUSTOM_REAL
PML_dpotential_dxl(:,:,:) = 0._CUSTOM_REAL
PML_dpotential_dyl(:,:,:) = 0._CUSTOM_REAL
PML_dpotential_dzl(:,:,:) = 0._CUSTOM_REAL
- PML_dpotential_dxl_new(:,:,:) = 0._CUSTOM_REAL
- PML_dpotential_dyl_new(:,:,:) = 0._CUSTOM_REAL
- PML_dpotential_dzl_new(:,:,:) = 0._CUSTOM_REAL
+ PML_dpotential_dxl_old(:,:,:) = 0._CUSTOM_REAL
+ PML_dpotential_dyl_old(:,:,:) = 0._CUSTOM_REAL
+ PML_dpotential_dzl_old(:,:,:) = 0._CUSTOM_REAL
rmemory_dpotential_dxl(:,:,:,:,:) = 0._CUSTOM_REAL
rmemory_dpotential_dyl(:,:,:,:,:) = 0._CUSTOM_REAL
@@ -261,6 +278,7 @@
if(ACOUSTIC_SIMULATION .and. ELASTIC_SIMULATION)then
rmemory_coupling_ac_el_displ(:,:,:,:,:,:) = 0._CUSTOM_REAL
+ rmemory_coupling_el_ac_potential_dot_dot(:,:,:,:,:) = 0._CUSTOM_REAL
endif
if(SIMULATION_TYPE == 3)then
@@ -407,51 +425,55 @@
if(.not. allocated(PML_duz_dxl)) allocate(PML_duz_dxl(1,1,1))
if(.not. allocated(PML_duz_dyl)) allocate(PML_duz_dyl(1,1,1))
if(.not. allocated(PML_duz_dzl)) allocate(PML_duz_dzl(1,1,1))
- if(.not. allocated(PML_dux_dxl_new)) allocate(PML_dux_dxl_new(1,1,1))
- if(.not. allocated(PML_dux_dyl_new)) allocate(PML_dux_dyl_new(1,1,1))
- if(.not. allocated(PML_dux_dzl_new)) allocate(PML_dux_dzl_new(1,1,1))
- if(.not. allocated(PML_duy_dxl_new)) allocate(PML_duy_dxl_new(1,1,1))
- if(.not. allocated(PML_duy_dyl_new)) allocate(PML_duy_dyl_new(1,1,1))
- if(.not. allocated(PML_duy_dzl_new)) allocate(PML_duy_dzl_new(1,1,1))
- if(.not. allocated(PML_duz_dxl_new)) allocate(PML_duz_dxl_new(1,1,1))
- if(.not. allocated(PML_duz_dyl_new)) allocate(PML_duz_dyl_new(1,1,1))
- if(.not. allocated(PML_duz_dzl_new)) allocate(PML_duz_dzl_new(1,1,1))
- if(.not. allocated(rmemory_dux_dxl_x)) allocate(rmemory_dux_dxl_x(1,1,1,1,2))
- if(.not. allocated(rmemory_dux_dyl_x)) allocate(rmemory_dux_dyl_x(1,1,1,1,2))
- if(.not. allocated(rmemory_dux_dzl_x)) allocate(rmemory_dux_dzl_x(1,1,1,1,2))
+ if(.not. allocated(PML_dux_dxl_old)) allocate(PML_dux_dxl_old(1,1,1))
+ if(.not. allocated(PML_dux_dyl_old)) allocate(PML_dux_dyl_old(1,1,1))
+ if(.not. allocated(PML_dux_dzl_old)) allocate(PML_dux_dzl_old(1,1,1))
+ if(.not. allocated(PML_duy_dxl_old)) allocate(PML_duy_dxl_old(1,1,1))
+ if(.not. allocated(PML_duy_dyl_old)) allocate(PML_duy_dyl_old(1,1,1))
+ if(.not. allocated(PML_duy_dzl_old)) allocate(PML_duy_dzl_old(1,1,1))
+ if(.not. allocated(PML_duz_dxl_old)) allocate(PML_duz_dxl_old(1,1,1))
+ if(.not. allocated(PML_duz_dyl_old)) allocate(PML_duz_dyl_old(1,1,1))
+ if(.not. allocated(PML_duz_dzl_old)) allocate(PML_duz_dzl_old(1,1,1))
+ if(.not. allocated(rmemory_dux_dxl_x)) allocate(rmemory_dux_dxl_x(1,1,1,1,3))
+ if(.not. allocated(rmemory_dux_dyl_x)) allocate(rmemory_dux_dyl_x(1,1,1,1,3))
+ if(.not. allocated(rmemory_dux_dzl_x)) allocate(rmemory_dux_dzl_x(1,1,1,1,3))
if(.not. allocated(rmemory_duy_dxl_x)) allocate(rmemory_duy_dxl_x(1,1,1,1))
if(.not. allocated(rmemory_duy_dyl_x)) allocate(rmemory_duy_dyl_x(1,1,1,1))
if(.not. allocated(rmemory_duz_dxl_x)) allocate(rmemory_duz_dxl_x(1,1,1,1))
if(.not. allocated(rmemory_duz_dzl_x)) allocate(rmemory_duz_dzl_x(1,1,1,1))
if(.not. allocated(rmemory_dux_dxl_y)) allocate(rmemory_dux_dxl_y(1,1,1,1))
if(.not. allocated(rmemory_dux_dyl_y)) allocate(rmemory_dux_dyl_y(1,1,1,1))
- if(.not. allocated(rmemory_duy_dxl_y)) allocate(rmemory_duy_dxl_y(1,1,1,1,2))
- if(.not. allocated(rmemory_duy_dyl_y)) allocate(rmemory_duy_dyl_y(1,1,1,1,2))
- if(.not. allocated(rmemory_duy_dzl_y)) allocate(rmemory_duy_dzl_y(1,1,1,1,2))
+ if(.not. allocated(rmemory_duy_dxl_y)) allocate(rmemory_duy_dxl_y(1,1,1,1,3))
+ if(.not. allocated(rmemory_duy_dyl_y)) allocate(rmemory_duy_dyl_y(1,1,1,1,3))
+ if(.not. allocated(rmemory_duy_dzl_y)) allocate(rmemory_duy_dzl_y(1,1,1,1,3))
if(.not. allocated(rmemory_duz_dyl_y)) allocate(rmemory_duz_dyl_y(1,1,1,1))
if(.not. allocated(rmemory_duz_dzl_y)) allocate(rmemory_duz_dzl_y(1,1,1,1))
if(.not. allocated(rmemory_dux_dxl_z)) allocate(rmemory_dux_dxl_z(1,1,1,1))
if(.not. allocated(rmemory_dux_dzl_z)) allocate(rmemory_dux_dzl_z(1,1,1,1))
if(.not. allocated(rmemory_duy_dyl_z)) allocate(rmemory_duy_dyl_z(1,1,1,1))
if(.not. allocated(rmemory_duy_dzl_z)) allocate(rmemory_duy_dzl_z(1,1,1,1))
- if(.not. allocated(rmemory_duz_dxl_z)) allocate(rmemory_duz_dxl_z(1,1,1,1,2))
- if(.not. allocated(rmemory_duz_dyl_z)) allocate(rmemory_duz_dyl_z(1,1,1,1,2))
- if(.not. allocated(rmemory_duz_dzl_z)) allocate(rmemory_duz_dzl_z(1,1,1,1,2))
+ if(.not. allocated(rmemory_duz_dxl_z)) allocate(rmemory_duz_dxl_z(1,1,1,1,3))
+ if(.not. allocated(rmemory_duz_dyl_z)) allocate(rmemory_duz_dyl_z(1,1,1,1,3))
+ if(.not. allocated(rmemory_duz_dzl_z)) allocate(rmemory_duz_dzl_z(1,1,1,1,3))
+ if(.not. allocated(displ_old)) allocate(displ_old(3,1))
if(.not. allocated(rmemory_displ_elastic)) allocate(rmemory_displ_elastic(1,1,1,1,1,3))
if(.not. allocated(accel_elastic_CPML)) allocate(accel_elastic_CPML(1,1,1,1))
if(.not. allocated(PML_dpotential_dxl)) allocate(PML_dpotential_dxl(1,1,1))
if(.not. allocated(PML_dpotential_dyl)) allocate(PML_dpotential_dyl(1,1,1))
if(.not. allocated(PML_dpotential_dzl)) allocate(PML_dpotential_dzl(1,1,1))
- if(.not. allocated(PML_dpotential_dxl_new)) allocate(PML_dpotential_dxl_new(1,1,1))
- if(.not. allocated(PML_dpotential_dyl_new)) allocate(PML_dpotential_dyl_new(1,1,1))
- if(.not. allocated(PML_dpotential_dzl_new)) allocate(PML_dpotential_dzl_new(1,1,1))
- if(.not. allocated(rmemory_dpotential_dxl)) allocate(rmemory_dpotential_dxl(1,1,1,1,2))
- if(.not. allocated(rmemory_dpotential_dyl)) allocate(rmemory_dpotential_dyl(1,1,1,1,2))
- if(.not. allocated(rmemory_dpotential_dzl)) allocate(rmemory_dpotential_dzl(1,1,1,1,2))
+ if(.not. allocated(PML_dpotential_dxl_old)) allocate(PML_dpotential_dxl_old(1,1,1))
+ if(.not. allocated(PML_dpotential_dyl_old)) allocate(PML_dpotential_dyl_old(1,1,1))
+ if(.not. allocated(PML_dpotential_dzl_old)) allocate(PML_dpotential_dzl_old(1,1,1))
+ if(.not. allocated(rmemory_dpotential_dxl)) allocate(rmemory_dpotential_dxl(1,1,1,1,3))
+ if(.not. allocated(rmemory_dpotential_dyl)) allocate(rmemory_dpotential_dyl(1,1,1,1,3))
+ if(.not. allocated(rmemory_dpotential_dzl)) allocate(rmemory_dpotential_dzl(1,1,1,1,3))
+ if(.not. allocated(potential_acoustic_old)) allocate(potential_acoustic_old(1))
+ if(.not. allocated(potential_dot_dot_acoustic_old)) allocate(potential_dot_dot_acoustic_old(1))
if(.not. allocated(rmemory_potential_acoustic)) allocate(rmemory_potential_acoustic(1,1,1,1,3))
if(.not. allocated(potential_dot_dot_acoustic_CPML)) allocate(potential_dot_dot_acoustic_CPML(1,1,1))
if(.not. allocated(rmemory_coupling_ac_el_displ)) allocate(rmemory_coupling_ac_el_displ(3,1,1,1,1,2))
if(.not. allocated(rmemory_coupling_el_ac_potential)) allocate(rmemory_coupling_el_ac_potential(1,1,1,1,2))
+ if(.not. allocated(rmemory_coupling_el_ac_potential_dot_dot)) allocate(rmemory_coupling_el_ac_potential_dot_dot(1,1,1,1,2))
! allocates wavefield
if(.not. allocated(b_PML_field)) allocate(b_PML_field(9,1))
! allocates wavefield
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_accel_contribution.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_accel_contribution.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_accel_contribution.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -37,7 +37,8 @@
use specfem_par, only: NGLOB_AB,it,deltat,wgll_cube,jacobian,ibool,rhostore
use pml_par, only: CPML_regions,d_store_x,d_store_y,d_store_z,K_store_x,K_store_y,K_store_z,&
- alpha_store,NSPEC_CPML,accel_elastic_CPML
+ alpha_store_x, alpha_store_y, alpha_store_z, &
+ NSPEC_CPML,accel_elastic_CPML,displ_old
use constants, only: CUSTOM_REAL,NDIM,NGLLX,NGLLY,NGLLZ,CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY, &
CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY,CPML_XYZ
@@ -48,11 +49,16 @@
real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3) :: rmemory_displ_elastic
! local parameters
- integer :: i,j,k,iglob
+ integer :: i,j,k,iglob,CPML_region_local
+ integer :: singularity_type_4, singularity_type_5
real(kind=CUSTOM_REAL) :: wgllcube,rhol,jacobianl
- real(kind=CUSTOM_REAL) :: bb,coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,coef0_3,coef1_3,coef2_3
- real(kind=CUSTOM_REAL) :: A0,A1,A2,A3,A4,A5,temp_A3! for convolution of acceleration
+ real(kind=CUSTOM_REAL) :: alpha_x,alpha_y,alpha_z,beta_x,beta_y,beta_z,d_x,d_y,d_z,kappa_x,kappa_y,kappa_z
+ real(kind=CUSTOM_REAL) :: coef0_x,coef1_x,coef2_x,coef0_y,coef1_y,coef2_y,coef0_z,coef1_z,coef2_z
+ real(kind=CUSTOM_REAL) :: A_0,A_1,A_2,A_3,A_4,A_5
+ real(kind=CUSTOM_REAL) :: time_nplus1, time_n
+ logical,parameter :: FIRST_ORDER_CONVOLUTION = .false.
+
do k=1,NGLLZ
do j=1,NGLLY
do i=1,NGLLX
@@ -61,399 +67,114 @@
iglob = ibool(i,j,k,ispec)
wgllcube = wgll_cube(i,j,k)
- if( CPML_regions(ispec_CPML) == CPML_X_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- X-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
+ CPML_region_local = CPML_regions(ispec_CPML)
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ alpha_x = alpha_store_x(i,j,k,ispec_CPML)
+ alpha_y = alpha_store_y(i,j,k,ispec_CPML)
+ alpha_z = alpha_store_z(i,j,k,ispec_CPML)
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ d_x = d_store_x(i,j,k,ispec_CPML)
+ d_y = d_store_y(i,j,k,ispec_CPML)
+ d_z = d_store_z(i,j,k,ispec_CPML)
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_1 + displ(1,iglob) * coef2_1
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) = 0.0
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) = 0.0
+ kappa_x = k_store_x(i,j,k,ispec_CPML)
+ kappa_y = k_store_y(i,j,k,ispec_CPML)
+ kappa_z = k_store_z(i,j,k,ispec_CPML)
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * coef1_1 + displ(2,iglob) * coef2_1
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) = 0.0
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) = 0.0
+ beta_x = alpha_x + d_x / kappa_x
+ beta_y = alpha_y + d_y / kappa_y
+ beta_z = alpha_z + d_z / kappa_z
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * coef1_1 + displ(3,iglob) * coef2_1
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) = 0.0
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) = 0.0
+ time_nplus1 = (it - 1._CUSTOM_REAL) * deltat
+ time_n = (it - 2._CUSTOM_REAL) * deltat
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_x(i,j,k,ispec_CPML)
- A1 = d_store_x(i,j,k,ispec_CPML)
- A2 = - alpha_store(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML)
- A3 = d_store_x(i,j,k,ispec_CPML) * alpha_store(i,j,k,ispec_CPML) ** 2
- A4 = 0.d0
- A5 = 0.d0
+ call l_parameter_computation( &
+ time_nplus1, deltat, &
+ kappa_x, beta_x, alpha_x, &
+ kappa_y, beta_y, alpha_y, &
+ kappa_z, beta_z, alpha_z, &
+ CPML_region_local, &
+ A_0, A_1, A_2, A_3, A_4, A_5, &
+ coef0_x, coef1_x, coef2_x, &
+ coef0_y, coef1_y, coef2_y, &
+ coef0_z, coef1_z, coef2_z, &
+ singularity_type_4, singularity_type_5, &
+ FIRST_ORDER_CONVOLUTION )
- else if( CPML_regions(ispec_CPML) == CPML_Y_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- Y-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
+ rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) = coef0_x * rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) &
+ + displ(1,iglob) * coef1_x + displ_old(1,iglob) * coef2_x
+ rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) = coef0_x * rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) &
+ + displ(2,iglob) * coef1_x + displ_old(2,iglob) * coef2_x
+ rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) = coef0_x * rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) &
+ + displ(3,iglob) * coef1_x + displ_old(3,iglob) * coef2_x
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ if (singularity_type_4 == 0) then
+ rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) = coef0_y * rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) &
+ + displ(1,iglob) * coef1_y + displ_old(1,iglob) * coef2_y
+ rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) = coef0_y * rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) &
+ + displ(2,iglob) * coef1_y + displ_old(2,iglob) * coef2_y
+ rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) = coef0_y * rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) &
+ + displ(3,iglob) * coef1_y + displ_old(3,iglob) * coef2_y
+ else if (singularity_type_4 == 1) then
+ rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) = coef0_y * rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) &
+ + displ(1,iglob) * time_nplus1 * coef1_y &
+ + displ_old(1,iglob) * time_n * coef2_y
+ rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) = coef0_y * rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) &
+ + displ(2,iglob) * time_nplus1 * coef1_y &
+ + displ_old(2,iglob) * time_n * coef2_y
+ rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) = coef0_y * rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) &
+ + displ(3,iglob) * time_nplus1 * coef1_y &
+ + displ_old(3,iglob) * time_n * coef2_y
+ end if
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ if (singularity_type_5 == 0) then
+ rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) = coef0_z * rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) &
+ + displ(1,iglob) * coef1_z + displ_old(1,iglob) * coef2_z
+ rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) = coef0_z * rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) &
+ + displ(2,iglob) * coef1_z + displ_old(2,iglob) * coef2_z
+ rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) = coef0_z * rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) &
+ + displ(3,iglob) * coef1_z + displ_old(3,iglob) * coef2_z
+ else if (singularity_type_5 == 1) then
+ rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) = coef0_z * rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) &
+ + displ(1,iglob) * time_nplus1 * coef1_z &
+ + displ_old(1,iglob) * time_n * coef2_z
+ rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) = coef0_z * rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) &
+ + displ(2,iglob) * time_nplus1 * coef1_z &
+ + displ_old(2,iglob) * time_n * coef2_z
+ rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) = coef0_z * rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) &
+ + displ(3,iglob) * time_nplus1 * coef1_z &
+ + displ_old(3,iglob) * time_n * coef2_z
+ else if (singularity_type_5 == 2) then
+ rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) = coef0_z * rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) &
+ + displ(1,iglob) * time_nplus1**2 * coef1_z &
+ + displ_old(1,iglob) * time_n**2 * coef2_z
+ rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) = coef0_z * rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) &
+ + displ(2,iglob) * time_nplus1**2 * coef1_z &
+ + displ_old(2,iglob) * time_n**2 * coef2_z
+ rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) = coef0_z * rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) &
+ + displ(3,iglob) * time_nplus1**2 * coef1_z &
+ + displ_old(3,iglob) * time_n**2 * coef2_z
+ end if
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_1 + displ(1,iglob) * coef2_1
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) = 0.0
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) = 0.0
-
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * coef1_1 + displ(2,iglob) * coef2_1
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) = 0.0
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) = 0.0
-
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * coef1_1 + displ(3,iglob) * coef2_1
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) = 0.0
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) = 0.0
-
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_y(i,j,k,ispec_CPML)
- A1 = d_store_y(i,j,k,ispec_CPML)
- A2 = - alpha_store(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- A3 = d_store_y(i,j,k,ispec_CPML) * alpha_store(i,j,k,ispec_CPML) ** 2
- A4 = 0.d0
- A5 = 0.d0
-
- else if( CPML_regions(ispec_CPML) == CPML_Z_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- Z-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_1 + displ(1,iglob) * coef2_1
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) = 0.0
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) = 0.0
-
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * coef1_1 + displ(2,iglob) * coef2_1
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) = 0.0
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) = 0.0
-
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * coef1_1 + displ(3,iglob) * coef2_1
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) = 0.0
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) = 0.0
-
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_z(i,j,k,ispec_CPML)
- A1 = d_store_z(i,j,k,ispec_CPML)
- A2 = - alpha_store(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A3 = d_store_z(i,j,k,ispec_CPML) * alpha_store(i,j,k,ispec_CPML) ** 2
- A4 = 0.d0
- A5 = 0.d0
-
- else if( CPML_regions(ispec_CPML) == CPML_XY_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- XY-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_1 + displ(1,iglob) * coef2_1
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) = coef0_2 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * it*deltat * coef1_2 &
- + displ(1,iglob) * it*deltat * coef2_2
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) = 0.0
-
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * coef1_1 + displ(2,iglob) * coef2_1
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) = coef0_2 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * it*deltat * coef1_2 &
- + displ(2,iglob) * it*deltat * coef2_2
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) = 0.0
-
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * coef1_1 + displ(3,iglob) * coef2_1
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) = coef0_2 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * it*deltat * coef1_2 &
- + displ(3,iglob) * it*deltat * coef2_2
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) = 0.0
-
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A1 = d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A2 = d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) &
- - alpha_store(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- - alpha_store(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML)
- A3 = -2.0 * alpha_store(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) &
- + alpha_store(i,j,k,ispec_CPML)**2 * ( d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- + d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) + alpha_store(i,j,k,ispec_CPML)**2 &
- * it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- A4 = -alpha_store(i,j,k,ispec_CPML)**2 * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- A5 = 0.0
-
- else if( CPML_regions(ispec_CPML) == CPML_XZ_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- XZ-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_1 + displ(1,iglob) * coef2_1
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) = coef0_2 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * it*deltat * coef1_2 &
- + displ(1,iglob) * it*deltat * coef2_2
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,3)= 0.0
-
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * coef1_1 + displ(2,iglob) * coef2_1
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) = coef0_2 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * it*deltat * coef1_2 &
- + displ(2,iglob) * it*deltat * coef2_2
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,3)= 0.0
-
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * coef1_1 + displ(3,iglob) * coef2_1
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) = coef0_2 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * it*deltat * coef1_2 &
- + displ(3,iglob) * it*deltat * coef2_2
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,3)= 0.0
-
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A1 = d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)&
- + d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML)
- A2 = d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) &
- - alpha_store(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- - alpha_store(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A3 = -2.0 * alpha_store(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) &
- + alpha_store(i,j,k,ispec_CPML)**2 * ( d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) + alpha_store(i,j,k,ispec_CPML)**2 &
- * it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A4 = -alpha_store(i,j,k,ispec_CPML)**2 * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A5 = 0.0
-
- else if( CPML_regions(ispec_CPML) == CPML_YZ_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- YZ-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_1 + displ(1,iglob) * coef2_1
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) = coef0_2 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * it*deltat * coef1_2 &
- + displ(1,iglob) * it*deltat * coef2_2
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,3)=0.d0
-
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * coef1_1 + displ(2,iglob) * coef2_1
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) = coef0_2 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * it*deltat * coef1_2 &
- + displ(2,iglob) * it*deltat * coef2_2
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,3)=0.d0
-
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * coef1_1 + displ(3,iglob) * coef2_1
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) = coef0_2 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * it*deltat * coef1_2 &
- + displ(3,iglob) * it*deltat * coef2_2
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,3)=0.d0
-
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A1 = d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A2 = d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) &
- - alpha_store(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- - alpha_store(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A3 = -2.0 * alpha_store(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) &
- + alpha_store(i,j,k,ispec_CPML)**2 * ( d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) ) + alpha_store(i,j,k,ispec_CPML)**2 &
- * it*deltat * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A4 = -alpha_store(i,j,k,ispec_CPML)**2 * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A5 = 0.0
-
- else if( CPML_regions(ispec_CPML) == CPML_XYZ ) then
- !------------------------------------------------------------------------------
- !---------------------------- XYZ-corner C-PML --------------------------------
- !------------------------------------------------------------------------------
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- coef0_3 = coef0_1
- coef1_3 = coef1_1
- coef2_3 = coef2_1
-
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_1 + displ(1,iglob) * coef2_1
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) = coef0_2 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * it*deltat * coef1_2 &
- + displ(1,iglob) * it*deltat * coef2_2
- rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) = coef0_3 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * (it*deltat)**2 * coef1_3 &
- + displ(1,iglob) * (it*deltat)**2 * coef2_3
-
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * coef1_1 + displ(2,iglob) * coef2_1
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) = coef0_2 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * it*deltat * coef1_2 &
- + displ(2,iglob) * it*deltat * coef2_2
- rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) = coef0_3 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * (it*deltat)**2 * coef1_3 &
- + displ(2,iglob) * (it*deltat)**2 * coef2_3
-
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) = coef0_1 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * coef1_1 + displ(3,iglob) * coef2_1
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) = coef0_2 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * it*deltat * coef1_2 &
- + displ(3,iglob) * it*deltat * coef2_2
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) = coef0_3 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * (it*deltat)**2 * coef1_3 &
- + displ(3,iglob) * (it*deltat)**2 * coef2_3
-
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A1 = d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) + &
- d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) + &
- d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A2 = k_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) + &
- k_store_y(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) + &
- k_store_z(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) - &
- d_store_x(i,j,k,ispec_CPML) * alpha_store(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) * &
- k_store_z(i,j,k,ispec_CPML) - d_store_y(i,j,k,ispec_CPML) * alpha_store(i,j,k,ispec_CPML) * &
- k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) - d_store_z(i,j,k,ispec_CPML) * &
- alpha_store(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- temp_A3 = d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) - &
- 2.0 * alpha_store(i,j,k,ispec_CPML) * ( &
- d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) + &
- d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) + &
- d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- ) + alpha_store(i,j,k,ispec_CPML)**2 * ( &
- d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) + &
- d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) + &
- d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- )
-! temp_A4 = -2.0 * alpha_store(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * &
-! d_store_z(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)**2 * ( &
-! d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) + &
-! d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) + &
-! d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
-! )
-! temp_A5 = 0.5 * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
-! A3 = temp_A3 + (it+0.0)*deltat*temp_A4 + ((it+0.0)*deltat)**2*temp_A5
-! A4 = -temp_A4 -2.0*(it+0.0)*deltat*temp_A5
-! A5 = temp_A5
-!!! the full experssion of A3,A4,A5 are given by above equation, here we use reduced
-!!! exprssion of A3,A4,A5 in order to stabilized the code.
-
- A3 = temp_A3
- A4 = 0.0
- A5 = 0.0
-
- endif
-
accel_elastic_CPML(1,i,j,k) = wgllcube * rhol * jacobianl * &
- ( A1 * veloc(1,iglob) + A2 * displ(1,iglob) + &
- A3 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) + &
- A4 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) + &
- A5 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) &
+ ( A_1 * veloc(1,iglob) + A_2 * displ(1,iglob) + &
+ A_3 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,1) + &
+ A_4 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,2) + &
+ A_5 * rmemory_displ_elastic(1,i,j,k,ispec_CPML,3) &
)
accel_elastic_CPML(2,i,j,k) = wgllcube * rhol * jacobianl * &
- ( A1 * veloc(2,iglob) + A2 * displ(2,iglob) + &
- A3 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) + &
- A4 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) + &
- A5 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) &
+ ( A_1 * veloc(2,iglob) + A_2 * displ(2,iglob) + &
+ A_3 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,1) + &
+ A_4 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,2) + &
+ A_5 * rmemory_displ_elastic(2,i,j,k,ispec_CPML,3) &
)
accel_elastic_CPML(3,i,j,k) = wgllcube * rhol * jacobianl * &
- ( A1 * veloc(3,iglob) + A2 * displ(3,iglob) + &
- A3 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) + &
- A4 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) + &
- A5 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) &
+ ( A_1 * veloc(3,iglob) + A_2 * displ(3,iglob) + &
+ A_3 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,1) + &
+ A_4 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,2) + &
+ A_5 * rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) &
)
enddo
enddo
@@ -464,8 +185,6 @@
!
!=====================================================================
!
-!
-
subroutine pml_compute_accel_contribution_acoustic(ispec,ispec_CPML,potential_acoustic,&
potential_dot_acoustic,rmemory_potential_acoustic)
@@ -478,7 +197,8 @@
use specfem_par, only: NGLOB_AB,it,deltat,wgll_cube,jacobian,ibool,kappastore
use pml_par, only: CPML_regions,NSPEC_CPML,d_store_x,d_store_y,d_store_z,K_store_x,K_store_y,K_store_z,&
- alpha_store, potential_dot_dot_acoustic_CPML
+ alpha_store_x, alpha_store_y, alpha_store_z, &
+ NSPEC_CPML,potential_dot_dot_acoustic_CPML,potential_acoustic_old
use constants, only: CUSTOM_REAL,NGLLX,NGLLY,NGLLZ,CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY, &
CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY,CPML_XYZ
@@ -490,11 +210,16 @@
! local parameters
- integer :: i,j,k,iglob
+ integer :: i,j,k,iglob,CPML_region_local
+ integer :: singularity_type_4, singularity_type_5
real(kind=CUSTOM_REAL) :: wgllcube,kappal_inv,jacobianl
- real(kind=CUSTOM_REAL) :: bb,coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,coef0_3,coef1_3,coef2_3
- real(kind=CUSTOM_REAL) :: A0,A1,A2,A3,A4,A5,temp_A3 ! for convolution of acceleration
+ real(kind=CUSTOM_REAL) :: alpha_x,alpha_y,alpha_z,beta_x,beta_y,beta_z,d_x,d_y,d_z,kappa_x,kappa_y,kappa_z
+ real(kind=CUSTOM_REAL) :: coef0_x,coef1_x,coef2_x,coef0_y,coef1_y,coef2_y,coef0_z,coef1_z,coef2_z
+ real(kind=CUSTOM_REAL) :: A_0,A_1,A_2,A_3,A_4,A_5
+ real(kind=CUSTOM_REAL) :: time_nplus1, time_n
+ logical,parameter :: FIRST_ORDER_CONVOLUTION = .false.
+
do k=1,NGLLZ
do j=1,NGLLY
do i=1,NGLLX
@@ -503,303 +228,70 @@
iglob = ibool(i,j,k,ispec)
wgllcube = wgll_cube(i,j,k)
- if( CPML_regions(ispec_CPML) == CPML_X_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- X-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
+ CPML_region_local = CPML_regions(ispec_CPML)
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ alpha_x = alpha_store_x(i,j,k,ispec_CPML)
+ alpha_y = alpha_store_y(i,j,k,ispec_CPML)
+ alpha_z = alpha_store_z(i,j,k,ispec_CPML)
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ d_x = d_store_x(i,j,k,ispec_CPML)
+ d_y = d_store_y(i,j,k,ispec_CPML)
+ d_z = d_store_z(i,j,k,ispec_CPML)
- rmemory_potential_acoustic(i,j,k,ispec_CPML,1)=coef0_1 * rmemory_potential_acoustic(i,j,k,ispec_CPML,1) &
- + (potential_acoustic(iglob) + deltat*potential_dot_acoustic(iglob)) * coef1_1 &
- + potential_acoustic(iglob) * coef2_1
- rmemory_potential_acoustic(i,j,k,ispec_CPML,2)=0.0
- rmemory_potential_acoustic(i,j,k,ispec_CPML,3)=0.0
+ kappa_x = k_store_x(i,j,k,ispec_CPML)
+ kappa_y = k_store_y(i,j,k,ispec_CPML)
+ kappa_z = k_store_z(i,j,k,ispec_CPML)
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_x(i,j,k,ispec_CPML)
- A1 = d_store_x(i,j,k,ispec_CPML)
- A2 = - alpha_store(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML)
- A3 = d_store_x(i,j,k,ispec_CPML) * alpha_store(i,j,k,ispec_CPML) ** 2
- A4 = 0.d0
- A5 = 0.d0
+ beta_x = alpha_x + d_x / kappa_x
+ beta_y = alpha_y + d_y / kappa_y
+ beta_z = alpha_z + d_z / kappa_z
- else if( CPML_regions(ispec_CPML) == CPML_Y_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- Y-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
+ time_nplus1 = (it - 1._CUSTOM_REAL) * deltat
+ time_n = (it - 2._CUSTOM_REAL) * deltat
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ call l_parameter_computation( &
+ time_nplus1, deltat, &
+ kappa_x, beta_x, alpha_x, &
+ kappa_y, beta_y, alpha_y, &
+ kappa_z, beta_z, alpha_z, &
+ CPML_region_local, &
+ A_0, A_1, A_2, A_3, A_4, A_5, &
+ coef0_x, coef1_x, coef2_x, &
+ coef0_y, coef1_y, coef2_y, &
+ coef0_z, coef1_z, coef2_z, &
+ singularity_type_4, singularity_type_5, &
+ FIRST_ORDER_CONVOLUTION )
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ rmemory_potential_acoustic(i,j,k,ispec_CPML,1) = coef0_x * rmemory_potential_acoustic(i,j,k,ispec_CPML,1) + &
+ coef1_x * potential_acoustic(iglob) + coef2_x * potential_acoustic_old(iglob)
- rmemory_potential_acoustic(i,j,k,ispec_CPML,1)=coef0_1 * rmemory_potential_acoustic(i,j,k,ispec_CPML,1) &
- + (potential_acoustic(iglob) + deltat*potential_dot_acoustic(iglob)) * coef1_1 &
- + potential_acoustic(iglob) * coef2_1
- rmemory_potential_acoustic(i,j,k,ispec_CPML,2)=0.0
- rmemory_potential_acoustic(i,j,k,ispec_CPML,3)=0.0
+ if (singularity_type_4 == 0) then
+ rmemory_potential_acoustic(i,j,k,ispec_CPML,2) = coef0_y * rmemory_potential_acoustic(i,j,k,ispec_CPML,2) + &
+ coef1_y * potential_acoustic(iglob) + coef2_y * potential_acoustic_old(iglob)
+ else if (singularity_type_4 == 1) then
+ rmemory_potential_acoustic(i,j,k,ispec_CPML,2) = coef0_y * rmemory_potential_acoustic(i,j,k,ispec_CPML,2) + &
+ coef1_y * time_nplus1 * potential_acoustic(iglob) + &
+ coef2_y * time_n * potential_acoustic_old(iglob)
+ end if
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_y(i,j,k,ispec_CPML)
- A1 = d_store_y(i,j,k,ispec_CPML)
- A2 = - alpha_store(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- A3 = d_store_y(i,j,k,ispec_CPML) * alpha_store(i,j,k,ispec_CPML) ** 2
- A4 = 0.d0
- A5 = 0.d0
+ if (singularity_type_5 == 0) then
+ rmemory_potential_acoustic(i,j,k,ispec_CPML,3) = coef0_z * rmemory_potential_acoustic(i,j,k,ispec_CPML,3) + &
+ coef1_z * potential_acoustic(iglob) + coef2_z * potential_acoustic_old(iglob)
+ else if (singularity_type_5 == 1) then
+ rmemory_potential_acoustic(i,j,k,ispec_CPML,3) = coef0_z * rmemory_potential_acoustic(i,j,k,ispec_CPML,3) + &
+ coef1_z * time_nplus1 * potential_acoustic(iglob) + &
+ coef2_z * time_n * potential_acoustic_old(iglob)
+ else if (singularity_type_5 == 2) then
+ rmemory_potential_acoustic(i,j,k,ispec_CPML,3) = coef0_z * rmemory_potential_acoustic(i,j,k,ispec_CPML,3) + &
+ coef1_z * time_nplus1**2 * potential_acoustic(iglob) + &
+ coef2_z * time_n**2 * potential_acoustic_old(iglob)
+ end if
- else if( CPML_regions(ispec_CPML) == CPML_Z_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- Z-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_potential_acoustic(i,j,k,ispec_CPML,1)=coef0_1 * rmemory_potential_acoustic(i,j,k,ispec_CPML,1) &
- + (potential_acoustic(iglob) + deltat*potential_dot_acoustic(iglob)) * coef1_1 &
- + potential_acoustic(iglob) * coef2_1
- rmemory_potential_acoustic(i,j,k,ispec_CPML,2)=0.0
- rmemory_potential_acoustic(i,j,k,ispec_CPML,3)=0.0
-
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_z(i,j,k,ispec_CPML)
- A1 = d_store_z(i,j,k,ispec_CPML)
- A2 = - alpha_store(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A3 = d_store_z(i,j,k,ispec_CPML) * alpha_store(i,j,k,ispec_CPML) ** 2
- A4 = 0.d0
- A5 = 0.d0
-
- else if( CPML_regions(ispec_CPML) == CPML_XY_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- XY-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- rmemory_potential_acoustic(i,j,k,ispec_CPML,1)=coef0_1 * rmemory_potential_acoustic(i,j,k,ispec_CPML,1) &
- + (potential_acoustic(iglob) + deltat*potential_dot_acoustic(iglob)) * coef1_1 &
- + potential_acoustic(iglob) * coef2_1
- rmemory_potential_acoustic(i,j,k,ispec_CPML,2)=coef0_2 * rmemory_potential_acoustic(i,j,k,ispec_CPML,2) &
- + (potential_acoustic(iglob) + deltat*potential_dot_acoustic(iglob)) * it*deltat * coef1_2 &
- + potential_acoustic(iglob) * it*deltat * coef2_2
- rmemory_potential_acoustic(i,j,k,ispec_CPML,3)=0.0
-
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A1 = d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A2 = d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) &
- - alpha_store(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- - alpha_store(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML)
- A3 = -2.0 * alpha_store(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) + &
- alpha_store(i,j,k,ispec_CPML)**2 * ( d_store_x(i,j,k,ispec_CPML)*k_store_y(i,j,k,ispec_CPML) &
- + d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) + alpha_store(i,j,k,ispec_CPML)**2 &
- * it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- A4 = -alpha_store(i,j,k,ispec_CPML)**2 * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- A5 = 0.0
-
- else if( CPML_regions(ispec_CPML) == CPML_XZ_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- XZ-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- rmemory_potential_acoustic(i,j,k,ispec_CPML,1)=coef0_1 * rmemory_potential_acoustic(i,j,k,ispec_CPML,1) &
- + (potential_acoustic(iglob) + deltat*potential_dot_acoustic(iglob)) * coef1_1 &
- + potential_acoustic(iglob) * coef2_1
- rmemory_potential_acoustic(i,j,k,ispec_CPML,2)=coef0_2 * rmemory_potential_acoustic(i,j,k,ispec_CPML,2) &
- + (potential_acoustic(iglob) + deltat*potential_dot_acoustic(iglob)) * it*deltat * coef1_2 &
- + potential_acoustic(iglob) * it*deltat * coef2_2
- rmemory_potential_acoustic(i,j,k,ispec_CPML,3)= 0.0
-
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A1 = d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)&
- + d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML)
- A2 = d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) &
- - alpha_store(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- - alpha_store(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A3 = -2.0 * alpha_store(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) &
- + alpha_store(i,j,k,ispec_CPML)**2 * ( d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) + alpha_store(i,j,k,ispec_CPML)**2 &
- * it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A4 = -alpha_store(i,j,k,ispec_CPML)**2 * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A5 = 0.0
-
- else if( CPML_regions(ispec_CPML) == CPML_YZ_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- YZ-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- rmemory_potential_acoustic(i,j,k,ispec_CPML,1)=coef0_1 * rmemory_potential_acoustic(i,j,k,ispec_CPML,1) &
- + (potential_acoustic(iglob) + deltat*potential_dot_acoustic(iglob)) * coef1_1 &
- + potential_acoustic(iglob) * coef2_1
- rmemory_potential_acoustic(i,j,k,ispec_CPML,2)=coef0_2 * rmemory_potential_acoustic(i,j,k,ispec_CPML,2) &
- + (potential_acoustic(iglob) + deltat*potential_dot_acoustic(iglob)) * it*deltat * coef1_2 &
- + potential_acoustic(iglob) * it*deltat * coef2_2
- rmemory_potential_acoustic(i,j,k,ispec_CPML,3)=0.d0
-
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A1 = d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A2 = d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) &
- - alpha_store(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- - alpha_store(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A3 = -2.0 * alpha_store(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) &
- + alpha_store(i,j,k,ispec_CPML)**2 * ( d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) ) + alpha_store(i,j,k,ispec_CPML)**2 &
- * it*deltat * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A4 = -alpha_store(i,j,k,ispec_CPML)**2 * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A5 = 0.0
-
- else if( CPML_regions(ispec_CPML) == CPML_XYZ ) then
- !------------------------------------------------------------------------------
- !---------------------------- XYZ-corner C-PML --------------------------------
- !------------------------------------------------------------------------------
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) / bb
- coef2_1 = (1.0d0 - exp(-bb * deltat/2.0d0) ) * exp(-bb * deltat/2.0d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- coef0_3 = coef0_1
- coef1_3 = coef1_1
- coef2_3 = coef2_1
-
- rmemory_potential_acoustic(i,j,k,ispec_CPML,1)=coef0_1 * rmemory_potential_acoustic(i,j,k,ispec_CPML,1) &
- + (potential_acoustic(iglob) + deltat*potential_dot_acoustic(iglob)) * coef1_1 &
- + potential_acoustic(iglob) * coef2_1
- rmemory_potential_acoustic(i,j,k,ispec_CPML,2)=coef0_2 * rmemory_potential_acoustic(i,j,k,ispec_CPML,2) &
- + (potential_acoustic(iglob) + deltat*potential_dot_acoustic(iglob)) * it*deltat * coef1_2 &
- + potential_acoustic(iglob) * it*deltat * coef2_2
- rmemory_potential_acoustic(i,j,k,ispec_CPML,3)=coef0_3 * rmemory_potential_acoustic(i,j,k,ispec_CPML,3) &
- + (potential_acoustic(iglob) + deltat*potential_dot_acoustic(iglob)) * (it*deltat)**2 * coef1_3 &
- + potential_acoustic(iglob) * (it*deltat)**2 * coef2_3
-
- !---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A1 = d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) + &
- d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) + &
- d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A2 = k_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) + &
- k_store_y(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) + &
- k_store_z(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) - &
- d_store_x(i,j,k,ispec_CPML) * alpha_store(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) * &
- k_store_z(i,j,k,ispec_CPML) - d_store_y(i,j,k,ispec_CPML) * alpha_store(i,j,k,ispec_CPML) * &
- k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) - d_store_z(i,j,k,ispec_CPML) * &
- alpha_store(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- temp_A3 = d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) - &
- 2.0 * alpha_store(i,j,k,ispec_CPML) * ( &
- d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) + &
- d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) + &
- d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- ) + alpha_store(i,j,k,ispec_CPML)**2 * ( &
- d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) + &
- d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) + &
- d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- )
-! temp_A4 = -2.0 * alpha_store(i,j,k,ispec_CPML) * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * &
-! d_store_z(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)**2 * ( &
-! d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) + &
-! d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) + &
-! d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
-! )
-! temp_A5 = 0.5 * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
-! A3 = temp_A3 + it*deltat*temp_A4 + (it*deltat)**2*temp_A5
-! A4 = -temp_A4 -2.0*it*deltat*temp_A5
-! A5 = temp_A5
-
-!!! the full experssion of A3,A4,A5 are given by above equation, here we use reduced
-!!! exprssion of A3,A4,A5 in order to stabilized the code.
-
- A3 = temp_A3
- A4 = 0.0
- A5 = 0.0
-
- endif
-
- potential_dot_dot_acoustic_CPML(i,j,k) = wgllcube * kappal_inv *jacobianl * &
- ( A1 * potential_dot_acoustic(iglob) + A2 * potential_acoustic(iglob) + &
- A3 * rmemory_potential_acoustic(i,j,k,ispec_CPML,1)+ &
- A4 * rmemory_potential_acoustic(i,j,k,ispec_CPML,2)+ &
- A5 * rmemory_potential_acoustic(i,j,k,ispec_CPML,3) &
+ potential_dot_dot_acoustic_CPML(i,j,k) = wgllcube * kappal_inv * jacobianl * &
+ ( A_1 * potential_dot_acoustic(iglob) + A_2 * potential_acoustic(iglob) + &
+ A_3 * rmemory_potential_acoustic(i,j,k,ispec_CPML,1)+ &
+ A_4 * rmemory_potential_acoustic(i,j,k,ispec_CPML,2)+ &
+ A_5 * rmemory_potential_acoustic(i,j,k,ispec_CPML,3) &
)
enddo
enddo
@@ -944,3 +436,464 @@
enddo
end subroutine read_potential_on_pml_interface
+!
+!=====================================================================
+!
+subroutine l_parameter_computation( &
+ time, deltat, &
+ kappa_x, beta_x, alpha_x, &
+ kappa_y, beta_y, alpha_y, &
+ kappa_z, beta_z, alpha_z, &
+ CPML_region_local, &
+ A_0, A_1, A_2, A_3, A_4, A_5, &
+ coef0_x, coef1_x, coef2_x, &
+ coef0_y, coef1_y, coef2_y, &
+ coef0_z, coef1_z, coef2_z, &
+ singularity_type_4, singularity_type_5, &
+ FIRST_ORDER_CONVOLUTION )
+
+ use constants, only: CUSTOM_REAL, CPML_XYZ, &
+ CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY, &
+ CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY
+
+ implicit none
+
+ real(kind=CUSTOM_REAL), intent(in) :: time,deltat
+ real(kind=CUSTOM_REAL), intent(in) :: kappa_x,beta_x,alpha_x, &
+ kappa_y,beta_y,alpha_y, &
+ kappa_z,beta_z,alpha_z
+ integer, intent(in) :: CPML_region_local
+ logical, intent(in) :: FIRST_ORDER_CONVOLUTION
+
+ real(kind=CUSTOM_REAL), intent(out) :: A_0, A_1, A_2, A_3, A_4, A_5
+ real(kind=CUSTOM_REAL), intent(out) :: coef0_x, coef1_x, coef2_x, &
+ coef0_y, coef1_y, coef2_y, &
+ coef0_z, coef1_z, coef2_z
+ integer, intent(out) :: singularity_type_4, singularity_type_5
+
+ !local variable
+ real(kind=CUSTOM_REAL) :: bar_A_0, bar_A_1, bar_A_2, bar_A_3, bar_A_4, bar_A_5
+ real(kind=CUSTOM_REAL) :: bb, alpha_0, beta_xyz_1, beta_xyz_2, beta_xyz_3
+
+ beta_xyz_1 = beta_x + beta_y + beta_z
+ beta_xyz_2 = beta_x * beta_y + beta_x * beta_z + beta_y * beta_z
+ beta_xyz_3 = beta_x * beta_y * beta_z
+
+ if ( CPML_region_local == CPML_XYZ ) then
+
+ bar_A_0 = kappa_x * kappa_y * kappa_z
+ bar_A_1 = bar_A_0 * (beta_x + beta_y + beta_z - alpha_x - alpha_y - alpha_z)
+ bar_A_2 = bar_A_0 * (beta_x - alpha_x) * (beta_y - alpha_y - alpha_x) &
+ + bar_A_0 * (beta_y - alpha_y) * (beta_z - alpha_z - alpha_y) &
+ + bar_A_0 * (beta_z - alpha_z) * (beta_x - alpha_x - alpha_z)
+
+ A_0 = bar_A_0
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+
+ if ( &
+ abs( alpha_x - alpha_y ) >= 1.e-5_CUSTOM_REAL .AND. &
+ abs( alpha_x - alpha_z ) >= 1.e-5_CUSTOM_REAL .AND. &
+ abs( alpha_y - alpha_z ) >= 1.e-5_CUSTOM_REAL &
+ ) then
+
+ bar_A_3 = bar_A_0 * alpha_x**2 &
+ * (beta_x - alpha_x) * (beta_y - alpha_x) * (beta_z - alpha_x) &
+ / (alpha_y - alpha_x) / (alpha_z - alpha_x)
+ bar_A_4 = bar_A_0 * alpha_y**2 &
+ * (beta_x - alpha_y) * (beta_y - alpha_y) * (beta_z - alpha_y) &
+ / (alpha_x - alpha_y) / (alpha_z - alpha_y)
+ bar_A_5 = bar_A_0 * alpha_z**2 &
+ * (beta_x - alpha_z) * (beta_y - alpha_z) * (beta_z - alpha_z) &
+ / (alpha_y - alpha_z) / (alpha_x - alpha_z)
+
+ A_3 = bar_A_3
+ A_4 = bar_A_4
+ A_5 = bar_A_5
+
+ singularity_type_4 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_5 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+
+ else if ( &
+ abs( alpha_x - alpha_y ) < 1.e-5_CUSTOM_REAL .AND. &
+ abs( alpha_x - alpha_z ) >= 1.e-5_CUSTOM_REAL .AND. &
+ abs( alpha_y - alpha_z ) >= 1.e-5_CUSTOM_REAL &
+ ) then
+
+ alpha_0 = alpha_x
+ bar_A_3 = bar_A_0 * alpha_0 / (alpha_z - alpha_0)**2 * ( &
+ - alpha_0**3 * (4._CUSTOM_REAL * alpha_0 - 5._CUSTOM_REAL * alpha_z) &
+ + alpha_0**2 * (3._CUSTOM_REAL * alpha_0 - 4._CUSTOM_REAL * alpha_z) * beta_xyz_1 &
+ - alpha_0 * (2._CUSTOM_REAL * alpha_0 - 3._CUSTOM_REAL * alpha_z) * beta_xyz_2 &
+ + (alpha_0 - 2._CUSTOM_REAL * alpha_z) * beta_xyz_3 )
+ bar_A_4 = bar_A_0 * alpha_0**2 &
+ * (beta_x - alpha_0) * (beta_y - alpha_0) * (beta_z - alpha_0) &
+ / (alpha_z - alpha_0)
+ bar_A_5 = bar_A_0 * alpha_z**2 &
+ * (beta_x - alpha_z) * (beta_y - alpha_z) * (beta_z - alpha_z) &
+ / (alpha_0 - alpha_z) / (alpha_0 - alpha_z)
+
+ A_3 = bar_A_3 + time * bar_A_4
+ A_4 = - bar_A_4
+ A_5 = bar_A_5
+
+ singularity_type_4 = 1 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_5 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+
+ else if ( &
+ abs( alpha_x - alpha_y ) >= 1.e-5_CUSTOM_REAL .AND. &
+ abs( alpha_x - alpha_z ) < 1.e-5_CUSTOM_REAL .AND. &
+ abs( alpha_y - alpha_z ) >= 1.e-5_CUSTOM_REAL &
+ ) then
+
+ alpha_0 = alpha_x
+ bar_A_3 = bar_A_0 * alpha_0 / (alpha_y - alpha_0)**2 * ( &
+ - alpha_0**3 * (4._CUSTOM_REAL * alpha_0 - 5._CUSTOM_REAL * alpha_y) &
+ + alpha_0**2 * (3._CUSTOM_REAL * alpha_0 - 4._CUSTOM_REAL * alpha_y) * beta_xyz_1 &
+ - alpha_0 * (2._CUSTOM_REAL * alpha_0 - 3._CUSTOM_REAL * alpha_y) * beta_xyz_2 &
+ + (alpha_0 - 2._CUSTOM_REAL * alpha_y) * beta_xyz_3 )
+ bar_A_4 = bar_A_0 * alpha_y**2 &
+ * (beta_x - alpha_y) * (beta_y - alpha_y) * (beta_z - alpha_y) &
+ / (alpha_0 - alpha_y) / (alpha_0 - alpha_y)
+ bar_A_5 = bar_A_0 * alpha_0**2 &
+ * (beta_x - alpha_0) * (beta_y - alpha_0) * (beta_z - alpha_0) &
+ / (alpha_y - alpha_0)
+
+ A_3 = bar_A_3 + time * bar_A_5
+ A_4 = bar_A_4
+ A_5 = - bar_A_5
+
+ singularity_type_4 = 0
+ singularity_type_5 = 1
+
+ else if ( &
+ abs( alpha_x - alpha_y ) >= 1.e-5_CUSTOM_REAL .AND. &
+ abs( alpha_x - alpha_z ) >= 1.e-5_CUSTOM_REAL .AND. &
+ abs( alpha_y - alpha_z ) < 1.e-5_CUSTOM_REAL &
+ ) then
+
+ alpha_0 = alpha_y
+ bar_A_3 = bar_A_0 * alpha_x**2 &
+ * (beta_x - alpha_x) * (beta_y - alpha_x) * (beta_z - alpha_x) &
+ / (alpha_0 - alpha_x) / (alpha_0 - alpha_x)
+ bar_A_4 = bar_A_0 * alpha_0 / (alpha_x - alpha_0)**2 * ( &
+ - alpha_0**3 * (4._CUSTOM_REAL * alpha_0 - 5._CUSTOM_REAL * alpha_x) &
+ + alpha_0**2 * (3._CUSTOM_REAL * alpha_0 - 4._CUSTOM_REAL * alpha_x) * beta_xyz_1 &
+ - alpha_0 * (2._CUSTOM_REAL * alpha_0 - 3._CUSTOM_REAL * alpha_x ) * beta_xyz_2 &
+ + (alpha_0 - 2._CUSTOM_REAL * alpha_x) * beta_xyz_3 )
+ bar_A_5 = bar_A_0 * alpha_0**2 &
+ * (beta_x - alpha_0) * (beta_y - alpha_0) * (beta_z - alpha_0) &
+ / (alpha_x - alpha_0)
+
+ A_3 = bar_A_3
+ A_4 = bar_A_4 + time * bar_A_5
+ A_5 = - bar_A_5
+
+ singularity_type_4 = 0
+ singularity_type_5 = 1
+
+ else if ( &
+ abs( alpha_x - alpha_y ) < 1.e-5_CUSTOM_REAL .AND. &
+ abs( alpha_x - alpha_z ) < 1.e-5_CUSTOM_REAL .AND. &
+ abs( alpha_y - alpha_z ) < 1.e-5_CUSTOM_REAL &
+ ) then
+
+ alpha_0 = alpha_x
+ bar_A_3 = bar_A_0 * ( &
+ - 10._CUSTOM_REAL * alpha_0**3 &
+ + 6._CUSTOM_REAL * alpha_0**2 * beta_xyz_1 &
+ - 3._CUSTOM_REAL * alpha_0 * beta_xyz_2 &
+ + beta_xyz_3 )
+ bar_A_4 = bar_A_0 * alpha_0 * ( &
+ 5._CUSTOM_REAL * alpha_0**3 &
+ - 4._CUSTOM_REAL * alpha_0**2 * beta_xyz_1 &
+ + 3._CUSTOM_REAL * alpha_0 * beta_xyz_2 &
+ - 2._CUSTOM_REAL * beta_xyz_3 )
+ bar_A_5 = bar_A_0 * alpha_0**2 / 2._CUSTOM_REAL &
+ * (beta_x - alpha_0) * (beta_y - alpha_0) * (beta_z - alpha_0)
+
+ A_3 = bar_A_3 + time * bar_A_4 + time**2 * bar_A_5
+ A_4 = - bar_A_4 - 2._CUSTOM_REAL * time * bar_A_5
+ A_5 = bar_A_5
+
+ singularity_type_4 = 1
+ singularity_type_5 = 2
+ end if
+
+ else if ( CPML_region_local == CPML_XY_ONLY ) then
+
+ bar_A_0 = kappa_x * kappa_y
+ bar_A_1 = bar_A_0 * (beta_x + beta_y - alpha_x - alpha_y)
+ bar_A_2 = bar_A_0 * (beta_x - alpha_x) * (beta_y - alpha_y - alpha_x) &
+ - bar_A_0 * (beta_y - alpha_y) * alpha_y
+
+ A_0 = bar_A_0
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+
+ beta_xyz_1 = beta_x + beta_y
+ beta_xyz_2 = beta_x * beta_y
+
+ if ( abs( alpha_x - alpha_y ) >= 1.e-5_CUSTOM_REAL ) then
+
+ bar_A_3 = bar_A_0 * alpha_x**2 &
+ * (beta_x - alpha_x) * (beta_y - alpha_x) &
+ / (alpha_y - alpha_x)
+ bar_A_4 = bar_A_0 * alpha_y**2 &
+ * (beta_x - alpha_y) * (beta_y - alpha_y) &
+ / (alpha_x - alpha_y)
+ bar_A_5 = 0._CUSTOM_REAL
+
+ A_3 = bar_A_3
+ A_4 = bar_A_4
+ A_5 = bar_A_5
+
+ singularity_type_4 = 0
+ singularity_type_5 = 0
+
+ else if ( abs( alpha_x - alpha_y ) < 1.e-5_CUSTOM_REAL ) then
+
+ alpha_0 = alpha_x
+ bar_A_3 = bar_A_0 * ( &
+ - 4._CUSTOM_REAL * alpha_0**3 &
+ + 3._CUSTOM_REAL * alpha_0**2 * beta_xyz_1 &
+ - 2._CUSTOM_REAL * alpha_0 * beta_xyz_2 )
+
+ bar_A_4 = bar_A_0 * alpha_0**2 * (beta_x - alpha_0) * (beta_y - alpha_0)
+ bar_A_5 = 0._CUSTOM_REAL
+
+ A_3 = bar_A_3 + time * bar_A_4
+ A_4 = -bar_A_4
+ A_5 = bar_A_5
+
+ singularity_type_4 = 1
+ singularity_type_5 = 0
+
+ end if
+
+ else if ( CPML_region_local == CPML_XZ_ONLY ) then
+
+ bar_A_0 = kappa_x * kappa_z
+ bar_A_1 = bar_A_0 * (beta_x + beta_z - alpha_x - alpha_z)
+ bar_A_2 = bar_A_0 * (beta_x - alpha_x) * (beta_z - alpha_z - alpha_x) &
+ - bar_A_0 * (beta_z - alpha_z) * alpha_z
+
+ A_0 = bar_A_0
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+
+ beta_xyz_1 = beta_x + beta_z
+ beta_xyz_2 = beta_x * beta_z
+
+ if ( abs( alpha_x - alpha_z ) >= 1.e-5_CUSTOM_REAL ) then
+
+ bar_A_3 = bar_A_0 * alpha_x**2 &
+ * (beta_x - alpha_x) * (beta_z - alpha_x) &
+ / (alpha_z - alpha_x)
+ bar_A_4 = 0._CUSTOM_REAL
+ bar_A_5 = bar_A_0 * alpha_z**2 &
+ * (beta_x - alpha_z) * (beta_z - alpha_z) &
+ / (alpha_x - alpha_z)
+
+ A_3 = bar_A_3
+ A_4 = bar_A_4
+ A_5 = bar_A_5
+
+ singularity_type_4 = 0
+ singularity_type_5 = 0
+
+ else if ( abs( alpha_x - alpha_z ) < 1.e-5_CUSTOM_REAL ) then
+
+ alpha_0 = alpha_x
+ bar_A_3 = bar_A_0 * ( &
+ - 4._CUSTOM_REAL * alpha_0**3 &
+ + 3._CUSTOM_REAL * alpha_0**2 * beta_xyz_1 &
+ - 2._CUSTOM_REAL * alpha_0 * beta_xyz_2 )
+ bar_A_4 = 0._CUSTOM_REAL
+ bar_A_5 = bar_A_0 * alpha_0**2 * (beta_x - alpha_0) * (beta_z - alpha_0)
+
+ A_3 = bar_A_3 + time * bar_A_5
+ A_4 = bar_A_4
+ A_5 = -bar_A_5
+
+ singularity_type_4 = 0
+ singularity_type_5 = 1
+
+ end if
+
+ else if ( CPML_region_local == CPML_YZ_ONLY ) then
+
+ bar_A_0 = kappa_y * kappa_z
+ bar_A_1 = bar_A_0 * (beta_y + beta_z - alpha_y - alpha_z)
+ bar_A_2 = bar_A_0 * (beta_y - alpha_y) * (beta_z - alpha_z - alpha_y) &
+ - bar_A_0 * (beta_z - alpha_z) * alpha_z
+
+ A_0 = bar_A_0
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+
+ beta_xyz_1 = beta_y + beta_z
+ beta_xyz_2 = beta_y * beta_z
+
+ if ( abs( alpha_y - alpha_z ) >= 1.e-5_CUSTOM_REAL ) then
+
+ bar_A_3 = 0._CUSTOM_REAL
+ bar_A_4 = bar_A_0 * alpha_y**2 &
+ * (beta_y - alpha_y) * (beta_z - alpha_y) &
+ / (alpha_z - alpha_y)
+ bar_A_5 = bar_A_0 * alpha_z**2 &
+ * (beta_y - alpha_z) * (beta_z - alpha_z) &
+ / (alpha_y - alpha_z)
+
+ A_3 = bar_A_3
+ A_4 = bar_A_4
+ A_5 = bar_A_5
+
+ singularity_type_4 = 0
+ singularity_type_5 = 0
+
+ else if ( abs( alpha_y - alpha_z ) < 1.e-5_CUSTOM_REAL ) then
+
+ alpha_0 = alpha_y
+ bar_A_3 = 0._CUSTOM_REAL
+ bar_A_4 = bar_A_0 * ( &
+ - 4._CUSTOM_REAL * alpha_0**3 &
+ + 3._CUSTOM_REAL * alpha_0**2 * beta_xyz_1 &
+ - 2._CUSTOM_REAL * alpha_0 * beta_xyz_2 )
+ bar_A_5 = bar_A_0 * alpha_0**2 * (beta_y - alpha_0) * (beta_z - alpha_0)
+
+ A_3 = bar_A_3
+ A_4 = bar_A_4 + time * bar_A_5
+ A_5 = -bar_A_5
+
+ singularity_type_4 = 0
+ singularity_type_5 = 1
+
+ end if
+
+ else if ( CPML_region_local == CPML_X_ONLY ) then
+
+ bar_A_0 = kappa_x
+ bar_A_1 = bar_A_0 * (beta_x - alpha_x)
+ bar_A_2 = - bar_A_0 * alpha_x * (beta_x - alpha_x)
+
+ A_0 = bar_A_0
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+
+ bar_A_3 = bar_A_0 * alpha_x**2 * (beta_x - alpha_x)
+ bar_A_4 = 0._CUSTOM_REAL
+ bar_A_5 = 0._CUSTOM_REAL
+
+ A_3 = bar_A_3
+ A_4 = bar_A_4
+ A_5 = bar_A_5
+
+ singularity_type_4 = 0
+ singularity_type_5 = 0
+
+ else if ( CPML_region_local == CPML_Y_ONLY ) then
+
+ bar_A_0 = kappa_y
+ bar_A_1 = bar_A_0 * (beta_y - alpha_y)
+ bar_A_2 = - bar_A_0 * alpha_y * (beta_y - alpha_y)
+
+ A_0 = bar_A_0
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+
+ bar_A_3 = 0._CUSTOM_REAL
+ bar_A_4 = bar_A_0 * alpha_y**2 * (beta_y - alpha_y)
+ bar_A_5 = 0._CUSTOM_REAL
+
+ A_3 = bar_A_3
+ A_4 = bar_A_4
+ A_5 = bar_A_5
+
+ singularity_type_4 = 0
+ singularity_type_5 = 0
+
+ else if ( CPML_region_local == CPML_Z_ONLY ) then
+
+ bar_A_0 = kappa_z
+ bar_A_1 = bar_A_0 * (beta_z - alpha_z)
+ bar_A_2 = - bar_A_0 * alpha_z * (beta_z - alpha_z)
+
+ A_0 = bar_A_0
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+
+ bar_A_3 = 0._CUSTOM_REAL
+ bar_A_4 = 0._CUSTOM_REAL
+ bar_A_5 = bar_A_0 * alpha_z**2 * (beta_z - alpha_z)
+
+ A_3 = bar_A_3
+ A_4 = bar_A_4
+ A_5 = bar_A_5
+
+ singularity_type_4 = 0
+ singularity_type_5 = 0
+
+ end if
+
+ bb = alpha_x
+ coef0_x = exp(-bb * deltat)
+ if ( abs(bb) >= 1.e-5_CUSTOM_REAL ) then
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_x = (1._CUSTOM_REAL - exp(-bb * deltat) ) / bb
+ coef2_x = 0._CUSTOM_REAL
+ else
+ coef1_x = (1._CUSTOM_REAL - exp(-bb * deltat/2._CUSTOM_REAL) ) / bb
+ coef2_x = (1._CUSTOM_REAL - exp(-bb * deltat/2._CUSTOM_REAL) ) * exp(-bb * deltat/2._CUSTOM_REAL) / bb
+ end if
+ else
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_x = deltat
+ coef2_x = 0._CUSTOM_REAL
+ else
+ coef1_x = deltat/2._CUSTOM_REAL
+ coef2_x = deltat/2._CUSTOM_REAL
+ end if
+ endif
+
+ bb = alpha_y
+ coef0_y = exp(-bb * deltat)
+ if ( abs(bb) >= 1.e-5_CUSTOM_REAL ) then
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_y = (1._CUSTOM_REAL - exp(-bb * deltat) ) / bb
+ coef2_y = 0._CUSTOM_REAL
+ else
+ coef1_y = (1._CUSTOM_REAL - exp(-bb * deltat/2._CUSTOM_REAL) ) / bb
+ coef2_y = (1._CUSTOM_REAL - exp(-bb * deltat/2._CUSTOM_REAL) ) * exp(-bb * deltat/2._CUSTOM_REAL) / bb
+ end if
+ else
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_y = deltat
+ coef2_y = 0._CUSTOM_REAL
+ else
+ coef1_y = deltat/2._CUSTOM_REAL
+ coef2_y = deltat/2._CUSTOM_REAL
+ end if
+ endif
+
+ bb = alpha_z
+ coef0_z = exp(-bb * deltat)
+ if ( abs(bb) >= 1.e-5_CUSTOM_REAL ) then
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_z = (1._CUSTOM_REAL - exp(-bb * deltat) ) / bb
+ coef2_z = 0._CUSTOM_REAL
+ else
+ coef1_z = (1._CUSTOM_REAL - exp(-bb * deltat/2._CUSTOM_REAL) ) / bb
+ coef2_z = (1._CUSTOM_REAL - exp(-bb * deltat/2._CUSTOM_REAL) ) * exp(-bb * deltat/2._CUSTOM_REAL) / bb
+ end if
+ else
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_z = deltat
+ coef2_z = 0._CUSTOM_REAL
+ else
+ coef1_z = deltat/2._CUSTOM_REAL
+ coef2_z = deltat/2._CUSTOM_REAL
+ end if
+ endif
+
+end subroutine l_parameter_computation
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_memory_variables.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_memory_variables.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_memory_variables.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -45,12 +45,12 @@
xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz,jacobian, &
kappastore,mustore
use pml_par, only: NSPEC_CPML,CPML_regions,k_store_x,k_store_y,k_store_z,&
- d_store_x,d_store_y,d_store_z,alpha_store, &
+ d_store_x,d_store_y,d_store_z,alpha_store_x,alpha_store_y,alpha_store_z, &
PML_dux_dxl, PML_dux_dyl, PML_dux_dzl, PML_duy_dxl, PML_duy_dyl, PML_duy_dzl, &
PML_duz_dxl, PML_duz_dyl, PML_duz_dzl, &
- PML_dux_dxl_new, PML_dux_dyl_new, PML_dux_dzl_new, &
- PML_duy_dxl_new, PML_duy_dyl_new, PML_duy_dzl_new, &
- PML_duz_dxl_new, PML_duz_dyl_new, PML_duz_dzl_new
+ PML_dux_dxl_old, PML_dux_dyl_old, PML_dux_dzl_old, &
+ PML_duy_dxl_old, PML_duy_dyl_old, PML_duy_dzl_old, &
+ PML_duz_dxl_old, PML_duz_dyl_old, PML_duz_dzl_old, displ_old
use constants, only: CUSTOM_REAL,NGLLX,NGLLY,NGLLZ,FOUR_THIRDS, &
CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY,CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY,CPML_XYZ
@@ -60,7 +60,7 @@
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ), intent(out) :: tempx1,tempx2,tempx3
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ), intent(out) :: tempy1,tempy2,tempy3
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ), intent(out) :: tempz1,tempz2,tempz3
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2) :: &
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3) :: &
rmemory_dux_dxl_x, rmemory_dux_dyl_x, rmemory_dux_dzl_x, &
rmemory_duy_dxl_y, rmemory_duy_dyl_y, rmemory_duy_dzl_y, &
rmemory_duz_dxl_z, rmemory_duz_dyl_z, rmemory_duz_dzl_z
@@ -77,17 +77,28 @@
real(kind=CUSTOM_REAL) :: duxdxl_x,duxdyl_x,duxdzl_x,duydxl_x,duydyl_x,duzdxl_x,duzdzl_x
real(kind=CUSTOM_REAL) :: duxdxl_y,duxdyl_y,duydxl_y,duydyl_y,duydzl_y,duzdyl_y,duzdzl_y
real(kind=CUSTOM_REAL) :: duxdxl_z,duxdzl_z,duydyl_z,duydzl_z,duzdxl_z,duzdyl_z,duzdzl_z
- real(kind=CUSTOM_REAL) :: bb,coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2
- real(kind=CUSTOM_REAL) :: A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17 ! for convolution of strain(complex)
- real(kind=CUSTOM_REAL) :: A18,A19,A20 ! for convolution of strain(simple)
+ real(kind=CUSTOM_REAL) :: time_nplus1,time_n
+ real(kind=CUSTOM_REAL) :: A6,A7,A8,A9 ! L231
+ real(kind=CUSTOM_REAL) :: A10,A11,A12,A13 ! L132
+ real(kind=CUSTOM_REAL) :: A14,A15,A16,A17 ! L123
+ real(kind=CUSTOM_REAL) :: A18,A19 ! L1
+ real(kind=CUSTOM_REAL) :: A20,A21 ! L2
+ real(kind=CUSTOM_REAL) :: A22,A23 ! L3
+ real(kind=CUSTOM_REAL) :: coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,coef0_3,coef1_3,coef2_3
+ integer :: CPML_region_local
+ integer :: singularity_type_2,singularity_type_3
+ real(kind=CUSTOM_REAL) :: kappa_x,kappa_y,kappa_z,d_x,d_y,d_z,alpha_x,alpha_y,alpha_z,&
+ beta_x,beta_y,beta_z
+ CPML_region_local = CPML_regions(ispec_CPML)
+
do k=1,NGLLZ
do j=1,NGLLY
do i=1,NGLLX
kappal = kappastore(i,j,k,ispec)
mul = mustore(i,j,k,ispec)
lambdalplus2mul = kappal + FOUR_THIRDS * mul
- lambdal = lambdalplus2mul - 2.0d0*mul
+ lambdal = lambdalplus2mul - 2.0_CUSTOM_REAL*mul
xixl = xix(i,j,k,ispec)
xiyl = xiy(i,j,k,ispec)
xizl = xiz(i,j,k,ispec)
@@ -99,1217 +110,272 @@
gammazl = gammaz(i,j,k,ispec)
jacobianl = jacobian(i,j,k,ispec)
- if( CPML_regions(ispec_CPML) == CPML_X_ONLY ) then
+ kappa_x = k_store_x(i,j,k,ispec_CPML)
+ kappa_y = k_store_y(i,j,k,ispec_CPML)
+ kappa_z = k_store_z(i,j,k,ispec_CPML)
+ d_x = d_store_x(i,j,k,ispec_CPML)
+ d_y = d_store_y(i,j,k,ispec_CPML)
+ d_z = d_store_z(i,j,k,ispec_CPML)
+ alpha_x = alpha_store_x(i,j,k,ispec_CPML)
+ alpha_y = alpha_store_y(i,j,k,ispec_CPML)
+ alpha_z = alpha_store_z(i,j,k,ispec_CPML)
+ beta_x = alpha_x + d_x / kappa_x
+ beta_y = alpha_y + d_y / kappa_y
+ beta_z = alpha_z + d_z / kappa_z
+ time_nplus1 = (it-1.0_CUSTOM_REAL) * deltat
+ time_n = (it-2.0_CUSTOM_REAL) * deltat
- !------------------------------------------------------------------------------
- !---------------------------- X-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
+ !---------------------- A6, A7, A8, A9 --------------------------
+ call lijk_parameter_computation(time_nplus1,deltat,&
+ kappa_z,beta_z,alpha_z,kappa_y,beta_y,alpha_y,kappa_x,beta_x,alpha_x,&
+ CPML_region_local,231,A6,A7,A8,A9,&
+ coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,&
+ coef0_3,coef1_3,coef2_3,singularity_type_2,singularity_type_3)
+ rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) &
+ + PML_dux_dxl(i,j,k) * coef1_1 + PML_dux_dxl_old(i,j,k) * coef2_1
+ rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) &
+ + PML_duy_dxl(i,j,k) * coef1_1 + PML_duy_dxl_old(i,j,k) * coef2_1
+ rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) &
+ + PML_duz_dxl(i,j,k) * coef1_1 + PML_duz_dxl_old(i,j,k) * coef2_1
- !---------------------- A6, A7 and A8 --------------------------
- A6 = 1.d0 / k_store_x(i,j,k,ispec_CPML)
- A7 = 0.d0
- A8 = - d_store_x(i,j,k,ispec_CPML) / (k_store_x(i,j,k,ispec_CPML)**2)
-
- bb = d_store_x(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_2 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
+ if(singularity_type_2 == 0)then
rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dxl_new(i,j,k) * coef1_2 + PML_dux_dxl(i,j,k) * coef2_2
-
- rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) = 0.d0
+ + PML_dux_dxl(i,j,k) * coef1_2 + PML_dux_dxl_old(i,j,k) * coef2_2
rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dxl_new(i,j,k) * coef1_2 + PML_duy_dxl(i,j,k) * coef2_2
-
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) = 0.d0
+ + PML_duy_dxl(i,j,k) * coef1_2 + PML_duy_dxl_old(i,j,k) * coef2_2
rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dxl_new(i,j,k) * coef1_2 + PML_duz_dxl(i,j,k) * coef2_2
-
- !---------------------- A9, A10 and A11 --------------------------
- A9 = k_store_x(i,j,k,ispec_CPML)
- A10 = d_store_x(i,j,k,ispec_CPML)
- A11 = 0.d0
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) &
- + PML_dux_dyl_new(i,j,k) * coef1_1 + PML_dux_dyl(i,j,k) * coef2_1
- rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) &
- + PML_duy_dyl_new(i,j,k) * coef1_1 + PML_duy_dyl(i,j,k) * coef2_1
- rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) &
- + PML_duz_dyl_new(i,j,k) * coef1_1 + PML_duz_dyl(i,j,k) * coef2_1
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- !---------------------- A12, A13 and A14 --------------------------
- A12 = k_store_x(i,j,k,ispec_CPML)
- A13 = d_store_x(i,j,k,ispec_CPML)
- A14 = 0.d0
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) &
- + PML_dux_dzl_new(i,j,k) * coef1_1 + PML_dux_dzl(i,j,k) * coef2_1
- rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) &
- + PML_duy_dzl_new(i,j,k) * coef1_1 + PML_duy_dzl(i,j,k) * coef2_1
- rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) &
- + PML_duz_dzl_new(i,j,k) * coef1_1 + PML_duz_dzl(i,j,k) * coef2_1
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- !---------------------- A15 and A16 --------------------------
- A15 = k_store_x(i,j,k,ispec_CPML)
- A16 = d_store_x(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_duz_dzl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dzl_y(i,j,k,ispec_CPML) &
- + PML_duz_dzl_new(i,j,k) * coef1_1 + PML_duz_dzl(i,j,k) * coef2_1
-
- rmemory_duz_dyl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dyl_y(i,j,k,ispec_CPML) &
- + PML_duz_dyl_new(i,j,k) * coef1_1 + PML_duz_dyl(i,j,k) * coef2_1
-
- rmemory_duy_dzl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dzl_z(i,j,k,ispec_CPML) &
- + PML_duy_dzl_new(i,j,k) * coef1_1 + PML_duy_dzl(i,j,k) * coef2_1
-
- rmemory_duy_dyl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dyl_z(i,j,k,ispec_CPML) &
- + PML_duy_dyl_new(i,j,k) * coef1_1 + PML_duy_dyl(i,j,k) * coef2_1
-
- !---------------------- A17 and A18 --------------------------
- A17 = 1.d0
- A18 = 0.0
-
- rmemory_duz_dzl_x(i,j,k,ispec_CPML) = 0.d0
- rmemory_duz_dxl_x(i,j,k,ispec_CPML) = 0.d0
- rmemory_dux_dzl_z(i,j,k,ispec_CPML) = 0.d0
- rmemory_dux_dxl_z(i,j,k,ispec_CPML) = 0.d0
-
- !---------------------- A19 and A20 --------------------------
- A19 = 1.d0
- A20 = 0.0
-
- rmemory_duy_dyl_x(i,j,k,ispec_CPML) = 0.d0
- rmemory_duy_dxl_x(i,j,k,ispec_CPML) = 0.d0
- rmemory_dux_dyl_y(i,j,k,ispec_CPML) = 0.d0
- rmemory_dux_dxl_y(i,j,k,ispec_CPML) = 0.d0
-
- else if( CPML_regions(ispec_CPML) == CPML_Y_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- Y-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
-
- !---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_y(i,j,k,ispec_CPML)
- A7 = d_store_y(i,j,k,ispec_CPML)
- A8 = 0.d0
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) &
- + PML_dux_dxl_new(i,j,k) * coef1_1 + PML_dux_dxl(i,j,k) * coef2_1
- rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) &
- + PML_duy_dxl_new(i,j,k) * coef1_1 + PML_duy_dxl(i,j,k) * coef2_1
- rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) &
- + PML_duz_dxl_new(i,j,k) * coef1_1 + PML_duz_dxl(i,j,k) * coef2_1
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- !---------------------- A9, A10 and A11 --------------------------
- A9 = 1.d0/k_store_y(i,j,k,ispec_CPML)
- A10 = 0.d0
- A11 = - d_store_y(i,j,k,ispec_CPML) / (k_store_y(i,j,k,ispec_CPML) ** 2)
-
- bb = d_store_y(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_2 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dyl_new(i,j,k) * coef1_2 + PML_dux_dyl(i,j,k) * coef2_2
-
- rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dyl_new(i,j,k) * coef1_2 + PML_duy_dyl(i,j,k) * coef2_2
-
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dyl_new(i,j,k) * coef1_2 + PML_duz_dyl(i,j,k) * coef2_2
-
- !---------------------- A12, A13 and A14 --------------------------
- A12 = k_store_y(i,j,k,ispec_CPML)
- A13 = d_store_y(i,j,k,ispec_CPML)
- A14 = 0.d0
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) &
- + PML_dux_dzl_new(i,j,k) * coef1_1 + PML_dux_dzl(i,j,k) * coef2_1
- rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) &
- + PML_duy_dzl_new(i,j,k) * coef1_1 + PML_duy_dzl(i,j,k) * coef2_1
- rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) &
- + PML_duz_dzl_new(i,j,k) * coef1_1 + PML_duz_dzl(i,j,k) * coef2_1
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- !---------------------- A15 and A16 --------------------------
- A15 = 1.d0
- A16 = 0.d0
-
- rmemory_duz_dzl_y(i,j,k,ispec_CPML) = 0.d0
- rmemory_duz_dyl_y(i,j,k,ispec_CPML) = 0.d0
- rmemory_duy_dzl_z(i,j,k,ispec_CPML) = 0.d0
- rmemory_duy_dyl_z(i,j,k,ispec_CPML) = 0.d0
-
- !---------------------- A17 and A18 --------------------------
- A17 = k_store_y(i,j,k,ispec_CPML)
- A18 = d_store_y(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_duz_dzl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dzl_x(i,j,k,ispec_CPML) &
- + PML_duz_dzl_new(i,j,k) * coef1_1 + PML_duz_dzl(i,j,k) * coef2_1
-
- rmemory_duz_dxl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dxl_x(i,j,k,ispec_CPML) &
- + PML_duz_dxl_new(i,j,k) * coef1_1 + PML_duz_dxl(i,j,k) * coef2_1
-
- rmemory_dux_dzl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dzl_z(i,j,k,ispec_CPML) &
- + PML_dux_dzl_new(i,j,k) * coef1_1 + PML_dux_dzl(i,j,k) * coef2_1
-
- rmemory_dux_dxl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dxl_z(i,j,k,ispec_CPML) &
- + PML_dux_dxl_new(i,j,k) * coef1_1 + PML_dux_dxl(i,j,k) * coef2_1
-
- !---------------------- A19 and A20--------------------------
- A19 = 1.d0
- A20 = 0.0
-
- rmemory_duy_dyl_x(i,j,k,ispec_CPML) = 0.d0
- rmemory_duy_dxl_x(i,j,k,ispec_CPML) = 0.d0
- rmemory_dux_dyl_y(i,j,k,ispec_CPML) = 0.d0
- rmemory_dux_dxl_y(i,j,k,ispec_CPML) = 0.d0
-
- else if( CPML_regions(ispec_CPML) == CPML_Z_ONLY ) then
-
- !------------------------------------------------------------------------------
- !---------------------------- Z-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
-
- !---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_z(i,j,k,ispec_CPML)
- A7 = d_store_z(i,j,k,ispec_CPML)
- A8 = 0.d0
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) &
- + PML_dux_dxl_new(i,j,k) * coef1_1 + PML_dux_dxl(i,j,k) * coef2_1
- rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) &
- + PML_duy_dxl_new(i,j,k) * coef1_1 + PML_duy_dxl(i,j,k) * coef2_1
- rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) &
- + PML_duz_dxl_new(i,j,k) * coef1_1 + PML_duz_dxl(i,j,k) * coef2_1
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- !---------------------- A9, A10 and A11 --------------------------
- A9 = k_store_z(i,j,k,ispec_CPML)
- A10 = d_store_z(i,j,k,ispec_CPML)
- A11 = 0.d0
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) &
- + PML_dux_dyl_new(i,j,k) * coef1_1 + PML_dux_dyl(i,j,k) * coef2_1
- rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) &
- + PML_duy_dyl_new(i,j,k) * coef1_1 + PML_duy_dyl(i,j,k) * coef2_1
- rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) &
- + PML_duz_dyl_new(i,j,k) * coef1_1 + PML_duz_dyl(i,j,k) * coef2_1
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- !---------------------- A12, A13 and A14 --------------------------
- A12 = 1.0 / k_store_z(i,j,k,ispec_CPML)
- A13 = 0.d0
- A14 = - d_store_z(i,j,k,ispec_CPML) / (k_store_z(i,j,k,ispec_CPML) ** 2)
-
- bb = d_store_z(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_2 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dzl_new(i,j,k) * coef1_2 + PML_dux_dzl(i,j,k) * coef2_2
-
- rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dzl_new(i,j,k) * coef1_2 + PML_duy_dzl(i,j,k) * coef2_2
-
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dzl_new(i,j,k) * coef1_2 + PML_duz_dzl(i,j,k) * coef2_2
-
- !---------------------- A15 and A16 --------------------------
- A15 = 1.d0
- A16 = 0.d0
-
- rmemory_duz_dzl_y(i,j,k,ispec_CPML) = 0.d0
- rmemory_duz_dyl_y(i,j,k,ispec_CPML) = 0.d0
- rmemory_duy_dzl_z(i,j,k,ispec_CPML) = 0.d0
- rmemory_duy_dyl_z(i,j,k,ispec_CPML) = 0.d0
-
- !---------------------- A17 and A18 --------------------------
- A17 = 1.d0
- A18 = 0.d0
-
- rmemory_duz_dzl_x(i,j,k,ispec_CPML) = 0.d0
- rmemory_duz_dxl_x(i,j,k,ispec_CPML) = 0.d0
- rmemory_dux_dzl_z(i,j,k,ispec_CPML) = 0.d0
- rmemory_dux_dxl_z(i,j,k,ispec_CPML) = 0.d0
-
- !---------------------- A19 and A20 --------------------------
- A19 = k_store_z(i,j,k,ispec_CPML)
- A20 = d_store_z(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_duy_dyl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dyl_x(i,j,k,ispec_CPML) &
- + PML_duy_dyl_new(i,j,k) * coef1_1 + PML_duy_dyl(i,j,k) * coef2_1
-
- rmemory_duy_dxl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dxl_x(i,j,k,ispec_CPML) &
- + PML_duy_dxl_new(i,j,k) * coef1_1 + PML_duy_dxl(i,j,k) * coef2_1
-
- rmemory_dux_dyl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dyl_y(i,j,k,ispec_CPML) &
- + PML_dux_dyl_new(i,j,k) * coef1_1 + PML_dux_dyl(i,j,k) * coef2_1
-
- rmemory_dux_dxl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dxl_y(i,j,k,ispec_CPML) &
- + PML_dux_dxl_new(i,j,k) * coef1_1 + PML_dux_dxl(i,j,k) * coef2_1
-
- else if( CPML_regions(ispec_CPML) == CPML_XY_ONLY ) then
-
- !------------------------------------------------------------------------------
- !---------------------------- XY-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
-
- !---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_y(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML)
- A7 = 0.d0
- A8 = ( d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) - &
- d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) ) / k_store_x(i,j,k,ispec_CPML)**2
-
- bb = d_store_x(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) / bb
- coef2_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
+ + PML_duz_dxl(i,j,k) * coef1_2 + PML_duz_dxl_old(i,j,k) * coef2_2
+ elseif(singularity_type_2 == 1)then
rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dxl_new(i,j,k) * coef1_2 + PML_dux_dxl(i,j,k) * coef2_2
-
- rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) = 0.d0
+ + PML_dux_dxl(i,j,k) * time_nplus1 * coef1_2 + PML_dux_dxl_old(i,j,k) * time_n * coef2_2
rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dxl_new(i,j,k) * coef1_2 + PML_duy_dxl(i,j,k) * coef2_2
-
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) = 0.d0
+ + PML_duy_dxl(i,j,k) * time_nplus1 * coef1_2 + PML_duy_dxl_old(i,j,k) * time_n * coef2_2
rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dxl_new(i,j,k) * coef1_2 + PML_duz_dxl(i,j,k) * coef2_2
+ + PML_duz_dxl(i,j,k) * time_nplus1 * coef1_2 + PML_duz_dxl_old(i,j,k) * time_n * coef2_2
+ else
+ stop 'error in singularity_type_2 computation in elastic part'
+ endif
+ if(singularity_type_3 == 0)then
+ rmemory_dux_dxl_x(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,3) &
+ + PML_dux_dxl(i,j,k) * coef1_3 + PML_dux_dxl_old(i,j,k) * coef2_3
+ rmemory_duy_dxl_y(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,3) &
+ + PML_duy_dxl(i,j,k) * coef1_3 + PML_duy_dxl_old(i,j,k) * coef2_3
+ rmemory_duz_dxl_z(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,3) &
+ + PML_duz_dxl(i,j,k) * coef1_3 + PML_duz_dxl_old(i,j,k) * coef2_3
+ elseif(singularity_type_3 == 1)then
+ rmemory_dux_dxl_x(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,3) &
+ + PML_dux_dxl(i,j,k) * time_nplus1 * coef1_3 + PML_dux_dxl_old(i,j,k) * time_n * coef2_3
+ rmemory_duy_dxl_y(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,3) &
+ + PML_duy_dxl(i,j,k) * time_nplus1 * coef1_3 + PML_duy_dxl_old(i,j,k) * time_n * coef2_3
+ rmemory_duz_dxl_z(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,3) &
+ + PML_duz_dxl(i,j,k) * time_nplus1 * coef1_3 + PML_duz_dxl_old(i,j,k) * time_n * coef2_3
+ elseif(singularity_type_3 == 2)then
+ rmemory_dux_dxl_x(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,3) &
+ + PML_dux_dxl(i,j,k) * time_nplus1**2 * coef1_3 + PML_dux_dxl_old(i,j,k) * time_n**2 * coef2_3
+ rmemory_duy_dxl_y(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,3) &
+ + PML_duy_dxl(i,j,k) * time_nplus1**2 * coef1_3 + PML_duy_dxl_old(i,j,k) * time_n**2 * coef2_3
+ rmemory_duz_dxl_z(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,3) &
+ + PML_duz_dxl(i,j,k) * time_nplus1**2 * coef1_3 + PML_duz_dxl_old(i,j,k) * time_n**2 * coef2_3
+ else
+ stop 'error in singularity_type_3 computation in elastic part'
+ endif
- !---------------------- A9, A10 and A11 --------------------------
- A9 = k_store_x(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML)
- A10 = 0.d0
- A11 = ( d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) - &
- d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) / k_store_y(i,j,k,ispec_CPML)**2
- bb = d_store_y(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
+ !---------------------- A10,A11,A12,A13 --------------------------
+ call lijk_parameter_computation(time_nplus1,deltat,&
+ kappa_x,beta_x,alpha_x,kappa_z,beta_z,alpha_z,kappa_y,beta_y,alpha_y,&
+ CPML_region_local,132,A10,A11,A12,A13,&
+ coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,&
+ coef0_3,coef1_3,coef2_3,singularity_type_2,singularity_type_3)
+ rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) &
+ + PML_dux_dyl(i,j,k) * coef1_1 + PML_dux_dyl_old(i,j,k) * coef2_1
+ rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) &
+ + PML_duy_dyl(i,j,k) * coef1_1 + PML_duy_dyl_old(i,j,k) * coef2_1
+ rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) &
+ + PML_duz_dyl(i,j,k) * coef1_1 + PML_duz_dyl_old(i,j,k) * coef2_1
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) / bb
- coef2_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) = 0.d0
+ if(singularity_type_2 == 0) then
rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dyl_new(i,j,k) * coef1_2 + PML_dux_dyl(i,j,k) * coef2_2
-
- rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
+ + PML_dux_dyl(i,j,k) * coef1_2 + PML_dux_dyl_old(i,j,k) * coef2_2
rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dyl_new(i,j,k) * coef1_2 + PML_duy_dyl(i,j,k) * coef2_2
-
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) = 0.d0
+ + PML_duy_dyl(i,j,k) * coef1_2 + PML_duy_dyl_old(i,j,k) * coef2_2
rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dyl_new(i,j,k) * coef1_2 + PML_duz_dyl(i,j,k) * coef2_2
-
- !---------------------- A12, A13 and A14 --------------------------
- A12 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A13 = d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- + d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- A14 = - d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) &
- + PML_dux_dzl_new(i,j,k) * coef1_1 + PML_dux_dzl(i,j,k) * coef2_1
- rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dzl_new(i,j,k) * it*deltat * coef1_2 + PML_dux_dzl(i,j,k) * it*deltat * coef2_2
-
- rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) &
- + PML_duy_dzl_new(i,j,k) * coef1_1 + PML_duy_dzl(i,j,k) * coef2_1
- rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dzl_new(i,j,k) * it*deltat * coef1_2 + PML_duy_dzl(i,j,k) * it*deltat * coef2_2
-
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) &
- + PML_duz_dzl_new(i,j,k) * coef1_1 + PML_duz_dzl(i,j,k) * coef2_1
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dzl_new(i,j,k) * it*deltat * coef1_2 + PML_duz_dzl(i,j,k) * it*deltat * coef2_2
-
- !---------------------- A15 and A16 --------------------------
- A15 = k_store_x(i,j,k,ispec_CPML)
- A16 = d_store_x(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_duz_dzl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dzl_y(i,j,k,ispec_CPML) &
- + PML_duz_dzl_new(i,j,k) * coef1_1 + PML_duz_dzl(i,j,k) * coef2_1
-
- rmemory_duz_dyl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dyl_y(i,j,k,ispec_CPML) &
- + PML_duz_dyl_new(i,j,k) * coef1_1 + PML_duz_dyl(i,j,k) * coef2_1
-
- rmemory_duy_dzl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dzl_z(i,j,k,ispec_CPML) &
- + PML_duy_dzl_new(i,j,k) * coef1_1 + PML_duy_dzl(i,j,k) * coef2_1
-
- rmemory_duy_dyl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dyl_z(i,j,k,ispec_CPML) &
- + PML_duy_dyl_new(i,j,k) * coef1_1 + PML_duy_dyl(i,j,k) * coef2_1
-
- !---------------------- A17 and A18 --------------------------
- A17 = k_store_y(i,j,k,ispec_CPML)
- A18 = d_store_y(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_duz_dzl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dzl_x(i,j,k,ispec_CPML) &
- + PML_duz_dzl_new(i,j,k) * coef1_1 + PML_duz_dzl(i,j,k) * coef2_1
-
- rmemory_duz_dxl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dxl_x(i,j,k,ispec_CPML) &
- + PML_duz_dxl_new(i,j,k) * coef1_1 + PML_duz_dxl(i,j,k) * coef2_1
-
- rmemory_dux_dzl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dzl_z(i,j,k,ispec_CPML) &
- + PML_dux_dzl_new(i,j,k) * coef1_1 + PML_dux_dzl(i,j,k) * coef2_1
-
- rmemory_dux_dxl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dxl_z(i,j,k,ispec_CPML) &
- + PML_dux_dxl_new(i,j,k) * coef1_1 + PML_dux_dxl(i,j,k) * coef2_1
-
- !---------------------- A19 and A20--------------------------
- A19 = 1.d0
- A20 = 0.0
-
- rmemory_duy_dyl_x(i,j,k,ispec_CPML) = 0.d0
- rmemory_duy_dxl_x(i,j,k,ispec_CPML) = 0.d0
- rmemory_dux_dyl_y(i,j,k,ispec_CPML) = 0.d0
- rmemory_dux_dxl_y(i,j,k,ispec_CPML) = 0.d0
-
- else if( CPML_regions(ispec_CPML) == CPML_XZ_ONLY ) then
-
- !------------------------------------------------------------------------------
- !---------------------------- XZ-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
-
- !---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_z(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML)
- A7 = 0.d0
- A8 = ( d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) - &
- d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) ) / k_store_x(i,j,k,ispec_CPML)**2
-
- bb = d_store_x(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) / bb
- coef2_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dxl_new(i,j,k) * coef1_2 + PML_dux_dxl(i,j,k) * coef2_2
-
- rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dxl_new(i,j,k) * coef1_2 + PML_duy_dxl(i,j,k) * coef2_2
-
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dxl_new(i,j,k) * coef1_2 + PML_duz_dxl(i,j,k) * coef2_2
-
- !---------------------- A9, A10 and A11 --------------------------
- A9 = k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A10 = d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A11 = - d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) &
- + PML_dux_dyl_new(i,j,k) * coef1_1 + PML_dux_dyl(i,j,k) * coef2_1
+ + PML_duz_dyl(i,j,k) * coef1_2 + PML_duz_dyl_old(i,j,k) * coef2_2
+ elseif(singularity_type_2 == 1)then
rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dyl_new(i,j,k) * it*deltat * coef1_2 + PML_dux_dyl(i,j,k) * it*deltat * coef2_2
-
- rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) &
- + PML_duy_dyl_new(i,j,k) * coef1_1 + PML_duy_dyl(i,j,k) * coef2_1
+ + PML_dux_dyl(i,j,k) * time_nplus1 * coef1_2 + PML_dux_dyl_old(i,j,k) * time_n * coef2_2
rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dyl_new(i,j,k) * it*deltat * coef1_2 + PML_duy_dyl(i,j,k) * it*deltat * coef2_2
-
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) &
- + PML_duz_dyl_new(i,j,k) * coef1_1 + PML_duz_dyl(i,j,k) * coef2_1
+ + PML_duy_dyl(i,j,k) * time_nplus1 * coef1_2 + PML_duy_dyl_old(i,j,k) * time_n * coef2_2
rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dyl_new(i,j,k) * it*deltat * coef1_2 + PML_duz_dyl(i,j,k) * it*deltat * coef2_2
+ + PML_duz_dyl(i,j,k) * time_nplus1 * coef1_2 + PML_duz_dyl_old(i,j,k) * time_n * coef2_2
+ else
+ stop 'error in singularity_type_2 computation in elastic part'
+ endif
- !---------------------- A12, A13 and A14 --------------------------
- A12 = k_store_x(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML)
- A13 = 0.d0
- A14 = ( d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- - d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) / k_store_z(i,j,k,ispec_CPML)**2
+ if(singularity_type_3 == 0) then
+ rmemory_dux_dyl_x(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,3) &
+ + PML_dux_dyl(i,j,k) * coef1_3 + PML_dux_dyl_old(i,j,k) * coef2_3
+ rmemory_duy_dyl_y(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,3) &
+ + PML_duy_dyl(i,j,k) * coef1_3 + PML_duy_dyl_old(i,j,k) * coef2_3
+ rmemory_duz_dyl_z(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,3) &
+ + PML_duz_dyl(i,j,k) * coef1_3 + PML_duz_dyl_old(i,j,k) * coef2_3
+ elseif(singularity_type_3 == 1)then
+ rmemory_dux_dyl_x(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,3) &
+ + PML_dux_dyl(i,j,k) * time_nplus1 * coef1_3 + PML_dux_dyl_old(i,j,k) * time_n * coef2_3
+ rmemory_duy_dyl_y(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,3) &
+ + PML_duy_dyl(i,j,k) * time_nplus1 * coef1_3 + PML_duy_dyl_old(i,j,k) * time_n * coef2_3
+ rmemory_duz_dyl_z(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,3) &
+ + PML_duz_dyl(i,j,k) * time_nplus1 * coef1_3 + PML_duz_dyl_old(i,j,k) * time_n * coef2_3
+ elseif(singularity_type_3 == 2)then
+ rmemory_dux_dyl_x(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,3) &
+ + PML_dux_dyl(i,j,k) * time_nplus1**2 * coef1_3 + PML_dux_dyl_old(i,j,k) * time_n**2 * coef2_3
+ rmemory_duy_dyl_y(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,3) &
+ + PML_duy_dyl(i,j,k) * time_nplus1**2 * coef1_3 + PML_duy_dyl_old(i,j,k) * time_n**2 * coef2_3
+ rmemory_duz_dyl_z(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,3) &
+ + PML_duz_dyl(i,j,k) * time_nplus1**2 * coef1_3 + PML_duz_dyl_old(i,j,k) * time_n**2 * coef2_3
+ else
+ stop 'error in singularity_type_3 computation in elastic part'
+ endif
- bb = d_store_z(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
+ !---------------------- A14,A15,A16,A17 --------------------------
+ call lijk_parameter_computation(time_nplus1,deltat,&
+ kappa_x,beta_x,alpha_x,kappa_y,beta_y,alpha_y,kappa_z,beta_z,alpha_z,&
+ CPML_region_local,123,A14,A15,A16,A17,&
+ coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,&
+ coef0_3,coef1_3,coef2_3,singularity_type_2,singularity_type_3)
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) / bb
- coef2_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
+ rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) &
+ + PML_dux_dzl(i,j,k) * coef1_1 + PML_dux_dzl_old(i,j,k) * coef2_1
+ rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) &
+ + PML_duy_dzl(i,j,k) * coef1_1 + PML_duy_dzl_old(i,j,k) * coef2_1
+ rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) &
+ + PML_duz_dzl(i,j,k) * coef1_1 + PML_duz_dzl_old(i,j,k) * coef2_1
- rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) = 0.d0
+ if(singularity_type_2 == 0) then
rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dzl_new(i,j,k) * coef1_2 + PML_dux_dzl(i,j,k) * coef2_2
-
- rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) = 0.d0
+ + PML_dux_dzl(i,j,k) * coef1_2 + PML_dux_dzl_old(i,j,k) * coef2_2
rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dzl_new(i,j,k) * coef1_2 + PML_duy_dzl(i,j,k) * coef2_2
-
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
+ + PML_duy_dzl(i,j,k) * coef1_2 + PML_duy_dzl_old(i,j,k) * coef2_2
rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dzl_new(i,j,k) * coef1_2 + PML_duz_dzl(i,j,k) * coef2_2
-
- !---------------------- A15 and A16 --------------------------
- A15 = k_store_x(i,j,k,ispec_CPML)
- A16 = d_store_x(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_duz_dzl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dzl_y(i,j,k,ispec_CPML) &
- + PML_duz_dzl_new(i,j,k) * coef1_1 + PML_duz_dzl(i,j,k) * coef2_1
-
- rmemory_duz_dyl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dyl_y(i,j,k,ispec_CPML) &
- + PML_duz_dyl_new(i,j,k) * coef1_1 + PML_duz_dyl(i,j,k) * coef2_1
-
- rmemory_duy_dzl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dzl_z(i,j,k,ispec_CPML) &
- + PML_duy_dzl_new(i,j,k) * coef1_1 + PML_duy_dzl(i,j,k) * coef2_1
-
- rmemory_duy_dyl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dyl_z(i,j,k,ispec_CPML) &
- + PML_duy_dyl_new(i,j,k) * coef1_1 + PML_duy_dyl(i,j,k) * coef2_1
-
- !---------------------- A17 and A18 --------------------------
- A17 = 1.0d0
- A18 = 0.d0
-
- rmemory_duz_dzl_x(i,j,k,ispec_CPML) = 0.d0
- rmemory_duz_dxl_x(i,j,k,ispec_CPML) = 0.d0
- rmemory_dux_dzl_z(i,j,k,ispec_CPML) = 0.d0
- rmemory_dux_dxl_z(i,j,k,ispec_CPML) = 0.d0
-
- !---------------------- A19 and A20 --------------------------
- A19 = k_store_z(i,j,k,ispec_CPML)
- A20 = d_store_z(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_duy_dyl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dyl_x(i,j,k,ispec_CPML) &
- + PML_duy_dyl_new(i,j,k) * coef1_1 + PML_duy_dyl(i,j,k) * coef2_1
-
- rmemory_duy_dxl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dxl_x(i,j,k,ispec_CPML) &
- + PML_duy_dxl_new(i,j,k) * coef1_1 + PML_duy_dxl(i,j,k) * coef2_1
-
- rmemory_dux_dyl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dyl_y(i,j,k,ispec_CPML) &
- + PML_dux_dyl_new(i,j,k) * coef1_1 + PML_dux_dyl(i,j,k) * coef2_1
-
- rmemory_dux_dxl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dxl_y(i,j,k,ispec_CPML) &
- + PML_dux_dxl_new(i,j,k) * coef1_1 + PML_dux_dxl(i,j,k) * coef2_1
-
- else if( CPML_regions(ispec_CPML) == CPML_YZ_ONLY ) then
-
- !------------------------------------------------------------------------------
- !---------------------------- YZ-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
-
- !---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A7 = d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- + it*deltat * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A8 = - d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) &
- + PML_dux_dxl_new(i,j,k) * coef1_1 + PML_dux_dxl(i,j,k) * coef2_1
- rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dxl_new(i,j,k) * it*deltat * coef1_2 + PML_dux_dxl(i,j,k) * it*deltat * coef2_2
-
- rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) &
- + PML_duy_dxl_new(i,j,k) * coef1_1 + PML_duy_dxl(i,j,k) * coef2_1
- rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dxl_new(i,j,k) * it*deltat * coef1_2 + PML_duy_dxl(i,j,k) * it*deltat * coef2_2
-
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) &
- + PML_duz_dxl_new(i,j,k) * coef1_1 + PML_duz_dxl(i,j,k) * coef2_1
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dxl_new(i,j,k) * it*deltat * coef1_2 + PML_duz_dxl(i,j,k) * it*deltat * coef2_2
-
- !---------------------- A9, A10 and A11 --------------------------
- A9 = k_store_z(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML)
- A10 = 0.d0
- A11 = ( d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) -&
- d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) ) / k_store_y(i,j,k,ispec_CPML)**2
-
- bb = d_store_y(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) / bb
- coef2_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dyl_new(i,j,k) * coef1_2 + PML_dux_dyl(i,j,k) * coef2_2
-
- rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dyl_new(i,j,k) * coef1_2 + PML_duy_dyl(i,j,k) * coef2_2
-
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dyl_new(i,j,k) * coef1_2 + PML_duz_dyl(i,j,k) * coef2_2
-
- !---------------------- A12, A13 and A14 --------------------------
- A12 = k_store_y(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML)
- A13 = 0.d0
- A14 = ( d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) -&
- d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) ) / k_store_z(i,j,k,ispec_CPML)**2
-
- bb = d_store_z(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) / bb
- coef2_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) = 0.d0
+ + PML_duz_dzl(i,j,k) * coef1_2 + PML_duz_dzl_old(i,j,k) * coef2_2
+ elseif(singularity_type_2 == 1) then
rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dzl_new(i,j,k) * coef1_2 + PML_dux_dzl(i,j,k) * coef2_2
-
- rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) = 0.d0
+ + PML_dux_dzl(i,j,k) * time_nplus1 * coef1_2 + PML_dux_dzl_old(i,j,k) * time_n * coef2_2
rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dzl_new(i,j,k) * coef1_2 + PML_duy_dzl(i,j,k) * coef2_2
-
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
+ + PML_duy_dzl(i,j,k) * time_nplus1 * coef1_2 + PML_duy_dzl_old(i,j,k) * time_n * coef2_2
rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dzl_new(i,j,k) * coef1_2 + PML_duz_dzl(i,j,k) * coef2_2
+ + PML_duz_dzl(i,j,k) * time_nplus1 * coef1_2 + PML_duz_dzl_old(i,j,k) * time_n * coef2_2
+ else
+ stop 'error in singularity_type_2 computation in elastic part'
+ endif
- !---------------------- A15 and A16 --------------------------
- A15 = 1.0d0
- A16 = 0.0d0
+ if(singularity_type_3 == 0) then
+ rmemory_dux_dzl_x(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,3) &
+ + PML_dux_dzl(i,j,k) * coef1_3 + PML_dux_dzl_old(i,j,k) * coef2_3
+ rmemory_duy_dzl_y(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,3) &
+ + PML_duy_dzl(i,j,k) * coef1_3 + PML_duy_dzl_old(i,j,k) * coef2_3
+ rmemory_duz_dzl_z(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,3) &
+ + PML_duz_dzl(i,j,k) * coef1_3 + PML_duz_dzl_old(i,j,k) * coef2_3
+ elseif(singularity_type_3 == 1) then
+ rmemory_dux_dzl_x(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,3) &
+ + PML_dux_dzl(i,j,k) * time_nplus1 * coef1_3 + PML_dux_dzl_old(i,j,k) * time_n * coef2_3
+ rmemory_duy_dzl_y(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,3) &
+ + PML_duy_dzl(i,j,k) * time_nplus1 * coef1_3 + PML_duy_dzl_old(i,j,k) * time_n * coef2_3
+ rmemory_duz_dzl_z(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,3) &
+ + PML_duz_dzl(i,j,k) * time_nplus1 * coef1_3 + PML_duz_dzl_old(i,j,k) * time_n * coef2_3
+ elseif(singularity_type_3 == 2) then
+ rmemory_dux_dzl_x(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,3) &
+ + PML_dux_dzl(i,j,k) * time_nplus1**2 * coef1_3 + PML_dux_dzl_old(i,j,k) * time_n**2 * coef2_3
+ rmemory_duy_dzl_y(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,3) &
+ + PML_duy_dzl(i,j,k) * time_nplus1**2 * coef1_3 + PML_duy_dzl_old(i,j,k) * time_n**2 * coef2_3
+ rmemory_duz_dzl_z(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,3) &
+ + PML_duz_dzl(i,j,k) * time_nplus1**2 * coef1_3 + PML_duz_dzl_old(i,j,k) * time_n**2 * coef2_3
+ else
+ stop 'error in singularity_type_3 computation in elastic part'
+ endif
- rmemory_duz_dzl_y(i,j,k,ispec_CPML) = 0.d0
+ !---------------------- A18 and A19 --------------------------
+ call lx_parameter_computation(deltat,kappa_x,beta_x,alpha_x,&
+ CPML_region_local,A18,A19,&
+ coef0_1,coef1_1,coef2_1)
+ rmemory_duz_dzl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dzl_y(i,j,k,ispec_CPML) &
+ + PML_duz_dzl(i,j,k) * coef1_1 + PML_duz_dzl_old(i,j,k) * coef2_1
- rmemory_duz_dyl_y(i,j,k,ispec_CPML) = 0.d0
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dyl_y(i,j,k,ispec_CPML) &
+ + PML_duz_dyl(i,j,k) * coef1_1 + PML_duz_dyl_old(i,j,k) * coef2_1
- rmemory_duy_dzl_z(i,j,k,ispec_CPML) = 0.d0
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dzl_z(i,j,k,ispec_CPML) &
+ + PML_duy_dzl(i,j,k) * coef1_1 + PML_duy_dzl_old(i,j,k) * coef2_1
- rmemory_duy_dyl_z(i,j,k,ispec_CPML) = 0.d0
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dyl_z(i,j,k,ispec_CPML) &
+ + PML_duy_dyl(i,j,k) * coef1_1 + PML_duy_dyl_old(i,j,k) * coef2_1
- !---------------------- A17 and A18 --------------------------
- A17 = k_store_y(i,j,k,ispec_CPML)
- A18 = d_store_y(i,j,k,ispec_CPML)
+ !---------------------- A20 and A21 --------------------------
+ call ly_parameter_computation(deltat,kappa_y,beta_y,alpha_y, &
+ CPML_region_local,A20,A21,&
+ coef0_1,coef1_1,coef2_1)
+ rmemory_duz_dzl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dzl_x(i,j,k,ispec_CPML) &
+ + PML_duz_dzl(i,j,k) * coef1_1 + PML_duz_dzl_old(i,j,k) * coef2_1
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dxl_x(i,j,k,ispec_CPML) &
+ + PML_duz_dxl(i,j,k) * coef1_1 + PML_duz_dxl_old(i,j,k) * coef2_1
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dzl_z(i,j,k,ispec_CPML) &
+ + PML_dux_dzl(i,j,k) * coef1_1 + PML_dux_dzl_old(i,j,k) * coef2_1
- rmemory_duz_dzl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dzl_x(i,j,k,ispec_CPML) &
- + PML_duz_dzl_new(i,j,k) * coef1_1 + PML_duz_dzl(i,j,k) * coef2_1
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dxl_z(i,j,k,ispec_CPML) &
+ + PML_dux_dxl(i,j,k) * coef1_1 + PML_dux_dxl_old(i,j,k) * coef2_1
- rmemory_duz_dxl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dxl_x(i,j,k,ispec_CPML) &
- + PML_duz_dxl_new(i,j,k) * coef1_1 + PML_duz_dxl(i,j,k) * coef2_1
+ !---------------------- A22 and A23 --------------------------
+ call lz_parameter_computation(deltat,kappa_z,beta_z,alpha_z, &
+ CPML_region_local,A22,A23,&
+ coef0_1,coef1_1,coef2_1)
+ rmemory_duy_dyl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dyl_x(i,j,k,ispec_CPML) &
+ + PML_duy_dyl(i,j,k) * coef1_1 + PML_duy_dyl_old(i,j,k) * coef2_1
- rmemory_dux_dzl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dzl_z(i,j,k,ispec_CPML) &
- + PML_dux_dzl_new(i,j,k) * coef1_1 + PML_dux_dzl(i,j,k) * coef2_1
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dxl_x(i,j,k,ispec_CPML) &
+ + PML_duy_dxl(i,j,k) * coef1_1 + PML_duy_dxl_old(i,j,k) * coef2_1
- rmemory_dux_dxl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dxl_z(i,j,k,ispec_CPML) &
- + PML_dux_dxl_new(i,j,k) * coef1_1 + PML_dux_dxl(i,j,k) * coef2_1
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dyl_y(i,j,k,ispec_CPML) &
+ + PML_dux_dyl(i,j,k) * coef1_1 + PML_dux_dyl_old(i,j,k) * coef2_1
- !---------------------- A19 and A20--------------------------
- A19 = k_store_z(i,j,k,ispec_CPML)
- A20 = d_store_z(i,j,k,ispec_CPML)
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dxl_y(i,j,k,ispec_CPML) &
+ + PML_dux_dxl(i,j,k) * coef1_1 + PML_dux_dxl_old(i,j,k) * coef2_1
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ duxdxl_x = A6 * PML_dux_dxl(i,j,k) + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) &
+ + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) + A9 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,3)
+ duxdyl_x = A10 * PML_dux_dyl(i,j,k) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) &
+ + A12 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) + A13 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,3)
+ duxdzl_x = A14 * PML_dux_dzl(i,j,k) + A15 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) &
+ + A16 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) + A17 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,3)
+ duzdzl_x = A20 * PML_duz_dzl(i,j,k) + A21 * rmemory_duz_dzl_x(i,j,k,ispec_CPML)
+ duzdxl_x = A20 * PML_duz_dxl(i,j,k) + A21 * rmemory_duz_dxl_x(i,j,k,ispec_CPML)
+ duydyl_x = A22 * PML_duy_dyl(i,j,k) + A23 * rmemory_duy_dyl_x(i,j,k,ispec_CPML)
+ duydxl_x = A22 * PML_duy_dxl(i,j,k) + A23 * rmemory_duy_dxl_x(i,j,k,ispec_CPML)
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ duydxl_y = A6 * PML_duy_dxl(i,j,k) + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) &
+ + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) + A9 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,3)
+ duydyl_y = A10 * PML_duy_dyl(i,j,k) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) &
+ + A12 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) + A13 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,3)
+ duydzl_y = A14 * PML_duy_dzl(i,j,k) + A15 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) &
+ + A16 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) + A17 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,3)
+ duzdzl_y = A18 * PML_duz_dzl(i,j,k) + A19 * rmemory_duz_dzl_y(i,j,k,ispec_CPML)
+ duzdyl_y = A18 * PML_duz_dyl(i,j,k) + A19 * rmemory_duz_dyl_y(i,j,k,ispec_CPML)
+ duxdyl_y = A22 * PML_dux_dyl(i,j,k) + A23 * rmemory_dux_dyl_y(i,j,k,ispec_CPML)
+ duxdxl_y = A22 * PML_dux_dxl(i,j,k) + A23 * rmemory_dux_dxl_y(i,j,k,ispec_CPML)
- rmemory_duy_dyl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dyl_x(i,j,k,ispec_CPML) &
- + PML_duy_dyl_new(i,j,k) * coef1_1 + PML_duy_dyl(i,j,k) * coef2_1
+ duzdxl_z = A6 * PML_duz_dxl(i,j,k) + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) &
+ + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) + A9 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,3)
+ duzdyl_z = A10 * PML_duz_dyl(i,j,k) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) &
+ + A12 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) + A13 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,3)
+ duzdzl_z = A14 * PML_duz_dzl(i,j,k) + A15 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) &
+ + A16 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) + A17 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,3)
+ duydzl_z = A18 * PML_duy_dzl(i,j,k) + A19 * rmemory_duy_dzl_z(i,j,k,ispec_CPML)
+ duydyl_z = A18 * PML_duy_dyl(i,j,k) + A19 * rmemory_duy_dyl_z(i,j,k,ispec_CPML)
+ duxdzl_z = A20 * PML_dux_dzl(i,j,k) + A21 * rmemory_dux_dzl_z(i,j,k,ispec_CPML)
+ duxdxl_z = A20 * PML_dux_dxl(i,j,k) + A21 * rmemory_dux_dxl_z(i,j,k,ispec_CPML)
- rmemory_duy_dxl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dxl_x(i,j,k,ispec_CPML) &
- + PML_duy_dxl_new(i,j,k) * coef1_1 + PML_duy_dxl(i,j,k) * coef2_1
-
- rmemory_dux_dyl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dyl_y(i,j,k,ispec_CPML) &
- + PML_dux_dyl_new(i,j,k) * coef1_1 + PML_dux_dyl(i,j,k) * coef2_1
-
- rmemory_dux_dxl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dxl_y(i,j,k,ispec_CPML) &
- + PML_dux_dxl_new(i,j,k) * coef1_1 + PML_dux_dxl(i,j,k) * coef2_1
-
- else if( CPML_regions(ispec_CPML) == CPML_XYZ ) then
-
- !------------------------------------------------------------------------------
- !---------------------------- XYZ-corner C-PML --------------------------------
- !------------------------------------------------------------------------------
-
- !---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML)
- if( abs(d_store_x(i,j,k,ispec_CPML)) > 1.d-5 ) then
- A7 = d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)/d_store_x(i,j,k,ispec_CPML)
- A8 = ( d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) - &
- d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) ) * &
- ( d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) - &
- d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) / &
- ( d_store_x(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML)**2)
- else
- A7 = ( d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) + &
- d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) ) / &
- k_store_x(i,j,k,ispec_CPML) + &
- it*deltat * d_store_y(i,j,k,ispec_CPML)*d_store_z(i,j,k,ispec_CPML)/k_store_x(i,j,k,ispec_CPML)
- A8 = - d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML)
- endif
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- bb = d_store_x(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_2 = (1.d0 - exp(-bb* deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) &
- + PML_dux_dxl_new(i,j,k) * coef1_1 + PML_dux_dxl(i,j,k) * coef2_1
- rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) &
- + PML_duy_dxl_new(i,j,k) * coef1_1 + PML_duy_dxl(i,j,k) * coef2_1
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) &
- + PML_duz_dxl_new(i,j,k) * coef1_1 + PML_duz_dxl(i,j,k) * coef2_1
-
- if( abs(d_store_x(i,j,k,ispec_CPML)) > 1.d-5 ) then
- rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dxl_new(i,j,k) * coef1_2 + PML_dux_dxl(i,j,k) * coef2_2
- rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dxl_new(i,j,k) * coef1_2 + PML_duy_dxl(i,j,k) * coef2_2
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dxl_new(i,j,k) * coef1_2 + PML_duz_dxl(i,j,k) * coef2_2
- else
- rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dxl_new(i,j,k) * it*deltat * coef1_2 + PML_dux_dxl(i,j,k) * it*deltat * coef2_2
- rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dxl_new(i,j,k) * it*deltat * coef1_2 + PML_duy_dxl(i,j,k) * it*deltat * coef2_2
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dxl_new(i,j,k) * it*deltat * coef1_2 + PML_duz_dxl(i,j,k) * it*deltat * coef2_2
- endif
-
- !---------------------- A9, A10 and A11 --------------------------
- A9 = k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML)
- if( abs(d_store_y(i,j,k,ispec_CPML)) > 1.d-5 ) then
- A10 = d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)/d_store_y(i,j,k,ispec_CPML)
- A11 = ( d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- - d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) * &
- ( d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- - d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) ) / &
- ( d_store_y(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)**2)
- else
- A10 = ( d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) ) / &
- k_store_y(i,j,k,ispec_CPML) + &
- it*deltat * d_store_x(i,j,k,ispec_CPML)*d_store_z(i,j,k,ispec_CPML)/k_store_y(i,j,k,ispec_CPML)
- A11 = - d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML)
- endif
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- bb = d_store_y(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_2 = (1.d0 - exp(-bb* deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) &
- + PML_dux_dyl_new(i,j,k) * coef1_1 + PML_dux_dyl(i,j,k) * coef2_1
- rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) &
- + PML_duy_dyl_new(i,j,k) * coef1_1 + PML_duy_dyl(i,j,k) * coef2_1
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) &
- + PML_duz_dyl_new(i,j,k) * coef1_1 + PML_duz_dyl(i,j,k) * coef2_1
-
- if( abs(d_store_y(i,j,k,ispec_CPML)) > 1.d-5 ) then
- rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dyl_new(i,j,k) * coef1_2 + PML_dux_dyl(i,j,k) * coef2_2
- rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dyl_new(i,j,k) * coef1_2 + PML_duy_dyl(i,j,k) * coef2_2
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dyl_new(i,j,k) * coef1_2 + PML_duz_dyl(i,j,k) * coef2_2
- else
- rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dyl_new(i,j,k) * it*deltat * coef1_2 + PML_dux_dyl(i,j,k) * it*deltat * coef2_2
- rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dyl_new(i,j,k) * it*deltat * coef1_2 + PML_duy_dyl(i,j,k) * it*deltat * coef2_2
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dyl_new(i,j,k) * it*deltat * coef1_2 + PML_duz_dyl(i,j,k) * it*deltat * coef2_2
- endif
-
- !---------------------- A12, A13 and A14 --------------------------
- A12 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML)
- if( abs(d_store_z(i,j,k,ispec_CPML)) > 1.d-5 ) then
- A13 = d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)/d_store_z(i,j,k,ispec_CPML)
- A14 = ( d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- - d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) * &
- ( d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- - d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) ) / &
- ( d_store_z(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)**2)
- else
- A13 = ( d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + d_store_x(i,j,k,ispec_CPML)*k_store_y(i,j,k,ispec_CPML) ) / &
- k_store_z(i,j,k,ispec_CPML) + &
- it*deltat * d_store_x(i,j,k,ispec_CPML)*d_store_y(i,j,k,ispec_CPML)/k_store_z(i,j,k,ispec_CPML)
- A14 = - d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML)
- endif
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- bb = d_store_z(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
-
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_2 = (1.d0 - exp(-bb* deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) &
- + PML_dux_dzl_new(i,j,k) * coef1_1 + PML_dux_dzl(i,j,k) * coef2_1
- rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) &
- + PML_duy_dzl_new(i,j,k) * coef1_1 + PML_duy_dzl(i,j,k) * coef2_1
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) &
- + PML_duz_dzl_new(i,j,k) * coef1_1 + PML_duz_dzl(i,j,k) * coef2_1
-
- if( abs(d_store_z(i,j,k,ispec_CPML)) > 1.d-5 ) then
- rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dzl_new(i,j,k) * coef1_2 + PML_dux_dzl(i,j,k) * coef2_2
- rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dzl_new(i,j,k) * coef1_2 + PML_duy_dzl(i,j,k) * coef2_2
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dzl_new(i,j,k) * coef1_2 + PML_duz_dzl(i,j,k) * coef2_2
- else
- rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) &
- + PML_dux_dzl_new(i,j,k) * it*deltat * coef1_2 + PML_dux_dzl(i,j,k) * it*deltat * coef2_2
- rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2) &
- + PML_duy_dzl_new(i,j,k) * it*deltat * coef1_2 + PML_duy_dzl(i,j,k) * it*deltat * coef2_2
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) &
- + PML_duz_dzl_new(i,j,k) * it*deltat * coef1_2 + PML_duz_dzl(i,j,k) * it*deltat * coef2_2
- endif
-
- !---------------------- A15 and A16 --------------------------
- A15 = k_store_x(i,j,k,ispec_CPML)
- A16 = d_store_x(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_duz_dzl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dzl_y(i,j,k,ispec_CPML) &
- + PML_duz_dzl_new(i,j,k) * coef1_1 + PML_duz_dzl(i,j,k) * coef2_1
-
- rmemory_duz_dyl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dyl_y(i,j,k,ispec_CPML) &
- + PML_duz_dyl_new(i,j,k) * coef1_1 + PML_duz_dyl(i,j,k) * coef2_1
-
- rmemory_duy_dzl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dzl_z(i,j,k,ispec_CPML) &
- + PML_duy_dzl_new(i,j,k) * coef1_1 + PML_duy_dzl(i,j,k) * coef2_1
-
- rmemory_duy_dyl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dyl_z(i,j,k,ispec_CPML) &
- + PML_duy_dyl_new(i,j,k) * coef1_1 + PML_duy_dyl(i,j,k) * coef2_1
-
- !---------------------- A17 and A18 --------------------------
- A17 = k_store_y(i,j,k,ispec_CPML)
- A18 = d_store_y(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_duz_dzl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dzl_x(i,j,k,ispec_CPML) &
- + PML_duz_dzl_new(i,j,k) * coef1_1 + PML_duz_dzl(i,j,k) * coef2_1
-
- rmemory_duz_dxl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duz_dxl_x(i,j,k,ispec_CPML) &
- + PML_duz_dxl_new(i,j,k) * coef1_1 + PML_duz_dxl(i,j,k) * coef2_1
-
- rmemory_dux_dzl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dzl_z(i,j,k,ispec_CPML) &
- + PML_dux_dzl_new(i,j,k) * coef1_1 + PML_dux_dzl(i,j,k) * coef2_1
-
- rmemory_dux_dxl_z(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dxl_z(i,j,k,ispec_CPML) &
- + PML_dux_dxl_new(i,j,k) * coef1_1 + PML_dux_dxl(i,j,k) * coef2_1
-
- !---------------------- A19 and A20 --------------------------
- A19 = k_store_z(i,j,k,ispec_CPML)
- A20 = d_store_z(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0))/ bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_duy_dyl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dyl_x(i,j,k,ispec_CPML) &
- + PML_duy_dyl_new(i,j,k) * coef1_1 + PML_duy_dyl(i,j,k) * coef2_1
-
- rmemory_duy_dxl_x(i,j,k,ispec_CPML) = coef0_1 * rmemory_duy_dxl_x(i,j,k,ispec_CPML) &
- + PML_duy_dxl_new(i,j,k) * coef1_1 + PML_duy_dxl(i,j,k) * coef2_1
-
- rmemory_dux_dyl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dyl_y(i,j,k,ispec_CPML) &
- + PML_dux_dyl_new(i,j,k) * coef1_1 + PML_dux_dyl(i,j,k) * coef2_1
-
- rmemory_dux_dxl_y(i,j,k,ispec_CPML) = coef0_1 * rmemory_dux_dxl_y(i,j,k,ispec_CPML) &
- + PML_dux_dxl_new(i,j,k) * coef1_1 + PML_dux_dxl(i,j,k) * coef2_1
-
- else
- stop 'wrong PML flag in PML memory variable calculation routine'
- endif
-
- duxdxl_x = A6 * PML_dux_dxl(i,j,k) &
- + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
- duxdyl_x = A9 * PML_dux_dyl(i,j,k) &
- + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
- duxdzl_x = A12 * PML_dux_dzl(i,j,k) &
- + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
- duzdzl_x = A17 * PML_duz_dzl(i,j,k) + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML)
- duzdxl_x = A17 * PML_duz_dxl(i,j,k) + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML)
- duydyl_x = A19 * PML_duy_dyl(i,j,k) + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML)
- duydxl_x = A19 * PML_duy_dxl(i,j,k) + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML)
-
- duydxl_y = A6 * PML_duy_dxl(i,j,k) &
- + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
- duydyl_y = A9 * PML_duy_dyl(i,j,k) &
- + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
- duydzl_y = A12 * PML_duy_dzl(i,j,k) &
- + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
- duzdzl_y = A15 * PML_duz_dzl(i,j,k) + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML)
- duzdyl_y = A15 * PML_duz_dyl(i,j,k) + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML)
- duxdyl_y = A19 * PML_dux_dyl(i,j,k) + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML)
- duxdxl_y = A19 * PML_dux_dxl(i,j,k) + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML)
-
- duzdxl_z = A6 * PML_duz_dxl(i,j,k) &
- + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
- duzdyl_z = A9 * PML_duz_dyl(i,j,k) &
- + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
- duzdzl_z = A12 * PML_duz_dzl(i,j,k) &
- + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
- duydzl_z = A15 * PML_duy_dzl(i,j,k) + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML)
- duydyl_z = A15 * PML_duy_dyl(i,j,k) + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML)
- duxdzl_z = A17 * PML_dux_dzl(i,j,k) + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML)
- duxdxl_z = A17 * PML_dux_dxl(i,j,k) + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML)
-
! compute stress sigma
sigma_xx = lambdalplus2mul*duxdxl_x + lambdal*duydyl_x + lambdal*duzdzl_x
sigma_yx = mul*duxdyl_x + mul*duydxl_x
@@ -1345,8 +411,6 @@
!
!=====================================================================
!
-!
-
subroutine pml_compute_memory_variables_acoustic(ispec,ispec_CPML,temp1,temp2,temp3,&
rmemory_dpotential_dxl,rmemory_dpotential_dyl,rmemory_dpotential_dzl)
! calculates C-PML elastic memory variables and computes stress sigma
@@ -1360,17 +424,19 @@
xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz,jacobian,&
it,deltat,rhostore
use pml_par, only: NSPEC_CPML,CPML_regions,k_store_x,k_store_y,k_store_z,&
- d_store_x,d_store_y,d_store_z,alpha_store,&
+ d_store_x,d_store_y,d_store_z,&
+ alpha_store_x,alpha_store_y,alpha_store_z,&
PML_dpotential_dxl,PML_dpotential_dyl,PML_dpotential_dzl,&
- PML_dpotential_dxl_new,PML_dpotential_dyl_new,PML_dpotential_dzl_new
- use constants, only: CUSTOM_REAL,NGLLX,NGLLY,NGLLZ,FOUR_THIRDS, &
+ PML_dpotential_dxl_old,PML_dpotential_dyl_old,PML_dpotential_dzl_old,&
+ potential_acoustic_old
+ use constants, only: CUSTOM_REAL,NGLLX,NGLLY,NGLLZ,FOUR_THIRDS,USE_DEVILLE_PRODUCTS, &
CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY,CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY,CPML_XYZ
implicit none
integer, intent(in) :: ispec,ispec_CPML
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ), intent(out) :: temp1,temp2,temp3
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,2) :: &
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3) :: &
rmemory_dpotential_dxl, rmemory_dpotential_dyl, rmemory_dpotential_dzl
! local parameters
@@ -1378,9 +444,18 @@
real(kind=CUSTOM_REAL) :: xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl,jacobianl
real(kind=CUSTOM_REAL) :: rho_invl_jacob,rhoin_jacob_jk,rhoin_jacob_ik,rhoin_jacob_ij
real(kind=CUSTOM_REAL) :: dpotentialdxl,dpotentialdyl,dpotentialdzl
- real(kind=CUSTOM_REAL) :: bb,coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2
- real(kind=CUSTOM_REAL) :: A6,A7,A8,A9,A10,A11,A12,A13,A14
+ real(kind=CUSTOM_REAL) :: time_nplus1,time_n
+ real(kind=CUSTOM_REAL) :: A6,A7,A8,A9 ! L231
+ real(kind=CUSTOM_REAL) :: A10,A11,A12,A13 ! L132
+ real(kind=CUSTOM_REAL) :: A14,A15,A16,A17 ! L123
+ real(kind=CUSTOM_REAL) :: coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,coef0_3,coef1_3,coef2_3
+ integer :: CPML_region_local
+ integer :: singularity_type_2,singularity_type_3
+ real(kind=CUSTOM_REAL) :: kappa_x,kappa_y,kappa_z,d_x,d_y,d_z,alpha_x,alpha_y,alpha_z,&
+ beta_x,beta_y,beta_z
+ CPML_region_local = CPML_regions(ispec_CPML)
+
do k=1,NGLLZ
do j=1,NGLLY
do i=1,NGLLX
@@ -1395,604 +470,153 @@
gammazl = gammaz(i,j,k,ispec)
jacobianl = jacobian(i,j,k,ispec)
rho_invl_jacob = 1.0_CUSTOM_REAL / rhostore(i,j,k,ispec) * jacobianl
- rhoin_jacob_jk = rho_invl_jacob * wgllwgll_yz(j,k)
- rhoin_jacob_ik = rho_invl_jacob * wgllwgll_xz(i,k)
- rhoin_jacob_ij = rho_invl_jacob * wgllwgll_xy(i,j)
+ if(USE_DEVILLE_PRODUCTS) then
+ rhoin_jacob_jk = rho_invl_jacob
+ rhoin_jacob_ik = rho_invl_jacob
+ rhoin_jacob_ij = rho_invl_jacob
+ else
+ rhoin_jacob_jk = rho_invl_jacob * wgllwgll_yz(j,k)
+ rhoin_jacob_ik = rho_invl_jacob * wgllwgll_xz(i,k)
+ rhoin_jacob_ij = rho_invl_jacob * wgllwgll_xy(i,j)
+ endif
- if( CPML_regions(ispec_CPML) == CPML_X_ONLY ) then
+ kappa_x = k_store_x(i,j,k,ispec_CPML)
+ kappa_y = k_store_y(i,j,k,ispec_CPML)
+ kappa_z = k_store_z(i,j,k,ispec_CPML)
+ d_x = d_store_x(i,j,k,ispec_CPML)
+ d_y = d_store_y(i,j,k,ispec_CPML)
+ d_z = d_store_z(i,j,k,ispec_CPML)
+ alpha_x = alpha_store_x(i,j,k,ispec_CPML)
+ alpha_y = alpha_store_y(i,j,k,ispec_CPML)
+ alpha_z = alpha_store_z(i,j,k,ispec_CPML)
+ beta_x = alpha_x + d_x / kappa_x
+ beta_y = alpha_y + d_y / kappa_y
+ beta_z = alpha_z + d_z / kappa_z
+ time_nplus1 = (it-1) * deltat
+ time_n = (it-2) * deltat
- !------------------------------------------------------------------------------
- !---------------------------- X-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
+ !---------------------- A6, A7, A8, A9 --------------------------
+ call lijk_parameter_computation(time_nplus1,deltat,&
+ kappa_z,beta_z,alpha_z,kappa_y,beta_y,alpha_y,kappa_x,beta_x,alpha_x,&
+ CPML_region_local,231,A6,A7,A8,A9,&
+ coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,&
+ coef0_3,coef1_3,coef2_3,singularity_type_2,singularity_type_3)
- !---------------------- A6, A7 and A8 --------------------------
- A6 = 1.d0 / k_store_x(i,j,k,ispec_CPML)
- A7 = 0.d0
- A8 = - d_store_x(i,j,k,ispec_CPML) / (k_store_x(i,j,k,ispec_CPML)**2)
- bb = d_store_x(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
+ rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + &
+ coef1_1 * PML_dpotential_dxl(i,j,k) + coef2_1 * PML_dpotential_dxl_old(i,j,k)
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_2 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
+ if(singularity_type_2 == 0)then
+ rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) + &
+ coef1_2 * PML_dpotential_dxl(i,j,k) + coef2_2 * PML_dpotential_dxl_old(i,j,k)
+ elseif(singularity_type_2 == 1)then
+ rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) + &
+ coef1_2 * time_nplus1 * PML_dpotential_dxl(i,j,k) + &
+ coef2_2 * time_n * PML_dpotential_dxl_old(i,j,k)
+ else
+ stop 'error in singularity_type_2 computation in acoustic part 231'
+ endif
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dxl_new(i,j,k) * coef1_2 + PML_dpotential_dxl(i,j,k) * coef2_2
+ if(singularity_type_3 == 0)then
+ rmemory_dpotential_dxl(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,3) + &
+ coef1_3 * PML_dpotential_dxl(i,j,k) + coef2_3 * PML_dpotential_dxl_old(i,j,k)
+ elseif(singularity_type_3 == 1)then
+ rmemory_dpotential_dxl(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,3) + &
+ coef1_3 * time_nplus1 * PML_dpotential_dxl(i,j,k) + &
+ coef2_3 * time_n * PML_dpotential_dxl_old(i,j,k)
+ elseif(singularity_type_3 == 2)then
+ rmemory_dpotential_dxl(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,3) + &
+ coef1_3 * time_nplus1**2 * PML_dpotential_dxl(i,j,k) + &
+ coef2_3 * time_n**2 * PML_dpotential_dxl_old(i,j,k)
+ else
+ stop 'error in singularity_type_3 computation in acoustic part 231'
+ endif
- !---------------------- A9, A10 and A11 --------------------------
- A9 = k_store_x(i,j,k,ispec_CPML)
- A10 = d_store_x(i,j,k,ispec_CPML)
- A11 = 0.d0
+ !---------------------- A10,A11,A12,A13 --------------------------
+ call lijk_parameter_computation(time_nplus1,deltat,&
+ kappa_x,beta_x,alpha_x,kappa_z,beta_z,alpha_z,kappa_y,beta_y,alpha_y,&
+ CPML_region_local,132,A10,A11,A12,A13,&
+ coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,&
+ coef0_3,coef1_3,coef2_3,singularity_type_2,singularity_type_3)
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + &
+ coef1_1 * PML_dpotential_dyl(i,j,k) + coef2_1 * PML_dpotential_dyl_old(i,j,k)
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ if(singularity_type_2 == 0)then
+ rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) + &
+ coef1_2 * PML_dpotential_dyl(i,j,k) + coef2_2 * PML_dpotential_dyl_old(i,j,k)
+ elseif(singularity_type_2 == 1)then
+ rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) + &
+ coef1_2 * time_nplus1 * PML_dpotential_dyl(i,j,k) + &
+ coef2_2 * time_n * PML_dpotential_dyl_old(i,j,k)
+ else
+ stop 'error in singularity_type_2 computation in acoustic part,132'
+ endif
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) &
- + PML_dpotential_dyl_new(i,j,k) * coef1_1 + PML_dpotential_dyl(i,j,k) * coef2_1
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = 0.d0
+ if(singularity_type_3 == 0)then
+ rmemory_dpotential_dyl(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,3) + &
+ coef1_3 * PML_dpotential_dyl(i,j,k) + coef2_3 * PML_dpotential_dyl_old(i,j,k)
+ elseif(singularity_type_3 == 1)then
+ rmemory_dpotential_dyl(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,3) + &
+ coef1_3 * time_nplus1 * PML_dpotential_dyl(i,j,k) + &
+ coef2_3 * time_n * PML_dpotential_dyl_old(i,j,k)
+ elseif(singularity_type_3 == 2)then
+ rmemory_dpotential_dyl(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,3) + &
+ coef1_3 * time_nplus1**2 * PML_dpotential_dyl(i,j,k) + &
+ coef2_3 * time_n**2 * PML_dpotential_dyl_old(i,j,k)
+ else
+ stop 'error in singularity_type_3 computation in acoustic part,132'
+ endif
- !---------------------- A12, A13 and A14 --------------------------
- A12 = k_store_x(i,j,k,ispec_CPML)
- A13 = d_store_x(i,j,k,ispec_CPML)
- A14 = 0.d0
+ !---------------------- A14,A15,A16,A17 --------------------------
+ call lijk_parameter_computation(time_nplus1,deltat,&
+ kappa_x,beta_x,alpha_x,kappa_y,beta_y,alpha_y,kappa_z,beta_z,alpha_z,&
+ CPML_region_local,123,A14,A15,A16,A17,&
+ coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,&
+ coef0_3,coef1_3,coef2_3,singularity_type_2,singularity_type_3)
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + &
+ coef1_1 * PML_dpotential_dzl(i,j,k) + coef2_1 * PML_dpotential_dzl_old(i,j,k)
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ if(singularity_type_2 == 0)then
+ rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) + &
+ coef1_2 * PML_dpotential_dzl(i,j,k) + coef2_2 * PML_dpotential_dzl_old(i,j,k)
+ elseif(singularity_type_2 == 1)then
+ rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) + &
+ coef1_2 * time_nplus1 * PML_dpotential_dzl(i,j,k) + &
+ coef2_2 * time_n * PML_dpotential_dzl_old(i,j,k)
+ else
+ stop 'error in singularity_type_2 computation in acoustic part,123'
+ endif
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) &
- + PML_dpotential_dzl_new(i,j,k) * coef1_1 + PML_dpotential_dzl(i,j,k) * coef2_1
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = 0.d0
-
- else if( CPML_regions(ispec_CPML) == CPML_Y_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- Y-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
-
- !---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_y(i,j,k,ispec_CPML)
- A7 = d_store_y(i,j,k,ispec_CPML)
- A8 = 0.d0
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) &
- + PML_dpotential_dxl_new(i,j,k) * coef1_1 + PML_dpotential_dxl(i,j,k) * coef2_1
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = 0.d0
-
- !---------------------- A9, A10 and A11 --------------------------
- A9 = 1.d0/k_store_y(i,j,k,ispec_CPML)
- A10 = 0.d0
- A11 = - d_store_y(i,j,k,ispec_CPML) / (k_store_y(i,j,k,ispec_CPML) ** 2)
-
- bb = d_store_y(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_2 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dyl_new(i,j,k) * coef1_2 + PML_dpotential_dyl(i,j,k) * coef2_2
-
- !---------------------- A12, A13 and A14 --------------------------
- A12 = k_store_y(i,j,k,ispec_CPML)
- A13 = d_store_y(i,j,k,ispec_CPML)
- A14 = 0.d0
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) &
- + PML_dpotential_dzl_new(i,j,k) * coef1_1 + PML_dpotential_dzl(i,j,k) * coef2_1
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = 0.d0
-
- else if( CPML_regions(ispec_CPML) == CPML_Z_ONLY ) then
-
- !------------------------------------------------------------------------------
- !---------------------------- Z-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
-
- !---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_z(i,j,k,ispec_CPML)
- A7 = d_store_z(i,j,k,ispec_CPML)
- A8 = 0.d0
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) &
- + PML_dpotential_dxl_new(i,j,k) * coef1_1 + PML_dpotential_dxl(i,j,k) * coef2_1
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = 0.d0
-
- !---------------------- A9, A10 and A11 --------------------------
- A9 = k_store_z(i,j,k,ispec_CPML)
- A10 = d_store_z(i,j,k,ispec_CPML)
- A11 = 0.d0
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) &
- + PML_dpotential_dyl_new(i,j,k) * coef1_1 + PML_dpotential_dyl(i,j,k) * coef2_1
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = 0.d0
-
- !---------------------- A12, A13 and A14 --------------------------
- A12 = 1.0 / k_store_z(i,j,k,ispec_CPML)
- A13 = 0.d0
- A14 = - d_store_z(i,j,k,ispec_CPML) / (k_store_z(i,j,k,ispec_CPML) ** 2)
-
- bb = d_store_z(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_2 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dzl_new(i,j,k) * coef1_2 + PML_dpotential_dzl(i,j,k) * coef2_2
-
- else if( CPML_regions(ispec_CPML) == CPML_XY_ONLY ) then
-
- !------------------------------------------------------------------------------
- !---------------------------- XY-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
-
- !---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_y(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML)
- A7 = 0.d0
- A8 = ( d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) - &
- d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) ) / k_store_x(i,j,k,ispec_CPML)**2
-
- bb = d_store_x(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) / bb
- coef2_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dxl_new(i,j,k) * coef1_2 + PML_dpotential_dxl(i,j,k) * coef2_2
-
- !---------------------- A9, A10 and A11 --------------------------
- A9 = k_store_x(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML)
- A10 = 0.d0
- A11 = ( d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) - &
- d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) / k_store_y(i,j,k,ispec_CPML)**2
-
- bb = d_store_y(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) / bb
- coef2_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dyl_new(i,j,k) * coef1_2 + PML_dpotential_dyl(i,j,k) * coef2_2
-
- !---------------------- A12, A13 and A14 --------------------------
- A12 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A13 = d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- + d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- A14 = - d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) &
- + PML_dpotential_dzl_new(i,j,k) * coef1_1 + PML_dpotential_dzl(i,j,k) * coef2_1
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dzl_new(i,j,k) * it*deltat * coef1_2 &
- + PML_dpotential_dzl(i,j,k) * it*deltat * coef2_2
-
- else if( CPML_regions(ispec_CPML) == CPML_XZ_ONLY ) then
-
- !------------------------------------------------------------------------------
- !---------------------------- XZ-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
-
- !---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_z(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML)
- A7 = 0.d0
- A8 = ( d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) - &
- d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) ) / k_store_x(i,j,k,ispec_CPML)**2
-
- bb = d_store_x(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) / bb
- coef2_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dxl_new(i,j,k) * coef1_2 + PML_dpotential_dxl(i,j,k) * coef2_2
-
- !---------------------- A9, A10 and A11 --------------------------
- A9 = k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A10 = d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A11 = - d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) &
- + PML_dpotential_dyl_new(i,j,k) * coef1_1 + PML_dpotential_dyl(i,j,k) * coef2_1
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dyl_new(i,j,k) * it*deltat * coef1_2 &
- + PML_dpotential_dyl(i,j,k) * it*deltat * coef2_2
-
- !---------------------- A12, A13 and A14 --------------------------
- A12 = k_store_x(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML)
- A13 = 0.d0
- A14 = ( d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- - d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) / k_store_z(i,j,k,ispec_CPML)**2
-
- bb = d_store_z(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) / bb
- coef2_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dzl_new(i,j,k) * coef1_2 + PML_dpotential_dzl(i,j,k) * coef2_2
-
- else if( CPML_regions(ispec_CPML) == CPML_YZ_ONLY ) then
-
- !------------------------------------------------------------------------------
- !---------------------------- YZ-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
-
- !---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A7 = d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- + it*deltat * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A8 = - d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) &
- + PML_dpotential_dxl_new(i,j,k) * coef1_1 + PML_dpotential_dxl(i,j,k) * coef2_1
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dxl_new(i,j,k) * it*deltat * coef1_2 &
- + PML_dpotential_dxl(i,j,k) * it*deltat * coef2_2
-
- !---------------------- A9, A10 and A11 --------------------------
- A9 = k_store_z(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML)
- A10 = 0.d0
- A11 = ( d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) -&
- d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) ) / k_store_y(i,j,k,ispec_CPML)**2
-
- bb = d_store_y(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) / bb
- coef2_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dyl_new(i,j,k) * coef1_2 + PML_dpotential_dyl(i,j,k) * coef2_2
-
- !---------------------- A12, A13 and A14 --------------------------
- A12 = k_store_y(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML)
- A13 = 0.d0
- A14 = ( d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) -&
- d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) ) / k_store_z(i,j,k,ispec_CPML)**2
-
- bb = d_store_z(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) / bb
- coef2_2 = ( 1.d0 - exp(-bb * deltat/2.d0) ) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dzl_new(i,j,k) * coef1_2 + PML_dpotential_dzl(i,j,k) * coef2_2
-
- else if( CPML_regions(ispec_CPML) == CPML_XYZ ) then
-
- !------------------------------------------------------------------------------
- !---------------------------- XYZ-corner C-PML --------------------------------
- !------------------------------------------------------------------------------
-
- !---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML)
- if( abs(d_store_x(i,j,k,ispec_CPML)) > 1.d-5 ) then
- A7 = d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)/d_store_x(i,j,k,ispec_CPML)
- A8 = ( d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) - &
- d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) ) * &
- ( d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) - &
- d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) / &
- ( d_store_x(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML)**2)
- else
- A7 = (d_store_z(i,j,k,ispec_CPML)*k_store_y(i,j,k,ispec_CPML)+ &
- d_store_y(i,j,k,ispec_CPML)*k_store_z(i,j,k,ispec_CPML)) / &
- k_store_x(i,j,k,ispec_CPML) + &
- it*deltat * d_store_y(i,j,k,ispec_CPML)*d_store_z(i,j,k,ispec_CPML)/k_store_x(i,j,k,ispec_CPML)
- A8 = - d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML)
- endif
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- bb = d_store_x(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_2 = (1.d0 - exp(-bb* deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) &
- + PML_dpotential_dxl_new(i,j,k) * coef1_1 + PML_dpotential_dxl(i,j,k) * coef2_1
-
- if(abs(d_store_x(i,j,k,ispec_CPML))> 1.d-5)then
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dxl_new(i,j,k) * coef1_2 + PML_dpotential_dxl(i,j,k) * coef2_2
- else
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dxl_new(i,j,k) * it*deltat * coef1_2 &
- + PML_dpotential_dxl(i,j,k) * it*deltat * coef2_2
- endif
-
- !---------------------- A9, A10 and A11 --------------------------
- A9 = k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML)
- if( abs(d_store_y(i,j,k,ispec_CPML)) > 1.d-5 ) then
- A10 = d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)/d_store_y(i,j,k,ispec_CPML)
- A11 = ( d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- - d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) * &
- ( d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- - d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) ) / &
- ( d_store_y(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)**2)
- else
- A10 = (d_store_z(i,j,k,ispec_CPML)*k_store_x(i,j,k,ispec_CPML) &
- +d_store_x(i,j,k,ispec_CPML)*k_store_z(i,j,k,ispec_CPML)) / &
- k_store_y(i,j,k,ispec_CPML) + &
- it*deltat * d_store_x(i,j,k,ispec_CPML)*d_store_z(i,j,k,ispec_CPML)/k_store_y(i,j,k,ispec_CPML)
- A11 = - d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML)
- endif
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- bb = d_store_y(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_2 = (1.d0 - exp(-bb* deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) &
- + PML_dpotential_dyl_new(i,j,k) * coef1_1 + PML_dpotential_dyl(i,j,k) * coef2_1
-
- if(abs(d_store_y(i,j,k,ispec_CPML))> 1.d-5)then
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dyl_new(i,j,k) * coef1_2 + PML_dpotential_dyl(i,j,k) * coef2_2
- else
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dyl_new(i,j,k) * it*deltat * coef1_2 &
- + PML_dpotential_dyl(i,j,k) * it*deltat * coef2_2
- endif
-
- !---------------------- A12, A13 and A14 --------------------------
- A12 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML)
- if( abs(d_store_z(i,j,k,ispec_CPML)) > 1.d-5 ) then
- A13 = d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)/d_store_z(i,j,k,ispec_CPML)
- A14 = ( d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- - d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) * &
- ( d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- - d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) ) / &
- ( d_store_z(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)**2)
- else
- A13 = (d_store_y(i,j,k,ispec_CPML)*k_store_x(i,j,k,ispec_CPML)&
- +d_store_x(i,j,k,ispec_CPML)*k_store_y(i,j,k,ispec_CPML)) / &
- k_store_z(i,j,k,ispec_CPML) + &
- it*deltat * d_store_x(i,j,k,ispec_CPML)*d_store_y(i,j,k,ispec_CPML)/k_store_z(i,j,k,ispec_CPML)
- A14 = - d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML)
- endif
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
-
- bb = d_store_z(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML) + alpha_store(i,j,k,ispec_CPML)
- coef0_2 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_2 = (1.d0 - exp(-bb* deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_2 = deltat/2.0d0
- coef2_2 = deltat/2.0d0
- endif
-
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) &
- + PML_dpotential_dzl_new(i,j,k) * coef1_1 + PML_dpotential_dzl(i,j,k) * coef2_1
-
- if(abs(d_store_z(i,j,k,ispec_CPML))> 1.d-5)then
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dzl_new(i,j,k) * coef1_2 + PML_dpotential_dzl(i,j,k) * coef2_2
- else
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) &
- + PML_dpotential_dzl_new(i,j,k) * it*deltat * coef1_2 &
- + PML_dpotential_dzl(i,j,k) * it*deltat * coef2_2
- endif
-
+ if(singularity_type_3 == 0)then
+ rmemory_dpotential_dzl(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,3) + &
+ coef1_3 * PML_dpotential_dzl(i,j,k) + coef2_3 * PML_dpotential_dzl_old(i,j,k)
+ elseif(singularity_type_3 == 1)then
+ rmemory_dpotential_dzl(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,3) + &
+ coef1_3 * time_nplus1 * PML_dpotential_dzl(i,j,k) + &
+ coef2_3 * time_n * PML_dpotential_dzl_old(i,j,k)
+ elseif(singularity_type_3 == 2)then
+ rmemory_dpotential_dzl(i,j,k,ispec_CPML,3) = coef0_3 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,3) + &
+ coef1_3 * time_nplus1**2 * PML_dpotential_dzl(i,j,k) + &
+ coef2_3 * time_n**2 * PML_dpotential_dzl_old(i,j,k)
else
- stop 'wrong PML flag in PML memory variable calculation routine'
+ stop 'error in singularity_type_3 computation,123'
endif
- dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k) &
- + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2)
- dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k) &
- + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2)
- dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k) &
- + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
+
+ dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k) + &
+ A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + &
+ A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) + &
+ A9 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,3)
+ dpotentialdyl = A10 * PML_dpotential_dyl(i,j,k) + &
+ A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + &
+ A12 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) + &
+ A13 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,3)
+ dpotentialdzl = A14 * PML_dpotential_dzl(i,j,k) + &
+ A15 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + &
+ A16 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) + &
+ A17 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,3)
temp1(i,j,k) = rhoin_jacob_jk * (xixl*dpotentialdxl + xiyl*dpotentialdyl + xizl*dpotentialdzl)
temp2(i,j,k) = rhoin_jacob_ik * (etaxl*dpotentialdxl + etayl*dpotentialdyl + etazl*dpotentialdzl)
temp3(i,j,k) = rhoin_jacob_ij * (gammaxl*dpotentialdxl + gammayl*dpotentialdyl + gammazl*dpotentialdzl)
@@ -2002,14 +626,11 @@
enddo
end subroutine pml_compute_memory_variables_acoustic
-
!
!=====================================================================
!
-!
-
subroutine pml_compute_memory_variables_acoustic_elastic(ispec_CPML,iface,iglob,i,j,k,&
- displ_x,displ_y,displ_z,displ,veloc,&
+ displ_x,displ_y,displ_z,displ,&
num_coupling_ac_el_faces,rmemory_coupling_ac_el_displ)
! calculates C-PML elastic memory variables and computes stress sigma
@@ -2019,7 +640,8 @@
! IEEE Transactions on Antennas and Propagation, vol. 54, no. 1, (2006)
use specfem_par, only: NGLOB_AB,it,deltat
- use pml_par,only : CPML_regions,k_store_x,k_store_y,k_store_z,d_store_x,d_store_y,d_store_z,alpha_store
+ use pml_par,only : CPML_regions,k_store_x,k_store_y,k_store_z,d_store_x,d_store_y,d_store_z,&
+ alpha_store_x,alpha_store_y,alpha_store_z,displ_old
use constants, only: CUSTOM_REAL,NDIM,NGLLX,NGLLY,NGLLZ,&
CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY,CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY,CPML_XYZ
@@ -2027,814 +649,1014 @@
integer, intent(in) :: ispec_CPML,iface,iglob,num_coupling_ac_el_faces
real(kind=CUSTOM_REAL) :: displ_x,displ_y,displ_z
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB), intent(in) :: displ,veloc
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB), intent(in) :: displ
real(kind=CUSTOM_REAL), dimension(3,NGLLX,NGLLY,NGLLZ,num_coupling_ac_el_faces,2) :: &
rmemory_coupling_ac_el_displ
! local parameters
- integer :: i,j,k
- real(kind=CUSTOM_REAL) :: bb,coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2
- real(kind=CUSTOM_REAL) :: A6,A7,A8,A9,A10,A11,A12,A13,A14
+ integer :: i,j,k,CPML_region_local,singularity_type_2
+ real(kind=CUSTOM_REAL) :: coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2
+ real(kind=CUSTOM_REAL) :: A_12,A_13,A_14,time_nplus1,time_n
+ real(kind=CUSTOM_REAL) :: kappa_x,kappa_y,kappa_z,d_x,d_y,d_z,alpha_x,alpha_y,alpha_z,&
+ beta_x,beta_y,beta_z
+ CPML_region_local = CPML_regions(ispec_CPML)
+ kappa_x = k_store_x(i,j,k,ispec_CPML)
+ kappa_y = k_store_y(i,j,k,ispec_CPML)
+ kappa_z = k_store_z(i,j,k,ispec_CPML)
+ d_x = d_store_x(i,j,k,ispec_CPML)
+ d_y = d_store_y(i,j,k,ispec_CPML)
+ d_z = d_store_z(i,j,k,ispec_CPML)
+ alpha_x = alpha_store_x(i,j,k,ispec_CPML)
+ alpha_y = alpha_store_y(i,j,k,ispec_CPML)
+ alpha_z = alpha_store_z(i,j,k,ispec_CPML)
+ beta_x = alpha_x + d_x / kappa_x
+ beta_y = alpha_y + d_y / kappa_y
+ beta_z = alpha_z + d_z / kappa_z
+ time_nplus1 = (it-1.0_CUSTOM_REAL) * deltat
+ time_n = (it-2.0_CUSTOM_REAL) * deltat
- if( CPML_regions(ispec_CPML) == CPML_X_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- X-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
+ call lxy_interface_parameter_computation(time_nplus1,deltat,kappa_x,beta_x,alpha_x,kappa_y,beta_y,alpha_y, &
+ CPML_region_local,12,A_12,A_13,A_14,&
+ coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,&
+ singularity_type_2)
+ ! displ_x
+ rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) + &
+ coef1_1 * displ(1,iglob) + coef2_1 * displ_old(1,iglob)
- ! displ_x
- A6 = 1.d0
- A7 = 0.d0
- A8 = 0.d0
+ if(singularity_type_2 == 0)then
+ rmemory_coupling_ac_el_displ(1,i,j,k,iface,2) = coef0_2 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,2) + &
+ coef1_2 * displ(1,iglob) + coef2_2 * displ_old(1,iglob)
+ else
+ rmemory_coupling_ac_el_displ(1,i,j,k,iface,2) = coef0_2 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,2) + &
+ coef1_2 * time_nplus1 * displ(1,iglob) + &
+ coef2_2 * time_n * displ_old(1,iglob)
+ endif
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) = 0.d0
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,2) = 0.d0
+ displ_x = A_12 * displ(1,iglob) + A_13 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) + &
+ A_14 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,2)
- displ_x = A6 * displ(1,iglob) + A7 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) &
- + A8 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,2)
+ ! displ_y
+ rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) + &
+ coef1_1 * displ(2,iglob) + coef2_1 * displ_old(2,iglob)
+ if(singularity_type_2 == 0)then
+ rmemory_coupling_ac_el_displ(2,i,j,k,iface,2) = coef0_2 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,2) + &
+ coef1_2 * displ(2,iglob) + coef2_2 * displ_old(2,iglob)
+ else
+ rmemory_coupling_ac_el_displ(2,i,j,k,iface,2) = coef0_2 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,2) + &
+ coef1_2 * time_nplus1 * displ(2,iglob) + &
+ coef2_2 * time_n * displ_old(2,iglob)
+ endif
- ! displ_y
- A9 = k_store_x(i,j,k,ispec_CPML)
- A10 = d_store_x(i,j,k,ispec_CPML)
- A11 = 0.d0
+ displ_y = A_12 * displ(2,iglob) + A_13 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) + &
+ A_14 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,2)
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ ! displ_z
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) + &
+ coef1_1 * displ(3,iglob) + coef2_1 * displ_old(3,iglob)
+ if(singularity_type_2 == 0)then
+ rmemory_coupling_ac_el_displ(3,i,j,k,iface,2) = coef0_2 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,2) + &
+ coef1_2 * displ(3,iglob) + coef2_2 * displ_old(3,iglob)
+ else
+ rmemory_coupling_ac_el_displ(3,i,j,k,iface,2) = coef0_2 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,2) + &
+ coef1_2 * time_nplus1 * displ(3,iglob) + &
+ coef2_2 * time_n * displ_old(3,iglob)
+ endif
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * coef1_1 + (displ(2,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,2) = 0.d0
+ displ_z = A_12 * displ(3,iglob) + A_13 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) + &
+ A_14 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,2)
- displ_y = A9 * displ(2,iglob) + A10 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) &
- + A11 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,2)
+end subroutine pml_compute_memory_variables_acoustic_elastic
+!
+!=====================================================================
+!
+subroutine pml_compute_memory_variables_elastic_acoustic(ispec_CPML,iface,iglob,i,j,k,&
+ pressure,potential_acoustic,potential_acoustic_old,&
+ num_coupling_ac_el_faces,rmemory_coupling_el_ac_potential)
+ ! calculates C-PML elastic memory variables and computes stress sigma
- ! displ_z
- A12 = k_store_x(i,j,k,ispec_CPML)
- A13 = d_store_x(i,j,k,ispec_CPML)
- A14 = 0.d0
+ ! second-order accurate convolution term calculation from equation (21) of
+ ! Shumin Wang, Robert Lee, and Fernando L. Teixeira,
+ ! Anisotropic-Medium PML for Vector FETD With Modified Basis Functions,
+ ! IEEE Transactions on Antennas and Propagation, vol. 54, no. 1, (2006)
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ use specfem_par, only: NGLOB_AB,it,deltat
+ use pml_par,only : CPML_regions,k_store_x,k_store_y,k_store_z,d_store_x,d_store_y,d_store_z,&
+ alpha_store_x,alpha_store_y,alpha_store_z
+ use constants, only: CUSTOM_REAL,NDIM,NGLLX,NGLLY,NGLLZ,&
+ CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY,CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY,CPML_XYZ
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ implicit none
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * coef1_1 + (displ(3,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,2) = 0.d0
+ integer, intent(in) :: ispec_CPML,iface,iglob,num_coupling_ac_el_faces
+ real(kind=CUSTOM_REAL) :: pressure
+ real(kind=CUSTOM_REAL), dimension(NGLOB_AB), intent(in) :: potential_acoustic,potential_acoustic_old
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,num_coupling_ac_el_faces,2) :: &
+ rmemory_coupling_el_ac_potential
- displ_z = A12 * displ(3,iglob) + A13 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) &
- + A14 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,2)
+ ! local parameters
+ integer :: i,j,k,CPML_region_local,singularity_type_2
+ real(kind=CUSTOM_REAL) :: coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2
+ real(kind=CUSTOM_REAL) :: A_12,A_13,A_14,time_nplus1,time_n
+ real(kind=CUSTOM_REAL) :: kappa_x,kappa_y,kappa_z,d_x,d_y,d_z,alpha_x,alpha_y,alpha_z,&
+ beta_x,beta_y,beta_z
+ CPML_region_local = CPML_regions(ispec_CPML)
+ kappa_x = k_store_x(i,j,k,ispec_CPML)
+ kappa_y = k_store_y(i,j,k,ispec_CPML)
+ kappa_z = k_store_z(i,j,k,ispec_CPML)
+ d_x = d_store_x(i,j,k,ispec_CPML)
+ d_y = d_store_y(i,j,k,ispec_CPML)
+ d_z = d_store_z(i,j,k,ispec_CPML)
+ alpha_x = alpha_store_x(i,j,k,ispec_CPML)
+ alpha_y = alpha_store_y(i,j,k,ispec_CPML)
+ alpha_z = alpha_store_z(i,j,k,ispec_CPML)
+ beta_x = alpha_x + d_x / kappa_x
+ beta_y = alpha_y + d_y / kappa_y
+ beta_z = alpha_z + d_z / kappa_z
+ time_nplus1 = (it-1.0_CUSTOM_REAL) * deltat
+ time_n = (it-2.0_CUSTOM_REAL) * deltat
- else if( CPML_regions(ispec_CPML) == CPML_Y_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- Y-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
+ call lxy_interface_parameter_computation(time_nplus1,deltat,kappa_x,beta_x,alpha_x,kappa_y,beta_y,alpha_y, &
+ CPML_region_local,12,A_12,A_13,A_14,&
+ coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,&
+ singularity_type_2)
- ! displ_x
- A6 = k_store_y(i,j,k,ispec_CPML)
- A7 = d_store_y(i,j,k,ispec_CPML)
- A8 = 0.0
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ rmemory_coupling_el_ac_potential(i,j,k,iface,1) = coef0_1 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) + &
+ coef1_1 * potential_acoustic(iglob) + coef2_1 * potential_acoustic_old(iglob)
+ if(singularity_type_2 == 0)then
+ rmemory_coupling_el_ac_potential(i,j,k,iface,2) = coef0_2 * rmemory_coupling_el_ac_potential(i,j,k,iface,2) + &
+ coef1_2 * potential_acoustic(iglob) + coef2_2 * potential_acoustic_old(iglob)
+ else
+ rmemory_coupling_el_ac_potential(i,j,k,iface,2) = coef0_2 * rmemory_coupling_el_ac_potential(i,j,k,iface,2) + &
+ coef1_2 * time_nplus1 * potential_acoustic(iglob) + &
+ coef2_2 * time_n * potential_acoustic_old(iglob)
+ endif
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ pressure = A_12 * potential_acoustic(iglob) + A_13 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) + &
+ A_14 * rmemory_coupling_el_ac_potential(i,j,k,iface,2)
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_1 + (displ(1,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,2) = 0.d0
- displ_x = A6 * displ(1,iglob) + A7 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) &
- + A8 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,2)
+end subroutine pml_compute_memory_variables_elastic_acoustic
+!
+!=====================================================================
+!
+subroutine lijk_parameter_computation(time,deltat,kappa_x,beta_x,alpha_x,kappa_y,beta_y,alpha_y,kappa_z,beta_z,alpha_z, &
+ CPML_region_local,index_ijk,A_0,A_1,A_2,A_3,&
+ coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,&
+ coef0_3,coef1_3,coef2_3,singularity_type_2,singularity_type_3)
- ! displ_y
- A9 = 1.d0
- A10 = 0.d0
- A11 = 0.d0
+ use constants, only: CUSTOM_REAL,CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY,&
+ CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY,CPML_XYZ
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) = 0.d0
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,2) = 0.d0
+ implicit none
- displ_y = A9 * displ(2,iglob) + A10 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) &
- + A11 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,2)
+ real(kind=CUSTOM_REAL), intent(in) :: time,deltat
+ real(kind=CUSTOM_REAL), intent(in) :: kappa_x,beta_x,alpha_x, &
+ kappa_y,beta_y,alpha_y, &
+ kappa_z,beta_z,alpha_z
+ integer, intent(in) :: CPML_region_local,index_ijk
- ! displ_z
- A12 = k_store_y(i,j,k,ispec_CPML)
- A13 = d_store_y(i,j,k,ispec_CPML)
- A14 = 0.0
+ real(kind=CUSTOM_REAL), intent(out) :: A_0,A_1,A_2,A_3
+ real(kind=CUSTOM_REAL), intent(out) :: coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,&
+ coef0_3,coef1_3,coef2_3
+ integer, intent(out) :: singularity_type_2,singularity_type_3
- bb = alpha_store(i,j,k,ispec_CPML)
+ !local variable
+ real(kind=CUSTOM_REAL) :: bar_A_0,bar_A_1,bar_A_2,bar_A_3,alpha_0,bb
- coef0_1 = exp(-bb * deltat)
+ integer :: CPML_X_ONLY_TEMP,CPML_Y_ONLY_TEMP,CPML_Z_ONLY_TEMP,&
+ CPML_XY_ONLY_TEMP,CPML_XZ_ONLY_TEMP,CPML_YZ_ONLY_TEMP,CPML_XYZ_TEMP
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ logical,parameter :: FIRST_ORDER_CONVOLUTION = .false.
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * coef1_1 + (displ(3,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,2) = 0.d0
+ if(index_ijk == 123)then
+ CPML_X_ONLY_TEMP = CPML_X_ONLY
+ CPML_Y_ONLY_TEMP = CPML_Y_ONLY
+ CPML_Z_ONLY_TEMP = CPML_Z_ONLY
+ CPML_XY_ONLY_TEMP = CPML_XY_ONLY
+ CPML_XZ_ONLY_TEMP = CPML_XZ_ONLY
+ CPML_YZ_ONLY_TEMP = CPML_YZ_ONLY
+ CPML_XYZ_TEMP = CPML_XYZ
+ elseif(index_ijk == 132)then
+ CPML_X_ONLY_TEMP = CPML_X_ONLY
+ CPML_Y_ONLY_TEMP = CPML_Z_ONLY
+ CPML_Z_ONLY_TEMP = CPML_Y_ONLY
+ CPML_XY_ONLY_TEMP = CPML_XZ_ONLY
+ CPML_XZ_ONLY_TEMP = CPML_XY_ONLY
+ CPML_YZ_ONLY_TEMP = CPML_YZ_ONLY
+ CPML_XYZ_TEMP = CPML_XYZ
+ elseif(index_ijk == 231)then
+ CPML_X_ONLY_TEMP = CPML_Z_ONLY
+ CPML_Y_ONLY_TEMP = CPML_Y_ONLY
+ CPML_Z_ONLY_TEMP = CPML_X_ONLY
+ CPML_XY_ONLY_TEMP = CPML_YZ_ONLY
+ CPML_XZ_ONLY_TEMP = CPML_XZ_ONLY
+ CPML_YZ_ONLY_TEMP = CPML_XY_ONLY
+ CPML_XYZ_TEMP = CPML_XYZ
+ else
+ stop 'In lijk_parameter_computation index_ijk must be equal to 123 or 132 or 231'
+ endif
- displ_z = A12 * displ(3,iglob) + A13 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) &
- + A14 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,2)
+ if(CPML_region_local == CPML_XYZ_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = kappa_x * kappa_y / kappa_z
+ A_0 = bar_A_0
+ if(abs(alpha_x-alpha_y) >= 1.e-5_CUSTOM_REAL .and. abs(alpha_x-beta_z) >= 1.e-5_CUSTOM_REAL &
+ .and. abs(alpha_y-beta_z) >= 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2,3-------------------------
+ bar_A_1 = - bar_A_0 * (alpha_x - alpha_z) * (alpha_x - beta_x) * (alpha_x - beta_y) / &
+ ((alpha_x-alpha_y) * (alpha_x-beta_z))
+ bar_A_2 = - bar_A_0 * (alpha_y - alpha_z) * (alpha_y - beta_x) * (alpha_y - beta_y) / &
+ ((alpha_y-alpha_x) * (alpha_y-beta_z))
+ bar_A_3 = - bar_A_0 * (beta_z - alpha_z) * (beta_z - beta_x) * (beta_z - beta_y) / &
+ ((beta_z-alpha_x) * (beta_z-alpha_y))
- else if( CPML_regions(ispec_CPML) == CPML_Z_ONLY ) then
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+ A_3 = bar_A_3
- !------------------------------------------------------------------------------
- !---------------------------- Z-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- ! displ_x
- A6 = k_store_z(i,j,k,ispec_CPML)
- A7 = d_store_z(i,j,k,ispec_CPML)
- A8 = 0.0
+ elseif(abs(alpha_x-alpha_y) < 1.e-5_CUSTOM_REAL .and. abs(alpha_x-beta_z) >= 1.e-5_CUSTOM_REAL &
+ .and. abs(alpha_y-beta_z) >= 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2,3-------------------------
+ alpha_0 = max(alpha_x,alpha_y)
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ bar_A_1 = bar_A_0 * (-2._CUSTOM_REAL * alpha_0**3 + beta_x*beta_y*beta_z &
+ -2._CUSTOM_REAL * alpha_0 * beta_z * (alpha_z + beta_x + beta_y) &
+ + alpha_0**2 * (alpha_z + beta_x + beta_y + 3._CUSTOM_REAL * beta_z) &
+ + alpha_z * (beta_y * beta_z + beta_x * (-beta_y + beta_z)) ) / &
+ ((alpha_0-beta_z) * (alpha_0-beta_z))
+ bar_A_2 = bar_A_0 * (alpha_0-alpha_z) * (alpha_0 - beta_x) * (alpha_0 - beta_y) / &
+ (alpha_0-beta_z)
+ bar_A_3 = - bar_A_0 * (beta_z - alpha_z) * (beta_z-beta_x) * (beta_z-beta_y) / &
+ ((beta_z-alpha_0) * (beta_z-alpha_0))
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ A_1 = bar_A_1 + time * bar_A_2
+ A_2 = - bar_A_2
+ A_3 = bar_A_3
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_1 + (displ(1,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,2) = 0.d0
+ singularity_type_2 = 1 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- displ_x = A6 * displ(1,iglob) + A7 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) &
- + A8 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,2)
+ elseif(abs(alpha_x-alpha_y) >= 1.e-5_CUSTOM_REAL .and. abs(alpha_x-beta_z) < 1.e-5_CUSTOM_REAL &
+ .and. abs(alpha_y-beta_z) >= 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2,3-------------------------
+ alpha_0 = max(alpha_x,beta_z)
- ! displ_y
- A9 = k_store_z(i,j,k,ispec_CPML)
- A10 = d_store_z(i,j,k,ispec_CPML)
- A11 = 0.0
+ bar_A_1 = bar_A_0 * (-2._CUSTOM_REAL * alpha_0 **3 - alpha_z*beta_x*beta_y &
+ -2._CUSTOM_REAL * alpha_0 * alpha_y * (alpha_z + beta_x + beta_y) &
+ + alpha_0**2 * (3._CUSTOM_REAL * alpha_y + alpha_z + beta_x + beta_y) &
+ + alpha_y * (alpha_z * (beta_x + beta_y) + beta_x * beta_y) ) / &
+ ((alpha_0-alpha_y) * (alpha_0-alpha_y))
+ bar_A_2 = - bar_A_0 * (alpha_y-alpha_z) * (alpha_y - beta_x) * (alpha_y - beta_y) / &
+ ((alpha_y-alpha_0) * (alpha_y-alpha_0))
+ bar_A_3 = bar_A_0 * (alpha_0 - alpha_z) * (alpha_0-beta_x) * (alpha_0-beta_y) / &
+ (alpha_0-alpha_y)
- bb = alpha_store(i,j,k,ispec_CPML)
+ A_1 = bar_A_1 + time * bar_A_3
+ A_2 = bar_A_2
+ A_3 = -bar_A_3
- coef0_1 = exp(-bb * deltat)
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 1 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ elseif(abs(alpha_x-alpha_y) >= 1.e-5_CUSTOM_REAL .and. abs(alpha_x-beta_z) >= 1.e-5_CUSTOM_REAL &
+ .and. abs(alpha_y-beta_z) < 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2,3-------------------------
+ alpha_0 = max(alpha_y,beta_z)
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * coef1_1 + (displ(2,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,2) = 0.d0
+ bar_A_1 = - bar_A_0 * (alpha_x-alpha_z) * (alpha_x - beta_x) * (alpha_x - beta_y) / &
+ ((alpha_x-alpha_0) * (alpha_x-alpha_0))
+ bar_A_2 = bar_A_0 * (-2._CUSTOM_REAL * alpha_0 **3 - alpha_z*beta_x*beta_y &
+ -2._CUSTOM_REAL * alpha_0 * alpha_x * (alpha_z + beta_x + beta_y) &
+ + alpha_0**2 * (3._CUSTOM_REAL * alpha_x + alpha_z + beta_x + beta_y) &
+ + alpha_x * (alpha_z * (beta_x + beta_y) + beta_x * beta_y) ) / &
+ ((alpha_0-alpha_x) * (alpha_0-alpha_x))
+ bar_A_3 = bar_A_0 * (alpha_0 - alpha_z) * (alpha_0-beta_x) * (alpha_0-beta_y) / &
+ (alpha_0-alpha_x)
- displ_y = A9 * displ(2,iglob) + A10 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) &
- + A11 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,2)
+ A_1 = bar_A_1
+ A_2 = bar_A_2 + time * bar_A_3
+ A_3 = - bar_A_3
- ! displ_z
- A12 = 1.d0
- A13 = 0.d0
- A14 = 0.d0
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 1 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) = 0.d0
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,2) = 0.d0
+ elseif(abs(alpha_x-alpha_y) < 1.e-5_CUSTOM_REAL .and. abs(alpha_x-beta_z) < 1.e-5_CUSTOM_REAL &
+ .and. abs(alpha_y-beta_z) < 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2,3-------------------------
+ alpha_0 = max(alpha_x,alpha_y,beta_z)
- displ_z = A12 * displ(3,iglob) + A13 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) &
- + A14 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,2)
+ bar_A_1 = bar_A_0 * (-3._CUSTOM_REAL * alpha_0 + alpha_z + beta_x + beta_y)
+ bar_A_2 = bar_A_0 * (3._CUSTOM_REAL * alpha_0 **2 + beta_x * beta_y + alpha_z * (beta_x + beta_y) &
+ -2._CUSTOM_REAL * alpha_0 * (alpha_z + beta_x + beta_y))
+ bar_A_3 = bar_A_0 * (-0.5_CUSTOM_REAL) * (alpha_0 - alpha_z) * (alpha_0-beta_x) * (alpha_0-beta_y)
+ A_1 = bar_A_1 + time * bar_A_2 + time**2 * bar_A_3
+ A_2 = - bar_A_2 - 2._CUSTOM_REAL * time * bar_A_3
+ A_3 = bar_A_3
- else if( CPML_regions(ispec_CPML) == CPML_XY_ONLY ) then
+ singularity_type_2 = 1 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 2 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- !------------------------------------------------------------------------------
- !---------------------------- XY-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
- ! displ_x
- A6 = k_store_y(i,j,k,ispec_CPML)
- A7 = d_store_y(i,j,k,ispec_CPML)
- A8 = 0.0
-
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
+ stop 'error in lijk_parameter_computation'
endif
+ elseif(CPML_region_local == CPML_YZ_ONLY_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = kappa_y / kappa_z
+ A_0 = bar_A_0
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_1 + (displ(1,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,2) = 0.d0
+ if(abs(alpha_y-beta_z) >= 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2,3-------------------------
- displ_x = A6 * displ(1,iglob) + A7 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) &
- + A8 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,2)
+ bar_A_1 = 0._CUSTOM_REAL
+ bar_A_2 = - bar_A_0 * (alpha_y - alpha_z) * (alpha_y - beta_y) / &
+ (alpha_y-beta_z)
+ bar_A_3 = - bar_A_0 * (beta_z - alpha_z) * (beta_z - beta_y) / &
+ (beta_z-alpha_y)
- ! displ_y
- A9 = k_store_x(i,j,k,ispec_CPML)
- A10 = d_store_x(i,j,k,ispec_CPML)
- A11 = 0.d0
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+ A_3 = bar_A_3
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ elseif( abs(alpha_y-beta_z) < 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2,3-------------------------
+ alpha_0 = max(alpha_y,beta_z)
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * coef1_1 + (displ(2,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,2) = 0.d0
+ bar_A_1 = 0._CUSTOM_REAL
+ bar_A_2 = bar_A_0 * (-2._CUSTOM_REAL * alpha_0 + ( alpha_z + beta_y))
+ bar_A_3 = bar_A_0 * (alpha_0 - alpha_z) * (alpha_0-beta_y)
- displ_y = A9 * displ(2,iglob) + A10 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) &
- + A11 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,2)
+ A_1 = bar_A_1
+ A_2 = bar_A_2 + time * bar_A_3
+ A_3 = - bar_A_3
- ! displ_z
- A12 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A13 = d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- + d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- A14 = - d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 1 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
+ stop 'error in lijk_parameter_computation'
endif
+ elseif(CPML_region_local == CPML_XZ_ONLY_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = kappa_x / kappa_z
+ A_0 = bar_A_0
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
+ if(abs(alpha_x-beta_z) >= 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2,3-------------------------
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * coef1_1 + (displ(3,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,2) = coef0_2 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,2) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * it*deltat * coef1_2 &
- + (displ(3,iglob)) * it*deltat * coef2_2
+ bar_A_1 = - bar_A_0 * (alpha_x - alpha_z) * (alpha_x - beta_x) / &
+ (alpha_x-beta_z)
+ bar_A_2 = 0._CUSTOM_REAL
+ bar_A_3 = - bar_A_0 * (beta_z - alpha_z) * (beta_z - beta_x) / &
+ ((beta_z-alpha_x))
- displ_z = A12 * displ(3,iglob) + A13 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) &
- + A14 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,2)
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+ A_3 = bar_A_3
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- else if( CPML_regions(ispec_CPML) == CPML_XZ_ONLY ) then
+ elseif(abs(alpha_x-beta_z) < 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2,3-------------------------
+ alpha_0 = max(alpha_x,beta_z)
- !------------------------------------------------------------------------------
- !---------------------------- XZ-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
+ bar_A_1 = bar_A_0 * (-2._CUSTOM_REAL * alpha_0 + (alpha_z + beta_x))
+ bar_A_2 = 0._CUSTOM_REAL
+ bar_A_3 = bar_A_0 * (alpha_0 - alpha_z) * (alpha_0-beta_x)
- ! displ_x
- A6 = k_store_z(i,j,k,ispec_CPML)
- A7 = d_store_z(i,j,k,ispec_CPML)
- A8 = 0.0
+ A_1 = bar_A_1 + time * bar_A_3
+ A_2 = bar_A_2
+ A_3 = -bar_A_3
- bb = alpha_store(i,j,k,ispec_CPML)
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 1 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
+ stop 'error in lijk_parameter_computation'
endif
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_1 + (displ(1,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,2) = 0.d0
+ elseif(CPML_region_local == CPML_XY_ONLY_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = kappa_x * kappa_y
+ A_0 = bar_A_0
- displ_x = A6 * displ(1,iglob) + A7 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) &
- + A8 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,2)
+ if(abs(alpha_x-alpha_y) >= 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2,3-------------------------
- ! displ_y
- A9 = k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A10 = d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A11 = - d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
+ bar_A_1 = - bar_A_0 * (alpha_x - beta_x) * (alpha_x - beta_y) / &
+ (alpha_x-alpha_y)
+ bar_A_2 = - bar_A_0 * (alpha_y - beta_x) * (alpha_y - beta_y) / &
+ (alpha_y-alpha_x)
+ bar_A_3 = 0._CUSTOM_REAL
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+ A_3 = bar_A_3
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
+ elseif(abs(alpha_x-alpha_y) < 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2,3-------------------------
+ alpha_0 = max(alpha_x,alpha_y)
+ bar_A_1 = bar_A_0 * (-2._CUSTOM_REAL * alpha_0 + (beta_x + beta_y))
+ bar_A_2 = bar_A_0 * (alpha_0 - beta_x) * (alpha_0 - beta_y)
+ bar_A_3 = 0._CUSTOM_REAL
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * coef1_1 + (displ(2,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,2) = coef0_2 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,2) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * it*deltat * coef1_2 &
- + (displ(2,iglob)) * it*deltat * coef2_2
+ A_1 = bar_A_1 + time * bar_A_2
+ A_2 = - bar_A_2
+ A_3 = bar_A_3
- displ_y = A9 * displ(2,iglob) + A10 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) &
- + A11 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,2)
+ singularity_type_2 = 1 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- ! displ_z
- A12 = k_store_x(i,j,k,ispec_CPML)
- A13 = d_store_x(i,j,k,ispec_CPML)
- A14 = 0.0
+ else
+ stop 'error in lijk_parameter_computation'
+ endif
+ elseif(CPML_region_local == CPML_X_ONLY_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = kappa_x
+ A_0 = bar_A_0
+ !----------------A1,2,3-------------------------
+ bar_A_1 = - bar_A_0 * (alpha_x - beta_x)
+ bar_A_2 = 0._CUSTOM_REAL
+ bar_A_3 = 0._CUSTOM_REAL
- bb = alpha_store(i,j,k,ispec_CPML)
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+ A_3 = bar_A_3
- coef0_1 = exp(-bb * deltat)
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ elseif(CPML_region_local == CPML_Y_ONLY_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = kappa_y
+ A_0 = bar_A_0
+ !----------------A1,2,3-------------------------
+ bar_A_1 = 0._CUSTOM_REAL
+ bar_A_2 = - bar_A_0 * (alpha_y - beta_y)
+ bar_A_3 = 0._CUSTOM_REAL
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * coef1_1 + (displ(3,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,2) = 0.d0
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+ A_3 = bar_A_3
- displ_z = A12 * displ(3,iglob) + A13 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) &
- + A14 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,2)
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ elseif(CPML_region_local == CPML_Z_ONLY_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = 1._CUSTOM_REAL / kappa_z
+ A_0 = bar_A_0
- else if( CPML_regions(ispec_CPML) == CPML_YZ_ONLY ) then
+ !----------------A1,2,3-------------------------
+ bar_A_1 = 0._CUSTOM_REAL
+ bar_A_2 = 0._CUSTOM_REAL
+ bar_A_3 = - bar_A_0 * (beta_z - alpha_z)
- !------------------------------------------------------------------------------
- !---------------------------- YZ-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
+ A_1 = bar_A_1
+ A_2 = bar_A_2
+ A_3 = bar_A_3
- ! displ_x
- A6 = k_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A7 = d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- + it*deltat * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A8 = - d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ singularity_type_3 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ endif
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ bb = alpha_x
+ coef0_1 = exp(- bb * deltat)
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ if ( abs(bb) > 1.e-5_CUSTOM_REAL ) then
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_1 = ( 1._CUSTOM_REAL - exp(- bb * deltat) ) / bb
+ coef2_1 = 0._CUSTOM_REAL
+ else
+ coef1_1 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) / bb
+ coef2_1 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) * exp(- bb * deltat / 2._CUSTOM_REAL) / bb
+ end if
+ else
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_1 = deltat
+ coef2_1 = 0._CUSTOM_REAL
+ else
+ coef1_1 = deltat / 2._CUSTOM_REAL
+ coef2_1 = deltat / 2._CUSTOM_REAL
+ end if
+ endif
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
+ bb = alpha_y
+ coef0_2 = exp(- bb * deltat)
+ if( abs(bb) > 1.e-5_CUSTOM_REAL ) then
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_2 = ( 1._CUSTOM_REAL - exp(- bb * deltat) ) / bb
+ coef2_2 = 0._CUSTOM_REAL
+ else
+ coef1_2 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) / bb
+ coef2_2 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) * exp(- bb * deltat / 2._CUSTOM_REAL) / bb
+ end if
+ else
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_2 = deltat
+ coef2_2 = 0._CUSTOM_REAL
+ else
+ coef1_2 = deltat / 2._CUSTOM_REAL
+ coef2_2 = deltat / 2._CUSTOM_REAL
+ end if
+ endif
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_1 + (displ(1,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,2) = coef0_2 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,2) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_2 + (displ(1,iglob)) * coef2_2
+ bb = beta_z
+ coef0_3 = exp(- bb * deltat)
+ if( abs(bb) > 1.e-5_CUSTOM_REAL ) then
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_3 = ( 1._CUSTOM_REAL - exp(- bb * deltat) ) / bb
+ coef2_3 = 0._CUSTOM_REAL
+ else
+ coef1_3 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) / bb
+ coef2_3 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) * exp(- bb * deltat / 2._CUSTOM_REAL) / bb
+ end if
+ else
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_3 = deltat
+ coef2_3 = 0._CUSTOM_REAL
+ else
+ coef1_3 = deltat / 2._CUSTOM_REAL
+ coef2_3 = deltat / 2._CUSTOM_REAL
+ end if
+ endif
- displ_x = A6 * displ(1,iglob) + A7 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) &
- + A8 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,2)
+end subroutine lijk_parameter_computation
+!
+!=====================================================================
+!
+!
+subroutine lx_parameter_computation(deltat,kappa_x,beta_x,alpha_x, &
+ CPML_region_local,A_0,A_1,&
+ coef0_1,coef1_1,coef2_1)
- ! displ_y
- A9 = k_store_z(i,j,k,ispec_CPML)
- A10 = d_store_z(i,j,k,ispec_CPML)
- A11 = 0.d0
+ use constants, only: CUSTOM_REAL,CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY,&
+ CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY,CPML_XYZ
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ implicit none
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ real(kind=CUSTOM_REAL), intent(in) :: deltat
+ real(kind=CUSTOM_REAL), intent(in) :: kappa_x,beta_x,alpha_x
+ integer, intent(in) :: CPML_region_local
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * coef1_1 + (displ(2,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,2) = 0.d0
+ real(kind=CUSTOM_REAL), intent(out) :: A_0,A_1
+ real(kind=CUSTOM_REAL), intent(out) :: coef0_1,coef1_1,coef2_1
- displ_y = A9 * displ(2,iglob) + A10 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) &
- + A11 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,2)
+ !local variable
+ real(kind=CUSTOM_REAL) :: bb
- ! displ_z
- A12 = k_store_y(i,j,k,ispec_CPML)
- A13 = d_store_y(i,j,k,ispec_CPML)
- A14 = 0.0
+ if(CPML_region_local == CPML_XYZ)then
+ !----------------A0-------------------------
+ A_0 = kappa_x
+ !----------------A1-------------------------
+ A_1 = - A_0 * (alpha_x - beta_x)
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ elseif(CPML_region_local == CPML_YZ_ONLY)then
+ !----------------A0-------------------------
+ A_0 = 1._CUSTOM_REAL
+ !----------------A1-------------------------
+ A_1 = 0._CUSTOM_REAL
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ elseif(CPML_region_local == CPML_XZ_ONLY)then
+ !----------------A0-------------------------
+ A_0 = kappa_x
+ !----------------A1-------------------------
+ A_1 = - A_0 * (alpha_x - beta_x)
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * coef1_1 + (displ(3,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,2) = 0.d0
+ elseif(CPML_region_local == CPML_XY_ONLY)then
+ !----------------A0-------------------------
+ A_0 = kappa_x
+ !----------------A1-------------------------
+ A_1 = - A_0 * (alpha_x - beta_x)
- displ_z = A12 * displ(3,iglob) + A13 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) &
- + A14 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,2)
+ elseif(CPML_region_local == CPML_X_ONLY)then
+ !----------------A0-------------------------
+ A_0 = kappa_x
+ !----------------A1-------------------------
+ A_1 = - A_0 * (alpha_x - beta_x)
+ elseif(CPML_region_local == CPML_Y_ONLY)then
+ !----------------A0-------------------------
+ A_0 = 1._CUSTOM_REAL
+ !----------------A1-------------------------
+ A_1 = 0._CUSTOM_REAL
- else if( CPML_regions(ispec_CPML) == CPML_XYZ ) then
+ elseif(CPML_region_local == CPML_Z_ONLY)then
+ !----------------A0-------------------------
+ A_0 = 1._CUSTOM_REAL
+ !----------------A1-------------------------
+ A_1 = 0._CUSTOM_REAL
- !------------------------------------------------------------------------------
- !---------------------------- XYZ-corner C-PML --------------------------------
- !------------------------------------------------------------------------------
- ! displ_x
- A6 = k_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A7 = d_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- + it*deltat * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A8 = - d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
+ endif
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ bb = alpha_x
+ coef0_1 = exp(- bb * deltat)
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ if( abs(bb) > 1.e-5_CUSTOM_REAL ) then
+ coef1_1 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) / bb
+ coef2_1 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) * exp(- bb * deltat / 2._CUSTOM_REAL) / bb
+ else
+ coef1_1 = deltat / 2._CUSTOM_REAL
+ coef2_1 = deltat / 2._CUSTOM_REAL
+ endif
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
+end subroutine lx_parameter_computation
+!
+!=====================================================================
+!
+subroutine ly_parameter_computation(deltat,kappa_y,beta_y,alpha_y, &
+ CPML_region_local,A_0,A_1,&
+ coef0_1,coef1_1,coef2_1)
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_1 + (displ(1,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(1,i,j,k,iface,2) = coef0_2 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,2) &
- + (displ(1,iglob) + deltat * veloc(1,iglob)) * coef1_2 + (displ(1,iglob)) * coef2_2
+ use constants, only: CUSTOM_REAL,CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY,&
+ CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY,CPML_XYZ
- displ_x = A6 * displ(1,iglob) + A7 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,1) &
- + A8 * rmemory_coupling_ac_el_displ(1,i,j,k,iface,2)
+ implicit none
- ! displ_y
- A9 = k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- A10 = d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- + d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- A11 = - d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
+ real(kind=CUSTOM_REAL), intent(in) :: deltat
+ real(kind=CUSTOM_REAL), intent(in) :: kappa_y,beta_y,alpha_y
+ integer, intent(in) :: CPML_region_local
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ real(kind=CUSTOM_REAL), intent(out) :: A_0,A_1
+ real(kind=CUSTOM_REAL), intent(out) :: coef0_1,coef1_1,coef2_1
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ !local variable
+ real(kind=CUSTOM_REAL) :: bb
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
+ if(CPML_region_local == CPML_XYZ)then
+ !----------------A0-------------------------
+ A_0 = kappa_y
+ !----------------A1-------------------------
+ A_1 = - A_0 * (alpha_y - beta_y)
+ elseif(CPML_region_local == CPML_YZ_ONLY)then
+ !----------------A0-------------------------
+ A_0 = kappa_y
+ !----------------A1-------------------------
+ A_1 = - A_0 * (alpha_y - beta_y)
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * coef1_1 + (displ(2,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(2,i,j,k,iface,2) = coef0_2 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,2) &
- + (displ(2,iglob) + deltat * veloc(2,iglob)) * it*deltat * coef1_2 &
- + (displ(2,iglob)) * it*deltat * coef2_2
+ elseif(CPML_region_local == CPML_XZ_ONLY)then
+ !----------------A0-------------------------
+ A_0 = 1._CUSTOM_REAL
+ !----------------A1-------------------------
+ A_1 = 0._CUSTOM_REAL
- displ_y = A9 * displ(2,iglob) + A10 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,1) &
- + A11 * rmemory_coupling_ac_el_displ(2,i,j,k,iface,2)
+ elseif(CPML_region_local == CPML_XY_ONLY)then
+ !----------------A0-------------------------
+ A_0 = kappa_y
+ !----------------A1-------------------------
+ A_1 = - A_0 * (alpha_y - beta_y)
- ! displ_z
- A12 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A13 = d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- + d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- A14 = - d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
+ elseif(CPML_region_local == CPML_X_ONLY)then
+ !----------------A0-------------------------
+ A_0 = 1._CUSTOM_REAL
+ !----------------A1-------------------------
+ A_1 = 0._CUSTOM_REAL
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ elseif(CPML_region_local == CPML_Y_ONLY)then
+ !----------------A0-------------------------
+ A_0 = kappa_y
+ !----------------A1-------------------------
+ A_1 = - A_0 * (alpha_y - beta_y)
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ elseif(CPML_region_local == CPML_Z_ONLY)then
+ !----------------A0-------------------------
+ A_0 = 1._CUSTOM_REAL
+ !----------------A1-------------------------
+ A_1 = 0._CUSTOM_REAL
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
+ endif
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) = coef0_1 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * coef1_1 + (displ(3,iglob)) * coef2_1
- rmemory_coupling_ac_el_displ(3,i,j,k,iface,2) = coef0_2 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,2) &
- + (displ(3,iglob) + deltat * veloc(3,iglob)) * it*deltat * coef1_2 &
- + (displ(3,iglob)) * it*deltat * coef2_2
+ bb = alpha_y
+ coef0_1 = exp(- bb * deltat)
- displ_z = A12 * displ(3,iglob) + A13 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,1) &
- + A14 * rmemory_coupling_ac_el_displ(3,i,j,k,iface,2)
+ if( abs(bb) > 1.e-5_CUSTOM_REAL ) then
+ coef1_1 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) / bb
+ coef2_1 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) * exp(- bb * deltat / 2._CUSTOM_REAL) / bb
else
- stop 'wrong PML flag in PML memory variable calculation routine'
+ coef1_1 = deltat / 2._CUSTOM_REAL
+ coef2_1 = deltat / 2._CUSTOM_REAL
endif
-end subroutine pml_compute_memory_variables_acoustic_elastic
-
+end subroutine ly_parameter_computation
!
!=====================================================================
!
-subroutine pml_compute_memory_variables_elastic_acoustic(ispec_CPML,iface,iglob,i,j,k,&
- pressure,potential_acoustic,potential_dot_acoustic,&
- num_coupling_ac_el_faces,rmemory_coupling_el_ac_potential)
- ! calculates C-PML elastic memory variables and computes stress sigma
+!
+!=====================================================================
+!
+!
+subroutine lz_parameter_computation(deltat,kappa_z,beta_z,alpha_z, &
+ CPML_region_local,A_0,A_1,&
+ coef0_1,coef1_1,coef2_1)
- ! second-order accurate convolution term calculation from equation (21) of
- ! Shumin Wang, Robert Lee, and Fernando L. Teixeira,
- ! Anisotropic-Medium PML for Vector FETD With Modified Basis Functions,
- ! IEEE Transactions on Antennas and Propagation, vol. 54, no. 1, (2006)
+ use constants, only: CUSTOM_REAL,CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY,&
+ CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY,CPML_XYZ
- use specfem_par, only: NGLOB_AB,it,deltat
- use pml_par,only : CPML_regions,k_store_x,k_store_y,d_store_x,d_store_y,alpha_store
- use constants, only: CUSTOM_REAL,NDIM,NGLLX,NGLLY,NGLLZ,&
- CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY,CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY,CPML_XYZ
-
implicit none
- integer, intent(in) :: ispec_CPML,iface,iglob,num_coupling_ac_el_faces
- real(kind=CUSTOM_REAL) :: pressure
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB), intent(in) :: potential_acoustic,potential_dot_acoustic
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,num_coupling_ac_el_faces,2) :: &
- rmemory_coupling_el_ac_potential
+ real(kind=CUSTOM_REAL), intent(in) :: deltat
+ real(kind=CUSTOM_REAL), intent(in) :: kappa_z,beta_z,alpha_z
+ integer, intent(in) :: CPML_region_local
- ! local parameters
- integer :: i,j,k
- real(kind=CUSTOM_REAL) :: bb,coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2
- real(kind=CUSTOM_REAL) :: A12,A13,A14
+ real(kind=CUSTOM_REAL), intent(out) :: A_0,A_1
+ real(kind=CUSTOM_REAL), intent(out) :: coef0_1,coef1_1,coef2_1
+ !local variable
+ real(kind=CUSTOM_REAL) :: bb
- if( CPML_regions(ispec_CPML) == CPML_X_ONLY ) then
+ if(CPML_region_local == CPML_XYZ)then
+ !----------------A0-------------------------
+ A_0 = kappa_z
+ !----------------A1-------------------------
+ A_1 = - A_0 * (alpha_z - beta_z)
- !------------------------------------------------------------------------------
- !---------------------------- X-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
+ elseif(CPML_region_local == CPML_YZ_ONLY)then
+ !----------------A0-------------------------
+ A_0 = kappa_z
+ !----------------A1-------------------------
+ A_1 = - A_0 * (alpha_z - beta_z)
- ! displ_z
- A12 = k_store_x(i,j,k,ispec_CPML)
- A13 = d_store_x(i,j,k,ispec_CPML)
- A14 = 0.d0
+ elseif(CPML_region_local == CPML_XZ_ONLY)then
+ !----------------A0-------------------------
+ A_0 = kappa_z
+ !----------------A1-------------------------
+ A_1 = - A_0 * (alpha_z - beta_z)
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ elseif(CPML_region_local == CPML_XY_ONLY)then
+ !----------------A0-------------------------
+ A_0 = 1._CUSTOM_REAL
+ !----------------A1-------------------------
+ A_1 = 0._CUSTOM_REAL
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ elseif(CPML_region_local == CPML_X_ONLY)then
+ !----------------A0-------------------------
+ A_0 = 1._CUSTOM_REAL
+ !----------------A1-------------------------
+ A_1 = 0._CUSTOM_REAL
- rmemory_coupling_el_ac_potential(i,j,k,iface,1) = coef0_1 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) &
- + (potential_acoustic(iglob) + deltat * potential_dot_acoustic(iglob)) * coef1_1 &
- + (potential_acoustic(iglob)) * coef2_1
- rmemory_coupling_el_ac_potential(i,j,k,iface,2) = 0.d0
+ elseif(CPML_region_local == CPML_Y_ONLY)then
+ !----------------A0-------------------------
+ A_0 = 1._CUSTOM_REAL
+ !----------------A1-------------------------
+ A_1 = 0._CUSTOM_REAL
- pressure = A12 * potential_acoustic(iglob) + A13 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) &
- + A14 * rmemory_coupling_el_ac_potential(i,j,k,iface,2)
+ elseif(CPML_region_local == CPML_Z_ONLY)then
+ !----------------A0-------------------------
+ A_0 = kappa_z
+ !----------------A1-------------------------
+ A_1 = - A_0 * (alpha_z - beta_z)
+ endif
- else if( CPML_regions(ispec_CPML) == CPML_Y_ONLY ) then
- !------------------------------------------------------------------------------
- !---------------------------- Y-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
- ! displ_z
- A12 = k_store_y(i,j,k,ispec_CPML)
- A13 = d_store_y(i,j,k,ispec_CPML)
- A14 = 0.0
+ bb = alpha_z
+ coef0_1 = exp(- bb * deltat)
- bb = alpha_store(i,j,k,ispec_CPML)
+ if( abs(bb) > 1.e-5_CUSTOM_REAL ) then
+ coef1_1 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) / bb
+ coef2_1 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) * exp(- bb * deltat / 2._CUSTOM_REAL) / bb
+ else
+ coef1_1 = deltat / 2._CUSTOM_REAL
+ coef2_1 = deltat / 2._CUSTOM_REAL
+ endif
- coef0_1 = exp(-bb * deltat)
+end subroutine lz_parameter_computation
+!
+!=====================================================================
+!
+subroutine lxy_interface_parameter_computation(time,deltat,kappa_x,beta_x,alpha_x,kappa_y,beta_y,alpha_y, &
+ CPML_region_local,index_ijk,A_0,A_1,A_2,&
+ coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2,&
+ singularity_type_2)
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ use constants, only: CUSTOM_REAL,CPML_X_ONLY,CPML_Y_ONLY,CPML_Z_ONLY,&
+ CPML_XY_ONLY,CPML_XZ_ONLY,CPML_YZ_ONLY,CPML_XYZ
- rmemory_coupling_el_ac_potential(i,j,k,iface,1) = coef0_1 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) &
- + (potential_acoustic(iglob) + deltat * potential_dot_acoustic(iglob)) * coef1_1 &
- + (potential_acoustic(iglob)) * coef2_1
- rmemory_coupling_el_ac_potential(i,j,k,iface,2) = 0.d0
+ implicit none
- pressure = A12 * potential_acoustic(iglob) + A13 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) &
- + A14 * rmemory_coupling_el_ac_potential(i,j,k,iface,2)
+ real(kind=CUSTOM_REAL), intent(in) :: time,deltat
+ real(kind=CUSTOM_REAL), intent(in) :: kappa_x,beta_x,alpha_x, &
+ kappa_y,beta_y,alpha_y
+ integer, intent(in) :: CPML_region_local,index_ijk
+ real(kind=CUSTOM_REAL), intent(out) :: A_0,A_1,A_2
+ real(kind=CUSTOM_REAL), intent(out) :: coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2
+ integer, intent(out) :: singularity_type_2
- else if( CPML_regions(ispec_CPML) == CPML_Z_ONLY ) then
+ !local variable
+ real(kind=CUSTOM_REAL) :: bar_A_0,bar_A_1,bar_A_2,alpha_0,bb
- !------------------------------------------------------------------------------
- !---------------------------- Z-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
- ! displ_z
- A12 = 1.d0
- A13 = 0.d0
- A14 = 0.d0
+ integer :: CPML_X_ONLY_TEMP,CPML_Y_ONLY_TEMP,CPML_Z_ONLY_TEMP,&
+ CPML_XY_ONLY_TEMP,CPML_XZ_ONLY_TEMP,CPML_YZ_ONLY_TEMP,CPML_XYZ_TEMP
- rmemory_coupling_el_ac_potential(i,j,k,iface,1) = 0.d0
- rmemory_coupling_el_ac_potential(i,j,k,iface,2) = 0.d0
+ logical,parameter :: FIRST_ORDER_CONVOLUTION = .false.
- pressure = A12 * potential_acoustic(iglob) + A13 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) &
- + A14 * rmemory_coupling_el_ac_potential(i,j,k,iface,2)
+ if(index_ijk == 12)then
+ CPML_X_ONLY_TEMP = CPML_X_ONLY
+ CPML_Y_ONLY_TEMP = CPML_Y_ONLY
+ CPML_Z_ONLY_TEMP = CPML_Z_ONLY
+ CPML_XY_ONLY_TEMP = CPML_XY_ONLY
+ CPML_XZ_ONLY_TEMP = CPML_XZ_ONLY
+ CPML_YZ_ONLY_TEMP = CPML_YZ_ONLY
+ CPML_XYZ_TEMP = CPML_XYZ
+ else
+ stop 'In lxy_interface_parameter_computation index_ijk must be equal to 12'
+ endif
+ if(CPML_region_local == CPML_XYZ_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = kappa_x * kappa_y
+ A_0 = bar_A_0
- else if( CPML_regions(ispec_CPML) == CPML_XY_ONLY ) then
+ if(abs(alpha_x-alpha_y) >= 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2-------------------------
- !------------------------------------------------------------------------------
- !---------------------------- XY-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
- ! displ_z
- A12 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A13 = d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- + d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- A14 = - d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
+ bar_A_1 = - bar_A_0 * (alpha_x - beta_x) * (alpha_x - beta_y) / &
+ (alpha_x-alpha_y)
+ bar_A_2 = - bar_A_0 * (alpha_y - beta_x) * (alpha_y - beta_y) / &
+ (alpha_y-alpha_x)
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ A_1 = bar_A_1
+ A_2 = bar_A_2
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+
+ elseif(abs(alpha_x-alpha_y) < 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2-------------------------
+ alpha_0 = max(alpha_x,alpha_y)
+
+ bar_A_1 = bar_A_0 * (-2._CUSTOM_REAL * alpha_0 + (beta_x + beta_y))
+ bar_A_2 = bar_A_0 * (alpha_0 - beta_x) * (alpha_0 - beta_y)
+
+ A_1 = bar_A_1 + time * bar_A_2
+ A_2 = - bar_A_2
+
+ singularity_type_2 = 1 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+
else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
+ stop 'error in lxy_interface_parameter_computation'
endif
+ elseif(CPML_region_local == CPML_YZ_ONLY_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = kappa_y
+ A_0 = bar_A_0
+ !----------------A1,2,3-------------------------
+ bar_A_1 = 0._CUSTOM_REAL
+ bar_A_2 = - bar_A_0 * (alpha_y - beta_y)
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
+ A_1 = bar_A_1
+ A_2 = bar_A_2
- rmemory_coupling_el_ac_potential(i,j,k,iface,1) = coef0_1 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) &
- + (potential_acoustic(iglob) + deltat * potential_dot_acoustic(iglob)) * coef1_1 &
- + (potential_acoustic(iglob)) * coef2_1
- rmemory_coupling_el_ac_potential(i,j,k,iface,2) = coef0_2 * rmemory_coupling_el_ac_potential(i,j,k,iface,2) &
- + (potential_acoustic(iglob) + deltat * potential_dot_acoustic(iglob)) * it*deltat * coef1_2 &
- + (potential_acoustic(iglob)) * it*deltat * coef2_2
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- pressure = A12 * potential_acoustic(iglob) + A13 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) &
- + A14 * rmemory_coupling_el_ac_potential(i,j,k,iface,2)
+ elseif(CPML_region_local == CPML_XZ_ONLY_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = kappa_x
+ A_0 = bar_A_0
+ !----------------A1,2,3-------------------------
+ bar_A_1 = - bar_A_0 * (alpha_x - beta_x)
+ bar_A_2 = 0._CUSTOM_REAL
- else if( CPML_regions(ispec_CPML) == CPML_XZ_ONLY ) then
+ A_1 = bar_A_1
+ A_2 = bar_A_2
- !------------------------------------------------------------------------------
- !---------------------------- XZ-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
- ! displ_z
- A12 = k_store_x(i,j,k,ispec_CPML)
- A13 = d_store_x(i,j,k,ispec_CPML)
- A14 = 0.0
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- bb = alpha_store(i,j,k,ispec_CPML)
+ elseif(CPML_region_local == CPML_XY_ONLY_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = kappa_x * kappa_y
+ A_0 = bar_A_0
- coef0_1 = exp(-bb * deltat)
+ if(abs(alpha_x-alpha_y) >= 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2,3-------------------------
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ bar_A_1 = - bar_A_0 * (alpha_x - beta_x) * (alpha_x - beta_y) / &
+ (alpha_x-alpha_y)
+ bar_A_2 = - bar_A_0 * (alpha_y - beta_x) * (alpha_y - beta_y) / &
+ (alpha_y-alpha_x)
- rmemory_coupling_el_ac_potential(i,j,k,iface,1) = coef0_1 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) &
- + (potential_acoustic(iglob) + deltat * potential_dot_acoustic(iglob)) * coef1_1 &
- + (potential_acoustic(iglob)) * coef2_1
- rmemory_coupling_el_ac_potential(i,j,k,iface,2) = 0.d0
+ A_1 = bar_A_1
+ A_2 = bar_A_2
- pressure = A12 * potential_acoustic(iglob) + A13 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) &
- + A14 * rmemory_coupling_el_ac_potential(i,j,k,iface,2)
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ elseif(abs(alpha_x-alpha_y) < 1.e-5_CUSTOM_REAL)then
+ !----------------A1,2,3-------------------------
+ alpha_0 = max(alpha_x,alpha_y)
- else if( CPML_regions(ispec_CPML) == CPML_YZ_ONLY ) then
+ bar_A_1 = bar_A_0 * (-2._CUSTOM_REAL * alpha_0 + (beta_x + beta_y))
+ bar_A_2 = bar_A_0 * (alpha_0 - beta_x) * (alpha_0 - beta_y)
- !------------------------------------------------------------------------------
- !---------------------------- YZ-edge C-PML -----------------------------------
- !------------------------------------------------------------------------------
+ A_1 = bar_A_1 + time * bar_A_2
+ A_2 = - bar_A_2
- ! displ_z
- A12 = k_store_y(i,j,k,ispec_CPML)
- A13 = d_store_y(i,j,k,ispec_CPML)
- A14 = 0.0
+ singularity_type_2 = 1 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
-
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
+ stop 'error in lxy_interface_parameter_computation'
endif
+ elseif(CPML_region_local == CPML_X_ONLY_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = kappa_x
+ A_0 = bar_A_0
+ !----------------A1,2,3-------------------------
+ bar_A_1 = - bar_A_0 * (alpha_x - beta_x)
+ bar_A_2 = 0._CUSTOM_REAL
- rmemory_coupling_el_ac_potential(i,j,k,iface,1) = coef0_1 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) &
- + (potential_acoustic(iglob) + deltat * potential_dot_acoustic(iglob)) * coef1_1 &
- + (potential_acoustic(iglob)) * coef2_1
- rmemory_coupling_el_ac_potential(i,j,k,iface,2) = 0.d0
+ A_1 = bar_A_1
+ A_2 = bar_A_2
- pressure = A12 * potential_acoustic(iglob) + A13 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) &
- + A14 * rmemory_coupling_el_ac_potential(i,j,k,iface,2)
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
+ elseif(CPML_region_local == CPML_Y_ONLY_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = kappa_y
+ A_0 = bar_A_0
+ !----------------A1,2,3-------------------------
+ bar_A_1 = 0._CUSTOM_REAL
+ bar_A_2 = - bar_A_0 * (alpha_y - beta_y)
- else if( CPML_regions(ispec_CPML) == CPML_XYZ ) then
+ A_1 = bar_A_1
+ A_2 = bar_A_2
- !------------------------------------------------------------------------------
- !---------------------------- XYZ-corner C-PML --------------------------------
- !------------------------------------------------------------------------------
- ! displ_z
- A12 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- A13 = d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- + d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) &
- + it*deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- A14 = - d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ elseif(CPML_region_local == CPML_Z_ONLY_TEMP)then
+ !----------------A0-------------------------
+ bar_A_0 = 1._CUSTOM_REAL
+ A_0 = bar_A_0
- if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
- coef2_1 = (1.d0 - exp(-bb * deltat/2.d0)) * exp(-bb * deltat/2.d0) / bb
- else
- coef1_1 = deltat/2.0d0
- coef2_1 = deltat/2.0d0
- endif
+ !----------------A1,2,3-------------------------
+ bar_A_1 = 0._CUSTOM_REAL
+ bar_A_2 = 0._CUSTOM_REAL
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
+ A_1 = bar_A_1
+ A_2 = bar_A_2
- rmemory_coupling_el_ac_potential(i,j,k,iface,1) = coef0_1 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) &
- + (potential_acoustic(iglob) + deltat * potential_dot_acoustic(iglob)) * coef1_1 &
- + (potential_acoustic(iglob)) * coef2_1
- rmemory_coupling_el_ac_potential(i,j,k,iface,2) = coef0_2 * rmemory_coupling_el_ac_potential(i,j,k,iface,2) &
- + (potential_acoustic(iglob) + deltat * potential_dot_acoustic(iglob)) * it*deltat * coef1_2 &
- + (potential_acoustic(iglob)) * it*deltat * coef2_2
+ singularity_type_2 = 0 ! 0 means no singularity, 1 means first order singularity, 2 means second order singularity
- pressure = A12 * potential_acoustic(iglob) + A13 * rmemory_coupling_el_ac_potential(i,j,k,iface,1) &
- + A14 * rmemory_coupling_el_ac_potential(i,j,k,iface,2)
else
- stop 'wrong PML flag in PML memory variable calculation routine'
+ stop 'error in lxy_interface_parameter_computation'
endif
-end subroutine pml_compute_memory_variables_elastic_acoustic
+ bb = alpha_x
+ coef0_1 = exp(- bb * deltat)
+ if ( abs(bb) > 1.e-5_CUSTOM_REAL ) then
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_1 = ( 1._CUSTOM_REAL - exp(- bb * deltat) ) / bb
+ coef2_1 = 0._CUSTOM_REAL
+ else
+ coef1_1 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) / bb
+ coef2_1 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) * exp(- bb * deltat / 2._CUSTOM_REAL) / bb
+ end if
+ else
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_1 = deltat
+ coef2_1 = 0._CUSTOM_REAL
+ else
+ coef1_1 = deltat / 2._CUSTOM_REAL
+ coef2_1 = deltat / 2._CUSTOM_REAL
+ end if
+ endif
+
+ bb = alpha_y
+ coef0_2 = exp(- bb * deltat)
+ if( abs(bb) > 1.e-5_CUSTOM_REAL ) then
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_2 = ( 1._CUSTOM_REAL - exp(- bb * deltat) ) / bb
+ coef2_2 = 0._CUSTOM_REAL
+ else
+ coef1_2 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) / bb
+ coef2_2 = ( 1._CUSTOM_REAL - exp(- bb * deltat / 2._CUSTOM_REAL) ) * exp(- bb * deltat / 2._CUSTOM_REAL) / bb
+ end if
+ else
+ if ( FIRST_ORDER_CONVOLUTION ) then
+ coef1_2 = deltat
+ coef2_2 = 0._CUSTOM_REAL
+ else
+ coef1_2 = deltat / 2._CUSTOM_REAL
+ coef2_2 = deltat / 2._CUSTOM_REAL
+ end if
+ endif
+
+end subroutine lxy_interface_parameter_computation
+
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_par.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_par.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_par.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -60,21 +60,24 @@
! auxiliary parameters arrays
real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: K_store_x, K_store_y, K_store_z
- real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: alpha_store
+ real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: alpha_store_x,alpha_store_y,alpha_store_z
+ !store the field of displ + 2 * deltat**2 * accel at time step n-1 for second order convolution scheme
+ real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: displ_old
+
! derivatives of ux, uy and uz with respect to x, y and z
real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: PML_dux_dxl,PML_dux_dyl,PML_dux_dzl
real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: PML_duy_dxl,PML_duy_dyl,PML_duy_dzl
real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: PML_duz_dxl,PML_duz_dyl,PML_duz_dzl
- real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: PML_dux_dxl_new,PML_dux_dyl_new,PML_dux_dzl_new
- real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: PML_duy_dxl_new,PML_duy_dyl_new,PML_duy_dzl_new
- real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: PML_duz_dxl_new,PML_duz_dyl_new,PML_duz_dzl_new
+ real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: PML_dux_dxl_old,PML_dux_dyl_old,PML_dux_dzl_old
+ real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: PML_duy_dxl_old,PML_duy_dyl_old,PML_duy_dzl_old
+ real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: PML_duz_dxl_old,PML_duz_dyl_old,PML_duz_dzl_old
! derivatives of potential with respect to x, y and z
real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: PML_dpotential_dxl,PML_dpotential_dyl,PML_dpotential_dzl
- real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: PML_dpotential_dxl_new,PML_dpotential_dyl_new,PML_dpotential_dzl_new
+ real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: PML_dpotential_dxl_old,PML_dpotential_dyl_old,PML_dpotential_dzl_old
! C-PML memory variables
real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: rmemory_dux_dxl_x,rmemory_dux_dyl_x,rmemory_dux_dzl_x
@@ -89,6 +92,12 @@
real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: rmemory_duy_dyl_z,rmemory_duy_dzl_z
real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: rmemory_duz_dxl_z,rmemory_duz_dyl_z,rmemory_duz_dzl_z
+ !store the field of displ + 2 * deltat**2 * accel at time step n-1 for second order convolution scheme
+ real(kind=CUSTOM_REAL), dimension(:), allocatable :: potential_acoustic_old
+
+ !store the field accel at time step n-1 for second order convolution scheme
+ real(kind=CUSTOM_REAL), dimension(:), allocatable :: potential_dot_dot_acoustic_old
+
real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: rmemory_dpotential_dxl
real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: rmemory_dpotential_dyl
real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: rmemory_dpotential_dzl
@@ -110,6 +119,7 @@
! C-PML contribution to update displacement on elastic/acoustic interface
real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: rmemory_coupling_el_ac_potential
+ real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: rmemory_coupling_el_ac_potential_dot_dot
! --------------------------------------------------------------------------------------------
! for adjoint tomography
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -255,17 +255,10 @@
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
my_neighbours_ext_mesh)
- call assemble_MPI_scalar_blocking(NPROC,NGLOB_AB,rmass_acoustic_interface, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh)
-
! fill mass matrix with fictitious non-zero values to make sure it can be inverted globally
where(rmass_acoustic <= 0._CUSTOM_REAL) rmass_acoustic = 1._CUSTOM_REAL
rmass_acoustic(:) = 1._CUSTOM_REAL / rmass_acoustic(:)
- where(rmass_acoustic_interface <= 0._CUSTOM_REAL) rmass_acoustic_interface = 1._CUSTOM_REAL
- rmass_acoustic_interface(:) = 1._CUSTOM_REAL / rmass_acoustic_interface(:)
endif
if(ELASTIC_SIMULATION) then
@@ -305,17 +298,6 @@
rmassy(:) = 1._CUSTOM_REAL / rmassy(:)
rmassz(:) = 1._CUSTOM_REAL / rmassz(:)
- if(PML_CONDITIONS)then
- if(ACOUSTIC_SIMULATION)then
- call assemble_MPI_scalar_blocking(NPROC,NGLOB_AB,rmass_elastic_interface, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh)
- where(rmass_elastic_interface <= 0._CUSTOM_REAL) rmass_elastic_interface = 1._CUSTOM_REAL
- rmass_elastic_interface(:) = 1._CUSTOM_REAL / rmass_elastic_interface(:)
- endif
- endif
-
! ocean load
if(APPROXIMATE_OCEAN_LOAD ) then
call assemble_MPI_scalar_blocking(NPROC,NGLOB_AB,rmass_ocean_load, &
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.F90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.F90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -92,8 +92,6 @@
if( ier /= 0 ) stop 'error allocating array potential_dot_acoustic'
allocate(potential_dot_dot_acoustic(NGLOB_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array potential_dot_dot_acoustic'
- allocate(potential_dot_dot_acoustic_interface(NGLOB_AB),stat=ier)
- if( ier /= 0 ) stop 'error allocating array potential_dot_dot_acoustic_interface'
if( SIMULATION_TYPE /= 1 ) then
allocate(potential_acoustic_adj_coupling(NGLOB_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array potential_acoustic_adj_coupling'
@@ -101,10 +99,7 @@
! mass matrix, density
allocate(rmass_acoustic(NGLOB_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array rmass_acoustic'
- allocate(rmass_acoustic_interface(NGLOB_AB),stat=ier)
- if( ier /= 0 ) stop 'error allocating array rmass_acoustic_interface'
read(27) rmass_acoustic
- read(27) rmass_acoustic_interface
! initializes mass matrix contribution
allocate(rmassz_acoustic(NGLOB_AB),stat=ier)
@@ -140,29 +135,6 @@
! allocates mass matrix
allocate(rmass(NGLOB_AB),stat=ier)
- if(PML_CONDITIONS)then
- if(ACOUSTIC_SIMULATION)then
- allocate(rmass_elastic_interface(NGLOB_AB),stat=ier)
- if( ier /= 0 ) stop 'error allocating array rmass_elastic_interface'
- rmass_elastic_interface(:) = 0._CUSTOM_REAL
- if(SIMULATION_TYPE == 3)then
- allocate(accel_interface(NDIM,NGLOB_AB),stat=ier)
- if( ier /= 0 ) stop 'error allocating array accel_interface'
- accel_interface(:,:) = 0._CUSTOM_REAL
- else
- allocate(accel_interface(NDIM,1),stat=ier)
- if( ier /= 0 ) stop 'error allocating array accel_interface'
- accel_interface(:,:) = 0._CUSTOM_REAL
- endif
- else
- allocate(rmass_elastic_interface(1),stat=ier)
- allocate(accel_interface(NDIM,1),stat=ier)
- endif
- else
- allocate(rmass_elastic_interface(1),stat=ier)
- allocate(accel_interface(NDIM,1),stat=ier)
- endif
-
if( ier /= 0 ) stop 'error allocating array rmass'
! initializes mass matrix contributions
allocate(rmassx(NGLOB_AB), &
@@ -239,13 +211,6 @@
read(27,iostat=ier) rmass
if( ier /= 0 ) stop 'error reading in array rmass'
- if(PML_CONDITIONS)then !need to be optimized
- if(ACOUSTIC_SIMULATION)then
- read(27,iostat=ier) rmass_elastic_interface
- if( ier /= 0 ) stop 'error reading in array rmass_elastic_interface'
- endif
- endif
-
if( APPROXIMATE_OCEAN_LOAD ) then
! ocean mass matrix
allocate(rmass_ocean_load(NGLOB_AB),stat=ier)
@@ -400,8 +365,12 @@
if(ier /= 0) stop 'error allocating array K_store_y'
allocate(K_store_z(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
if(ier /= 0) stop 'error allocating array K_store_z'
- allocate(alpha_store(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
+ allocate(alpha_store_x(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
if(ier /= 0) stop 'error allocating array alpha_store'
+ allocate(alpha_store_y(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
+ if(ier /= 0) stop 'error allocating array alpha_store'
+ allocate(alpha_store_z(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
+ if(ier /= 0) stop 'error allocating array alpha_store'
read(27) CPML_regions
read(27) CPML_to_spec
@@ -412,7 +381,9 @@
read(27) k_store_x
read(27) k_store_y
read(27) k_store_z
- read(27) alpha_store
+ read(27) alpha_store_x
+ read(27) alpha_store_y
+ read(27) alpha_store_z
if((SIMULATION_TYPE == 1 .and. SAVE_FORWARD) .or. SIMULATION_TYPE == 3) then
read(27) nglob_interface_PML_acoustic
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases_adios.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases_adios.F90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases_adios.F90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -103,8 +103,7 @@
local_dim_ispec_is_acoustic, local_dim_ispec_is_elastic, &
local_dim_ispec_is_poroelastic, local_dim_rmass, &
local_dim_rmass_ocean_load, local_dim_rmass_acoustic, &
- local_dim_rmass_acoustic_interface, local_dim_rmass_elastic, &
- local_dim_rmass_elastic_interface, local_dim_rho_vp, &
+ local_dim_rmass_elastic,local_dim_rho_vp, &
local_dim_rho_vs, local_dim_abs_boundary_ispec, &
local_dim_abs_boundary_ijk, local_dim_abs_boundary_jacobian2Dw, &
local_dim_abs_boundary_normal, local_dim_ibelm_xmin, &
@@ -369,18 +368,11 @@
if( ACOUSTIC_SIMULATION ) then
call adios_get_scalar(handle, "rmass_acoustic/local_dim",&
local_dim_rmass_acoustic,ier)
- call adios_get_scalar(handle, "rmass_acoustic_interface/local_dim",&
- local_dim_rmass_acoustic_interface,ier)
endif
if( ELASTIC_SIMULATION ) then
call adios_get_scalar(handle, "rmass/local_dim",&
local_dim_rmass,ier)
- if(PML_CONDITIONS)then
- if(ACOUSTIC_SIMULATION)then
- call adios_get_scalar(handle, "rmass_elastic_interface/local_dim",&
- local_dim_rmass_elastic_interface,ier)
- endif
- endif
+
if( APPROXIMATE_OCEAN_LOAD) then
call adios_get_scalar(handle, "rmass_ocean_load/local_dim",&
local_dim_rmass_ocean_load,ier)
@@ -602,8 +594,6 @@
if( ier /= 0 ) stop 'error allocating array potential_dot_acoustic'
allocate(potential_dot_dot_acoustic(NGLOB_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array potential_dot_dot_acoustic'
- allocate(potential_dot_dot_acoustic_interface(NGLOB_AB),stat=ier)
- if( ier /= 0 ) stop 'error allocating array potential_dot_dot_acoustic_interface'
if( SIMULATION_TYPE /= 1 ) then
allocate(potential_acoustic_adj_coupling(NGLOB_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array potential_acoustic_adj_coupling'
@@ -611,8 +601,6 @@
! mass matrix, density
allocate(rmass_acoustic(NGLOB_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array rmass_acoustic'
- allocate(rmass_acoustic_interface(NGLOB_AB),stat=ier)
- if( ier /= 0 ) stop 'error allocating array rmass_acoustic_interface'
! initializes mass matrix contribution
allocate(rmassz_acoustic(NGLOB_AB),stat=ier)
@@ -647,29 +635,6 @@
! allocates mass matrix
allocate(rmass(NGLOB_AB),stat=ier)
- if(PML_CONDITIONS)then
- if(ACOUSTIC_SIMULATION)then
- allocate(rmass_elastic_interface(NGLOB_AB),stat=ier)
- if( ier /= 0 ) stop 'error allocating array rmass_elastic_interface'
- rmass_elastic_interface(:) = 0._CUSTOM_REAL
- if(SIMULATION_TYPE == 3)then
- allocate(accel_interface(NDIM,NGLOB_AB),stat=ier)
- if( ier /= 0 ) stop 'error allocating array accel_interface'
- accel_interface(:,:) = 0._CUSTOM_REAL
- else
- allocate(accel_interface(NDIM,1),stat=ier)
- if( ier /= 0 ) stop 'error allocating array accel_interface'
- accel_interface(:,:) = 0._CUSTOM_REAL
- endif
- else
- allocate(rmass_elastic_interface(1),stat=ier)
- allocate(accel_interface(NDIM,1),stat=ier)
- endif
- else
- allocate(rmass_elastic_interface(1),stat=ier)
- allocate(accel_interface(NDIM,1),stat=ier)
- endif
-
if( ier /= 0 ) stop 'error allocating array rmass'
! initializes mass matrix contributions
allocate(rmassx(NGLOB_AB), &
@@ -1060,8 +1025,6 @@
call adios_selection_boundingbox (sel , 1, start, count_ad)
call adios_schedule_read(handle, sel, "rmass_acoustic/array", 0, 1, &
rmass_acoustic, ier)
- call adios_schedule_read(handle, sel, "rmass_acoustic_interface/array", &
- 0, 1, rmass_acoustic_interface, ier)
endif
if( ELASTIC_SIMULATION ) then
@@ -1073,19 +1036,6 @@
call adios_schedule_read(handle, sel, "rmass/array", 0, 1, &
rmass, ier)
- if(PML_CONDITIONS)then !need to be optimized
- if(ACOUSTIC_SIMULATION)then
- start(1) = local_dim_rmass * myrank
- count_ad(1) = NGLOB_AB
- sel_num = sel_num+1
- sel => selections(sel_num)
- call adios_selection_boundingbox (sel , 1, start, count_ad)
- call adios_schedule_read(handle, sel, &
- "rmass_elastic_interface/array", 0, 1, &
- rmass_elastic_interface, ier)
- endif
- endif
-
if( APPROXIMATE_OCEAN_LOAD ) then
! ocean mass matrix
start(1) = local_dim_rmass_ocean_load * myrank
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D_par.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D_par.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D_par.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -320,10 +320,6 @@
! mass matrix
real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmass
-! PML on fluid-solid interface
- real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: accel_interface
- real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmass_elastic_interface
-
! Stacey
real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmassx,rmassy,rmassz
real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: rho_vp,rho_vs
@@ -404,12 +400,11 @@
! potential
real(kind=CUSTOM_REAL), dimension(:), allocatable :: potential_acoustic,potential_dot_acoustic, &
- potential_dot_dot_acoustic,potential_dot_dot_acoustic_interface
+ potential_dot_dot_acoustic
real(kind=CUSTOM_REAL), dimension(:), allocatable :: potential_acoustic_adj_coupling
! mass matrix
real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmass_acoustic
- real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmass_acoustic_interface
real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmassz_acoustic
! acoustic-elastic coupling surface
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/update_displacement_scheme.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/update_displacement_scheme.f90 2013-10-19 22:15:11 UTC (rev 22966)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/update_displacement_scheme.f90 2013-10-22 09:55:50 UTC (rev 22967)
@@ -101,8 +101,11 @@
if( .not. GPU_MODE ) then
! wavefields on CPU
-
! updates (forward) acoustic potentials
+ if(PML_CONDITIONS .and. NSPEC_CPML > 0)then
+ potential_acoustic_old(:) = potential_acoustic(:) + deltatsqover2*4._CUSTOM_REAL*potential_dot_dot_acoustic(:)
+ potential_dot_dot_acoustic_old(:) = potential_dot_dot_acoustic(:)
+ endif
potential_acoustic(:) = potential_acoustic(:) &
+ deltat * potential_dot_acoustic(:) &
+ deltatsqover2 * potential_dot_dot_acoustic(:)
@@ -164,6 +167,9 @@
! wavefields on CPU
! updates elastic displacement and velocity
+ if(PML_CONDITIONS .and. NSPEC_CPML > 0)then
+ displ_old(:,:) = displ(:,:) + deltatsqover2*4._CUSTOM_REAL*accel(:,:)
+ endif
displ(:,:) = displ(:,:) + deltat*veloc(:,:) + deltatsqover2*accel(:,:)
veloc(:,:) = veloc(:,:) + deltatover2*accel(:,:)
if( SIMULATION_TYPE /= 1 ) accel_adj_coupling(:,:) = accel(:,:)
More information about the CIG-COMMITS
mailing list