[cig-commits] r21281 - seismo/3D/SPECFEM3D/trunk/src/specfem3D
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Sat Jan 19 10:03:21 PST 2013
Author: dkomati1
Date: 2013-01-19 10:03:21 -0800 (Sat, 19 Jan 2013)
New Revision: 21281
Added:
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_accel_contribution.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_memory_variables.f90
Removed:
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_set_accel_contribution.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_set_memory_variables.f90
Modified:
seismo/3D/SPECFEM3D/trunk/src/specfem3D/Makefile.in
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_noDev.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90
Log:
changed pml_set_ to pml_compute_ in all subroutines for clarity
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/Makefile.in 2013-01-19 17:59:58 UTC (rev 21280)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/Makefile.in 2013-01-19 18:03:21 UTC (rev 21281)
@@ -208,8 +208,8 @@
$O/noise_tomography.o \
$O/pml_allocate_arrays.o \
$O/pml_output_VTKs.o \
- $O/pml_set_accel_contribution.o \
- $O/pml_set_memory_variables.o \
+ $O/pml_compute_accel_contribution.o \
+ $O/pml_compute_memory_variables.o \
$O/prepare_timerun.o \
$O/program_specfem3D.o \
$O/read_mesh_databases.o \
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_noDev.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_noDev.f90 2013-01-19 17:59:58 UTC (rev 21280)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_noDev.f90 2013-01-19 18:03:21 UTC (rev 21281)
@@ -237,13 +237,13 @@
if( PML_CONDITIONS .and. CPML_mask_ibool(ispec) ) then
! sets C-PML elastic memory variables to compute stress sigma and form dot product with test vector
- call pml_set_memory_variables(ispec,ispec_CPML,deltat,jacobianl,tempx1,tempy1,tempz1,tempx2,tempy2,tempz2, &
+ call pml_compute_memory_variables(ispec,ispec_CPML,deltat,jacobianl,tempx1,tempy1,tempz1,tempx2,tempy2,tempz2, &
tempx3,tempy3,tempz3,sigma_xx,sigma_yy,sigma_zz,sigma_xy,sigma_xz,sigma_yz, &
sigma_yx,sigma_zx,sigma_zy,lambdal,mul,lambdalplus2mul,xixl,xiyl,xizl, &
etaxl,etayl,etazl,gammaxl,gammayl,gammazl)
! calculates contribution from each C-PML element to update acceleration
- call pml_set_accel_contribution(ispec,ispec_CPML,deltat,jacobianl,accel_elastic_CPML)
+ call pml_compute_accel_contribution(ispec,ispec_CPML,deltat,jacobianl,accel_elastic_CPML)
endif
! second double-loop over GLL to compute all the terms
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90 2013-01-19 17:59:58 UTC (rev 21280)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90 2013-01-19 18:03:21 UTC (rev 21281)
@@ -541,13 +541,13 @@
if( PML_CONDITIONS .and. CPML_mask_ibool(ispec) ) then
! sets C-PML elastic memory variables to compute stress sigma and form dot product with test vector
- call pml_set_memory_variables(ispec,ispec_CPML,deltat,jacobianl,tempx1,tempy1,tempz1,tempx2,tempy2,tempz2, &
+ call pml_compute_memory_variables(ispec,ispec_CPML,deltat,jacobianl,tempx1,tempy1,tempz1,tempx2,tempy2,tempz2, &
tempx3,tempy3,tempz3,sigma_xx,sigma_yy,sigma_zz,sigma_xy,sigma_xz,sigma_yz, &
sigma_yx,sigma_zx,sigma_zy,lambdal,mul,lambdalplus2mul,xixl,xiyl,xizl, &
etaxl,etayl,etazl,gammaxl,gammayl,gammazl)
! calculates contribution from each C-PML element to update acceleration
- call pml_set_accel_contribution(ispec,ispec_CPML,deltat,jacobianl,accel_elastic_CPML)
+ call pml_compute_accel_contribution(ispec,ispec_CPML,deltat,jacobianl,accel_elastic_CPML)
endif
! second double-loop over GLL to compute all the terms
Copied: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_accel_contribution.f90 (from rev 21279, seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_set_accel_contribution.f90)
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_accel_contribution.f90 (rev 0)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_accel_contribution.f90 2013-01-19 18:03:21 UTC (rev 21281)
@@ -0,0 +1,825 @@
+!=====================================================================
+!
+! S p e c f e m 3 D V e r s i o n 2 . 1
+! ---------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA and CNRS / INRIA / University of Pau
+! (c) Princeton University / California Institute of Technology and CNRS / INRIA / University of Pau
+! July 2012
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+!
+! United States and French Government Sponsorship Acknowledged.
+
+subroutine pml_compute_accel_contribution(ispec,ispec_CPML,deltat,jacobianl,accel_elastic_CPML)
+
+ ! calculates contribution from each C-PML element to update acceleration to the global mesh
+
+ use specfem_par, only: ibool,wgllwgll_yz,wgllwgll_xz,wgllwgll_xy,it,kappastore
+ use specfem_par_elastic, only: rho_vp,displ,veloc,ispec_is_elastic
+ use specfem_par_acoustic, only: potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic,ispec_is_acoustic
+ use pml_par, only: NSPEC_CPML,rmemory_displ_elastic,rmemory_potential_acoustic,CPML_regions,spec_to_CPML,alpha_store, &
+ d_store_x,d_store_y,d_store_z,K_store_x,K_store_y,K_store_z,potential_dot_dot_acoustic_CPML
+ use constants, only: CUSTOM_REAL,NDIM,NGLLX,NGLLY,NGLLZ
+
+ implicit none
+
+ integer, intent(in) :: ispec,ispec_CPML
+
+ real(kind=CUSTOM_REAL), intent(in) :: deltat,jacobianl
+
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NGLLZ,NSPEC_CPML), intent(out) :: accel_elastic_CPML
+
+ ! local parameters
+ integer :: i,j,k,iglob
+
+ real(kind=CUSTOM_REAL) :: fac1,fac2,fac3,fac4,rhol,kappal
+ 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 ! for convolution of acceleration
+ real(kind=CUSTOM_REAL) :: temp_A3,temp_A4,temp_A5
+
+ do k=1,NGLLZ
+ do j=1,NGLLY
+ do i=1,NGLLX
+ rhol = rho_vp(i,j,k,ispec)
+ kappal = kappastore(i,j,k,ispec)
+
+ iglob = ibool(i,j,k,ispec)
+
+ if( CPML_regions(ispec_CPML) == 1 ) then
+ !------------------------------------------------------------------------------
+ !---------------------------- X-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
+ end if
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ 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
+ endif
+
+ !---------------------- 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
+
+ fac1 = wgllwgll_yz(j,k)
+ fac2 = wgllwgll_xz(i,k)
+ fac3 = wgllwgll_xy(i,j)
+ fac4 = sqrt(fac1 * fac2 * fac3)
+
+ if( ispec_is_elastic(ispec) ) then
+
+ accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
+ )
+ endif
+
+ elseif( CPML_regions(ispec_CPML) == 2 ) then
+ !------------------------------------------------------------------------------
+ !---------------------------- Y-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
+ end if
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ 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
+ endif
+
+ !---------------------- 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
+
+ fac1 = wgllwgll_yz(j,k)
+ fac2 = wgllwgll_xz(i,k)
+ fac3 = wgllwgll_xy(i,j)
+ fac4 = sqrt(fac1 * fac2 * fac3)
+
+ if( ispec_is_elastic(ispec) ) then
+
+ accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
+ )
+ endif
+
+ elseif( CPML_regions(ispec_CPML) == 3 ) 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
+ end if
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ 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
+ endif
+
+ !---------------------- 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
+
+ fac1 = wgllwgll_yz(j,k)
+ fac2 = wgllwgll_xz(i,k)
+ fac3 = wgllwgll_xy(i,j)
+ fac4 = sqrt(fac1 * fac2 * fac3)
+
+ if( ispec_is_elastic(ispec) ) then
+
+ accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
+ )
+ endif
+
+ elseif( CPML_regions(ispec_CPML) == 4 ) 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
+ end if
+
+ coef0_2 = coef0_1
+ coef1_2 = coef1_1
+ coef2_2 = coef2_1
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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+0.0) * deltat * coef1_2 &
+ + displ(1,iglob) * (it-0.0) * 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+0.0) * deltat * coef1_2 &
+ + displ(2,iglob) * (it-0.0) * 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+0.0) * deltat * coef1_2 &
+ + displ(3,iglob) * (it-0.0) * deltat * coef2_2
+ rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) = 0.0
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ 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+0.5)*deltat * coef1_2 &
+ + potential_acoustic(iglob) * (it-0.5)*deltat * coef2_2
+ rmemory_potential_acoustic(i,j,k,ispec_CPML,3)=0.0
+ endif
+
+ !---------------------- 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)
+ if( ispec_is_elastic(ispec) ) then
+ 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+0.0) * deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
+ elseif( ispec_is_acoustic(ispec) ) then
+ 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+0.5) * deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
+ endif
+ 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
+
+ fac1 = wgllwgll_yz(j,k)
+ fac2 = wgllwgll_xz(i,k)
+ fac3 = wgllwgll_xy(i,j)
+ fac4 = sqrt(fac1 * fac2 * fac3)
+
+ if( ispec_is_elastic(ispec) ) then
+
+ accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
+ )
+ endif
+
+ elseif( CPML_regions(ispec_CPML) == 5 ) 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
+ end if
+
+ coef0_2 = coef0_1
+ coef1_2 = coef1_1
+ coef2_2 = coef2_1
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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+0.0) * deltat * coef1_2 &
+ + displ(1,iglob) * (it-0.0) * 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+0.0) * deltat * coef1_2 &
+ + displ(2,iglob) * (it-0.0) * 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+0.0) * deltat * coef1_2 &
+ + displ(3,iglob) * (it-0.0) * deltat * coef2_2
+ rmemory_displ_elastic(3,i,j,k,ispec_CPML,3)= 0.0
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ 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+0.5)*deltat * coef1_2 &
+ + potential_acoustic(iglob) * (it-0.5)*deltat * coef2_2
+ rmemory_potential_acoustic(i,j,k,ispec_CPML,3)= 0.0
+ endif
+
+ !---------------------- 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)
+ if( ispec_is_elastic(ispec) ) then
+ 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+0.0) * deltat * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
+ elseif( ispec_is_acoustic(ispec) ) then
+ 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+0.5) * deltat * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
+ endif
+ 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
+
+ fac1 = wgllwgll_yz(j,k)
+ fac2 = wgllwgll_xz(i,k)
+ fac3 = wgllwgll_xy(i,j)
+ fac4 = sqrt(fac1 * fac2 * fac3)
+
+ if( ispec_is_elastic(ispec) ) then
+
+ accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
+ )
+ endif
+
+ elseif( CPML_regions(ispec_CPML) == 6 ) 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
+ end if
+
+ coef0_2 = coef0_1
+ coef1_2 = coef1_1
+ coef2_2 = coef2_1
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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+0.0) * deltat * coef1_2 &
+ + displ(1,iglob) * (it-0.0) * 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+0.0) * deltat * coef1_2 &
+ + displ(2,iglob) * (it-0.0) * 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+0.0) * deltat * coef1_2 &
+ + displ(3,iglob) * (it-0.0) * deltat * coef2_2
+ rmemory_displ_elastic(3,i,j,k,ispec_CPML,3)=0.d0
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ 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+0.5)*deltat * coef1_2 &
+ + potential_acoustic(iglob) * (it-0.5)*deltat * coef2_2
+ rmemory_potential_acoustic(i,j,k,ispec_CPML,3)=0.d0
+ endif
+
+ !---------------------- 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)
+ if( ispec_is_elastic(ispec) ) then
+ 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+0.0) * deltat * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
+ elseif( ispec_is_acoustic(ispec) ) then
+ 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+0.5) * deltat * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
+ endif
+ 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
+
+ fac1 = wgllwgll_yz(j,k)
+ fac2 = wgllwgll_xz(i,k)
+ fac3 = wgllwgll_xy(i,j)
+ fac4 = sqrt(fac1 * fac2 * fac3)
+
+ if( ispec_is_elastic(ispec) ) then
+
+ accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
+ )
+ endif
+
+ elseif( CPML_regions(ispec_CPML) == 7 ) 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
+ end if
+
+ coef0_2 = coef0_1
+ coef1_2 = coef1_1
+ coef2_2 = coef2_1
+
+ coef0_3 = coef0_1
+ coef1_3 = coef1_1
+ coef2_3 = coef2_1
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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+0.0) * deltat * coef1_2 &
+ + displ(1,iglob) * (it-0.0) * 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+0.0) * deltat)**2 * coef1_3 &
+ + displ(1,iglob) * ((it-0.0) * 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+0.0) * deltat * coef1_2 &
+ + displ(2,iglob) * (it-0.0) * 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+0.0) * deltat)**2 * coef1_3 &
+ + displ(2,iglob) * ((it-0.0) * 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+0.0) * deltat * coef1_2 &
+ + displ(3,iglob) * (it-0.0) * 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+0.0) * deltat)**2 * coef1_3 &
+ + displ(3,iglob) * ((it-0.0) * deltat)**2 * coef2_3
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ 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+0.5)*deltat * coef1_2 &
+ + potential_acoustic(iglob) * (it-0.5)*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+0.5)*deltat)**2 * coef1_3 &
+ + potential_acoustic(iglob) * ((it-0.5)*deltat)**2 * coef2_3
+ endif
+
+ !---------------------- 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
+
+ if( ispec_is_elastic(ispec) ) then
+ 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
+ elseif( ispec_is_acoustic(ispec)) then
+ A3 = temp_A3 + (it+0.5)*deltat*temp_A4 !+ ((it+0.5)*deltat)**2*temp_A5
+ A4 = -temp_A4 !-2.0*(it+0.5)*deltat*temp_A5
+ endif
+ A5 = 0.0 ! temp_A5
+
+ fac1 = wgllwgll_yz(j,k)
+ fac2 = wgllwgll_xz(i,k)
+ fac3 = wgllwgll_xy(i,j)
+ fac4 = sqrt(fac1 * fac2 * fac3)
+
+ if( ispec_is_elastic(ispec) ) then
+
+ accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
+ )
+
+ elseif( ispec_is_acoustic(ispec) ) then
+
+ potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
+ )
+ endif
+ endif
+ enddo
+ enddo
+ enddo
+
+end subroutine pml_compute_accel_contribution
Copied: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_memory_variables.f90 (from rev 21279, seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_set_memory_variables.f90)
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_memory_variables.f90 (rev 0)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_memory_variables.f90 2013-01-19 18:03:21 UTC (rev 21281)
@@ -0,0 +1,2190 @@
+!=====================================================================
+!
+! S p e c f e m 3 D V e r s i o n 2 . 1
+! ---------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA and CNRS / INRIA / University of Pau
+! (c) Princeton University / California Institute of Technology and CNRS / INRIA / University of Pau
+! July 2012
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+!
+! United States and French Government Sponsorship Acknowledged.
+
+subroutine pml_compute_memory_variables(ispec,ispec_CPML,deltat,jacobianl,tempx1,tempy1,tempz1,tempx2,tempy2,tempz2, &
+ tempx3,tempy3,tempz3,sigma_xx,sigma_yy,sigma_zz,sigma_xy,sigma_xz,sigma_yz, &
+ sigma_yx,sigma_zx,sigma_zy,lambdal,mul,lambdalplus2mul,xixl,xiyl,xizl, &
+ etaxl,etayl,etazl,gammaxl,gammayl,gammazl)
+
+ ! calculates C-PML elastic memory variables and computes stress sigma
+
+ use specfem_par, only: it
+ use specfem_par_elastic, only: ispec_is_elastic
+ use specfem_par_acoustic, only: ispec_is_acoustic
+ use pml_par
+ use constants, only: NGLLX,NGLLY,NGLLZ
+
+ implicit none
+
+ integer, intent(in) :: ispec,ispec_CPML
+
+ real(kind=CUSTOM_REAL), intent(in) :: lambdal,mul,lambdalplus2mul
+ real(kind=CUSTOM_REAL), intent(in) :: deltat,xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl,jacobianl
+
+ 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
+
+ ! local parameters
+ integer :: i,j,k
+
+ real(kind=CUSTOM_REAL) :: sigma_xx,sigma_yy,sigma_zz,sigma_xy,sigma_xz,sigma_yz,sigma_yx,sigma_zx,sigma_zy
+ 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) :: 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,A15,A16,A17 ! for convolution of strain(complex)
+ real(kind=CUSTOM_REAL) :: A18,A19,A20 ! for convolution of strain(simple)
+
+ if( CPML_regions(ispec_CPML) == 1 ) then
+
+ do k=1,NGLLZ
+ do j=1,NGLLY
+ do i=1,NGLLX
+
+ !------------------------------------------------------------------------------
+ !---------------------------- X-surface C-PML ---------------------------------
+ !------------------------------------------------------------------------------
+
+ !---------------------- 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_2
+
+ duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
+ duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
+ duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dpotential_dxl(i,j,k,ispec_CPML) * coef2_2
+
+ dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2)
+ 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
+
+ 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
+ duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
+ duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dpotential_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = 0.d0
+
+ dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2)
+ 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
+
+ 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
+ duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
+ duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dpotential_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = 0.d0
+
+ dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
+ endif
+
+ if( ispec_is_elastic(ispec) ) then
+ !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) &
+ + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) &
+ + PML_duz_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
+ duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
+
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) &
+ + PML_duy_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) &
+ + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
+ duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
+
+
+ !---------------------- A17 and A18 --------------------------
+ A17 = 1.d0
+ A18 = 0.0
+
+ rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
+ duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
+ duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
+
+
+ !---------------------- A19 and A20 --------------------------
+ A19 = 1.d0
+ A20 = 0.0
+
+ rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
+ duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
+ duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
+ endif
+
+ enddo
+ enddo
+ enddo
+ endif
+
+ if( CPML_regions(ispec_CPML) == 2 ) then
+ do k=1,NGLLZ
+ do j=1,NGLLY
+ do i=1,NGLLX
+ !------------------------------------------------------------------------------
+ !---------------------------- 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
+ duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
+ duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dpotential_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = 0.d0
+
+ dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2)
+ endif
+
+ !---------------------- 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_2
+
+ duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
+ duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
+ duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dpotential_dyl(i,j,k,ispec_CPML) * coef2_2
+
+ dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2)
+ endif
+
+ !---------------------- 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
+ duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
+ duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dpotential_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = 0.d0
+
+ dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
+ endif
+
+ if( ispec_is_elastic(ispec) ) then
+ !---------------------- A15 and A16 --------------------------
+ A15 = 1.d0
+ A16 = 0.d0
+
+ rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
+ duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
+
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
+ duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
+
+ !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) &
+ + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) &
+ + PML_duz_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
+ duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) &
+ + PML_dux_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) &
+ + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
+ duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
+
+
+ !---------------------- A19 and A20--------------------------
+ A19 = 1.d0
+ A20 = 0.0
+
+ rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
+ duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
+ duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
+ endif
+
+ enddo
+ enddo
+ enddo
+ endif
+
+ if( CPML_regions(ispec_CPML) == 3 ) then
+ do k=1,NGLLZ
+ do j=1,NGLLY
+ do i=1,NGLLX
+
+ !------------------------------------------------------------------------------
+ !---------------------------- 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
+ duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
+ duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dpotential_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = 0.d0
+
+ dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2)
+ endif
+
+ !---------------------- 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
+ duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
+ duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dpotential_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = 0.d0
+
+ dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2)
+ endif
+
+ !---------------------- 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_2
+
+ duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
+ duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
+ duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dpotential_dzl(i,j,k,ispec_CPML) * coef2_2
+
+ dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
+ endif
+
+ if( ispec_is_elastic(ispec) ) then
+ !---------------------- A15 and A16 --------------------------
+ A15 = 1.d0
+ A16 = 0.d0
+
+ rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
+ duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
+
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
+ duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
+
+ !---------------------- A17 and A18 --------------------------
+ A17 = 1.d0
+ A18 = 0.d0
+
+ rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
+ duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
+ duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
+
+ !---------------------- 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,1) = coef0_1 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) &
+ + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) &
+ + PML_duy_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
+ duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) &
+ + PML_dux_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) &
+ + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
+ duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
+ endif
+
+ enddo
+ enddo
+ enddo
+ endif
+
+ if( CPML_regions(ispec_CPML) == 4 ) then
+ do k=1,NGLLZ
+ do j=1,NGLLY
+ do i=1,NGLLX
+
+ !------------------------------------------------------------------------------
+ !---------------------------- 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_2
+
+ duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
+ duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
+ duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dpotential_dxl(i,j,k,ispec_CPML) * coef2_2
+
+ dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2)
+ 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)
+
+ 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( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_2
+
+ duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
+ duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
+ duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dpotential_dyl(i,j,k,ispec_CPML) * coef2_2
+
+ dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2)
+ endif
+
+ !---------------------- A12, A13 and A14 --------------------------
+ A12 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
+ if( ispec_is_elastic(ispec) ) then
+ 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+0.0) * deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
+ else if( ispec_is_acoustic(ispec) ) then
+ 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+0.5)*deltat*d_store_x(i,j,k,ispec_CPML)*d_store_y(i,j,k,ispec_CPML)
+ endif
+ 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_dux_dzl(i,j,k,ispec_CPML) * (it-0.0) * 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,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_duy_dzl(i,j,k,ispec_CPML) * (it-0.0) * 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,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_duz_dzl(i,j,k,ispec_CPML) * (it-0.0) * deltat * coef2_2
+
+ duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
+ duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
+ duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dpotential_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) *(it+0.5)*deltat * coef1_2 &
+ + PML_dpotential_dzl(i,j,k,ispec_CPML) *(it-0.5)*deltat * coef2_2
+
+ dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
+ endif
+
+ if( ispec_is_elastic(ispec) ) then
+ !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) &
+ + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) &
+ + PML_duz_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
+ duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
+
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) &
+ + PML_duy_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) &
+ + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
+ duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
+
+ !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) &
+ + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) &
+ + PML_duz_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
+ duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) &
+ + PML_dux_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) &
+ + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
+ duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
+
+ !---------------------- A19 and A20--------------------------
+ A19 = 1.d0
+ A20 = 0.0
+
+ rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
+ duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
+ duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
+ endif
+
+ enddo
+ enddo
+ enddo
+ endif
+
+ if(CPML_regions(ispec_CPML)==5) then
+ do k=1,NGLLZ
+ do j=1,NGLLY
+ do i=1,NGLLX
+
+ !------------------------------------------------------------------------------
+ !---------------------------- 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_2
+
+ duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
+ duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
+ duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dpotential_dxl(i,j,k,ispec_CPML) * coef2_2
+
+ dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2)
+ endif
+
+ !---------------------- A9, A10 and A11 --------------------------
+ A9 = k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
+ if( ispec_is_elastic(ispec) ) then
+ 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+0.0) * deltat * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
+ else if( ispec_is_acoustic(ispec) ) then
+ 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+0.5)*deltat*d_store_x(i,j,k,ispec_CPML)*d_store_z(i,j,k,ispec_CPML)
+ endif
+ 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
+
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * coef2_1
+ 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_dux_dyl(i,j,k,ispec_CPML) * (it-0.0) * 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,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
+ 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_duy_dyl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
+ 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_duz_dyl(i,j,k,ispec_CPML) * (it-0.0) * deltat * coef2_2
+
+ duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
+ duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
+ duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dpotential_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) *(it+0.5)*deltat* coef1_2 &
+ + PML_dpotential_dyl(i,j,k,ispec_CPML) *(it-0.5)*deltat* coef2_2
+
+ dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2)
+ 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
+
+ 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_2
+
+ duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
+ duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
+ duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dpotential_dzl(i,j,k,ispec_CPML) * coef2_2
+
+ dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
+ endif
+
+ if( ispec_is_elastic(ispec) ) then
+ !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) &
+ + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) &
+ + PML_duz_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
+ duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
+
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) &
+ + PML_duy_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) &
+ + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
+ duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
+
+ !---------------------- A17 and A18 --------------------------
+ A17 = 1.0d0
+ A18 = 0.d0
+
+ rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
+ duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
+ duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
+
+ !---------------------- 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,1) = coef0_1 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) &
+ + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) &
+ + PML_duy_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
+ duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) &
+ + PML_dux_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) &
+ + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
+ duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
+ endif
+
+ enddo
+ enddo
+ enddo
+ endif
+
+ if( CPML_regions(ispec_CPML) == 6 ) then
+
+ do k=1,NGLLZ
+ do j=1,NGLLY
+ do i=1,NGLLX
+ !------------------------------------------------------------------------------
+ !---------------------------- 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)
+ if( ispec_is_elastic(ispec) ) then
+ 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+0.0) * deltat * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
+ else if( ispec_is_acoustic(ispec) ) then
+ 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+0.5)*deltat*d_store_y(i,j,k,ispec_CPML)*d_store_z(i,j,k,ispec_CPML)
+ endif
+ 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_dux_dxl(i,j,k,ispec_CPML) * (it-0.0) * 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,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_duy_dxl(i,j,k,ispec_CPML) * (it-0.0) * 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,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_duz_dxl(i,j,k,ispec_CPML) * (it-0.0) * deltat * coef2_2
+
+ duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
+ duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
+ duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dpotential_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.5)*deltat* coef1_2 &
+ + PML_dpotential_dxl(i,j,k,ispec_CPML) *(it-0.5)*deltat* coef2_2
+
+ dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2)
+ endif
+
+ !---------------------- 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_2
+
+ duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
+ duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
+ duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dpotential_dyl(i,j,k,ispec_CPML) * coef2_2
+
+ dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2)
+ endif
+
+ !---------------------- 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_2
+
+ duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
+ duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
+ duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_2 + PML_dpotential_dzl(i,j,k,ispec_CPML) * coef2_2
+
+ dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
+ endif
+
+ if( ispec_is_elastic(ispec) ) then
+ !---------------------- A15 and A16 --------------------------
+ A15 = 1.0d0
+ A16 = 0.0d0
+
+ rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
+ duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
+
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = 0.d0
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
+ duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
+
+ !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) &
+ + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) &
+ + PML_duz_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
+ duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) &
+ + PML_dux_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) &
+ + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
+ duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
+
+ !---------------------- 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,1) = coef0_1 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) &
+ + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) &
+ + PML_duy_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
+ duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) &
+ + PML_dux_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) &
+ + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
+ duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
+ endif
+
+ enddo
+ enddo
+ enddo
+ endif
+
+ if( CPML_regions(ispec_CPML) == 7 ) then
+
+ do k=1,NGLLZ
+ do j=1,NGLLY
+ do i=1,NGLLX
+ !------------------------------------------------------------------------------
+ !---------------------------- 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)) .gt. 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
+ if( ispec_is_elastic(ispec) ) then
+ 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+0.0)*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)
+ else if( ispec_is_acoustic(ispec) ) then
+ 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+0.5)*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)
+ endif
+ 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
+
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
+
+ if( abs(d_store_x(i,j,k,ispec_CPML)) .gt. 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,ispec_CPML) * coef1_2 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_dux_dxl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_duy_dxl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_duz_dxl(i,j,k,ispec_CPML) * (it-0.0)*deltat * coef2_2
+ endif
+
+ duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
+ duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
+ duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dpotential_dxl(i,j,k,ispec_CPML) * coef2_1
+
+ if(abs(d_store_x(i,j,k,ispec_CPML)).gt. 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,ispec_CPML) * coef1_2 + PML_dpotential_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.5)*deltat* coef1_2 &
+ + PML_dpotential_dxl(i,j,k,ispec_CPML) * (it-0.5)*deltat* coef2_2
+ endif
+
+ dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
+ + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,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)) .gt. 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
+ if( ispec_is_elastic(ispec) ) then
+ 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+0.0)*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)
+ else if( ispec_is_acoustic(ispec) ) then
+ 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+0.5)*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)
+ endif
+ 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
+
+ if( abs(d_store_y(i,j,k,ispec_CPML)) .gt. 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,ispec_CPML) * coef1_2 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_dux_dyl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_duy_dyl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_duz_dyl(i,j,k,ispec_CPML) * (it-0.0)*deltat * coef2_2
+ endif
+
+ duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
+ duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
+ duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+ 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,ispec_CPML) * coef1_1 + PML_dpotential_dyl(i,j,k,ispec_CPML) * coef2_1
+
+ if(abs(d_store_y(i,j,k,ispec_CPML)).gt. 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,ispec_CPML) * coef1_2 + PML_dpotential_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.5)*deltat* coef1_2 &
+ + PML_dpotential_dyl(i,j,k,ispec_CPML) * (it-0.5)*deltat* coef2_2
+ endif
+
+ dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
+ + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,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)) .gt. 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
+ if( ispec_is_elastic(ispec) ) then
+ 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+0.0)*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)
+ else if( ispec_is_acoustic(ispec) ) then
+ 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+0.5)*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)
+ endif
+ 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
+
+ if( ispec_is_elastic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
+
+ if( abs(d_store_z(i,j,k,ispec_CPML)) .gt. 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,ispec_CPML) * coef1_2 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_dux_dzl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_duy_dzl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
+ + PML_duz_dzl(i,j,k,ispec_CPML) * (it-0.0)*deltat * coef2_2
+ endif
+
+ duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
+ duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
+ duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
+
+ else if( ispec_is_acoustic(ispec) ) then
+
+ 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,ispec_CPML) * coef1_1 + PML_dpotential_dzl(i,j,k,ispec_CPML) * coef2_1
+
+ if(abs(d_store_z(i,j,k,ispec_CPML)).gt. 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,ispec_CPML) * coef1_2 + PML_dpotential_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.5)*deltat* coef1_2 &
+ + PML_dpotential_dzl(i,j,k,ispec_CPML) * (it-0.5)*deltat* coef2_2
+ endif
+
+ dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
+ + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
+ endif
+
+ if( ispec_is_elastic(ispec) ) then
+ !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) &
+ + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) &
+ + PML_duz_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
+ duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
+
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) &
+ + PML_duy_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) &
+ + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
+ duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
+
+ !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) &
+ + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) &
+ + PML_duz_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
+ duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) &
+ + PML_dux_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) &
+ + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
+ duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
+
+ !---------------------- 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,1) = coef0_1 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) &
+ + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) &
+ + PML_duy_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
+
+ duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
+ duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
+
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) &
+ + PML_dux_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) &
+ + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
+ rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
+
+ duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
+ duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
+ + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
+ endif
+
+ enddo
+ enddo
+ enddo
+ endif
+
+
+ if( ispec_is_elastic(ispec) ) then
+ do k=1,NGLLZ
+ do j=1,NGLLY
+ do i=1,NGLLX
+ ! compute stress sigma
+ sigma_xx = lambdalplus2mul*duxdxl_x + lambdal*duydyl_x + lambdal*duzdzl_x
+ sigma_yx = mul*duxdyl_x + mul*duydxl_x
+ sigma_zx = mul*duzdxl_x + mul*duxdzl_x
+
+ sigma_xy = mul*duxdyl_y + mul*duydxl_y
+ sigma_yy = lambdal*duxdxl_y + lambdalplus2mul*duydyl_y + lambdal*duzdzl_y
+ sigma_zy = mul*duzdyl_y + mul*duydzl_y
+
+ sigma_xz = mul*duzdxl_z + mul*duxdzl_z
+ sigma_yz = mul*duzdyl_z + mul*duydzl_z
+ sigma_zz = lambdal*duxdxl_z + lambdal*duydyl_z + lambdalplus2mul*duzdzl_z
+
+ ! form dot product with test vector, non-symmetric form
+ tempx1(i,j,k) = jacobianl * (sigma_xx*xixl + sigma_yx*xiyl + sigma_zx*xizl) ! this goes to accel_x
+ tempy1(i,j,k) = jacobianl * (sigma_xy*xixl + sigma_yy*xiyl + sigma_zy*xizl) ! this goes to accel_y
+ tempz1(i,j,k) = jacobianl * (sigma_xz*xixl + sigma_yz*xiyl + sigma_zz*xizl) ! this goes to accel_z
+
+ tempx2(i,j,k) = jacobianl * (sigma_xx*etaxl + sigma_yx*etayl + sigma_zx*etazl) ! this goes to accel_x
+ tempy2(i,j,k) = jacobianl * (sigma_xy*etaxl + sigma_yy*etayl + sigma_zy*etazl) ! this goes to accel_y
+ tempz2(i,j,k) = jacobianl * (sigma_xz*etaxl + sigma_yz*etayl + sigma_zz*etazl) ! this goes to accel_z
+
+ tempx3(i,j,k) = jacobianl * (sigma_xx*gammaxl + sigma_yx*gammayl + sigma_zx*gammazl) ! this goes to accel_x
+ tempy3(i,j,k) = jacobianl * (sigma_xy*gammaxl + sigma_yy*gammayl + sigma_zy*gammazl) ! this goes to accel_y
+ tempz3(i,j,k) = jacobianl * (sigma_xz*gammaxl + sigma_yz*gammayl + sigma_zz*gammazl) ! this goes to accel_z
+ enddo
+ enddo
+ enddo
+ endif
+
+end subroutine pml_compute_memory_variables
+
Deleted: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_set_accel_contribution.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_set_accel_contribution.f90 2013-01-19 17:59:58 UTC (rev 21280)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_set_accel_contribution.f90 2013-01-19 18:03:21 UTC (rev 21281)
@@ -1,825 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 2 . 1
-! ---------------------------------------
-!
-! Main authors: Dimitri Komatitsch and Jeroen Tromp
-! Princeton University, USA and CNRS / INRIA / University of Pau
-! (c) Princeton University / California Institute of Technology and CNRS / INRIA / University of Pau
-! July 2012
-!
-! This program is free software; you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation; either version 2 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along
-! with this program; if not, write to the Free Software Foundation, Inc.,
-! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-!
-!=====================================================================
-!
-! United States and French Government Sponsorship Acknowledged.
-
-subroutine pml_set_accel_contribution(ispec,ispec_CPML,deltat,jacobianl,accel_elastic_CPML)
-
- ! calculates contribution from each C-PML element to update acceleration to the global mesh
-
- use specfem_par, only: ibool,wgllwgll_yz,wgllwgll_xz,wgllwgll_xy,it,kappastore
- use specfem_par_elastic, only: rho_vp,displ,veloc,ispec_is_elastic
- use specfem_par_acoustic, only: potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic,ispec_is_acoustic
- use pml_par, only: NSPEC_CPML,rmemory_displ_elastic,rmemory_potential_acoustic,CPML_regions,spec_to_CPML,alpha_store, &
- d_store_x,d_store_y,d_store_z,K_store_x,K_store_y,K_store_z,potential_dot_dot_acoustic_CPML
- use constants, only: CUSTOM_REAL,NDIM,NGLLX,NGLLY,NGLLZ
-
- implicit none
-
- integer, intent(in) :: ispec,ispec_CPML
-
- real(kind=CUSTOM_REAL), intent(in) :: deltat,jacobianl
-
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NGLLZ,NSPEC_CPML), intent(out) :: accel_elastic_CPML
-
- ! local parameters
- integer :: i,j,k,iglob
-
- real(kind=CUSTOM_REAL) :: fac1,fac2,fac3,fac4,rhol,kappal
- 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 ! for convolution of acceleration
- real(kind=CUSTOM_REAL) :: temp_A3,temp_A4,temp_A5
-
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- rhol = rho_vp(i,j,k,ispec)
- kappal = kappastore(i,j,k,ispec)
-
- iglob = ibool(i,j,k,ispec)
-
- if( CPML_regions(ispec_CPML) == 1 ) then
- !------------------------------------------------------------------------------
- !---------------------------- X-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
- end if
-
- if( ispec_is_elastic(ispec) ) then
-
- 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
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- 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
- endif
-
- !---------------------- 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
-
- fac1 = wgllwgll_yz(j,k)
- fac2 = wgllwgll_xz(i,k)
- fac3 = wgllwgll_xy(i,j)
- fac4 = sqrt(fac1 * fac2 * fac3)
-
- if( ispec_is_elastic(ispec) ) then
-
- accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
- )
- endif
-
- elseif( CPML_regions(ispec_CPML) == 2 ) then
- !------------------------------------------------------------------------------
- !---------------------------- Y-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
- end if
-
- if( ispec_is_elastic(ispec) ) then
-
- 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
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- 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
- endif
-
- !---------------------- 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
-
- fac1 = wgllwgll_yz(j,k)
- fac2 = wgllwgll_xz(i,k)
- fac3 = wgllwgll_xy(i,j)
- fac4 = sqrt(fac1 * fac2 * fac3)
-
- if( ispec_is_elastic(ispec) ) then
-
- accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
- )
- endif
-
- elseif( CPML_regions(ispec_CPML) == 3 ) 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
- end if
-
- if( ispec_is_elastic(ispec) ) then
-
- 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
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- 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
- endif
-
- !---------------------- 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
-
- fac1 = wgllwgll_yz(j,k)
- fac2 = wgllwgll_xz(i,k)
- fac3 = wgllwgll_xy(i,j)
- fac4 = sqrt(fac1 * fac2 * fac3)
-
- if( ispec_is_elastic(ispec) ) then
-
- accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
- )
- endif
-
- elseif( CPML_regions(ispec_CPML) == 4 ) 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
- end if
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- if( ispec_is_elastic(ispec) ) then
-
- 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+0.0) * deltat * coef1_2 &
- + displ(1,iglob) * (it-0.0) * 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+0.0) * deltat * coef1_2 &
- + displ(2,iglob) * (it-0.0) * 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+0.0) * deltat * coef1_2 &
- + displ(3,iglob) * (it-0.0) * deltat * coef2_2
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,3) = 0.0
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- 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+0.5)*deltat * coef1_2 &
- + potential_acoustic(iglob) * (it-0.5)*deltat * coef2_2
- rmemory_potential_acoustic(i,j,k,ispec_CPML,3)=0.0
- endif
-
- !---------------------- 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)
- if( ispec_is_elastic(ispec) ) then
- 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+0.0) * deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- elseif( ispec_is_acoustic(ispec) ) then
- 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+0.5) * deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- endif
- 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
-
- fac1 = wgllwgll_yz(j,k)
- fac2 = wgllwgll_xz(i,k)
- fac3 = wgllwgll_xy(i,j)
- fac4 = sqrt(fac1 * fac2 * fac3)
-
- if( ispec_is_elastic(ispec) ) then
-
- accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
- )
- endif
-
- elseif( CPML_regions(ispec_CPML) == 5 ) 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
- end if
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- if( ispec_is_elastic(ispec) ) then
-
- 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+0.0) * deltat * coef1_2 &
- + displ(1,iglob) * (it-0.0) * 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+0.0) * deltat * coef1_2 &
- + displ(2,iglob) * (it-0.0) * 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+0.0) * deltat * coef1_2 &
- + displ(3,iglob) * (it-0.0) * deltat * coef2_2
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,3)= 0.0
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- 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+0.5)*deltat * coef1_2 &
- + potential_acoustic(iglob) * (it-0.5)*deltat * coef2_2
- rmemory_potential_acoustic(i,j,k,ispec_CPML,3)= 0.0
- endif
-
- !---------------------- 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)
- if( ispec_is_elastic(ispec) ) then
- 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+0.0) * deltat * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- elseif( ispec_is_acoustic(ispec) ) then
- 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+0.5) * deltat * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- endif
- 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
-
- fac1 = wgllwgll_yz(j,k)
- fac2 = wgllwgll_xz(i,k)
- fac3 = wgllwgll_xy(i,j)
- fac4 = sqrt(fac1 * fac2 * fac3)
-
- if( ispec_is_elastic(ispec) ) then
-
- accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
- )
- endif
-
- elseif( CPML_regions(ispec_CPML) == 6 ) 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
- end if
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- if( ispec_is_elastic(ispec) ) then
-
- 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+0.0) * deltat * coef1_2 &
- + displ(1,iglob) * (it-0.0) * 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+0.0) * deltat * coef1_2 &
- + displ(2,iglob) * (it-0.0) * 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+0.0) * deltat * coef1_2 &
- + displ(3,iglob) * (it-0.0) * deltat * coef2_2
- rmemory_displ_elastic(3,i,j,k,ispec_CPML,3)=0.d0
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- 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+0.5)*deltat * coef1_2 &
- + potential_acoustic(iglob) * (it-0.5)*deltat * coef2_2
- rmemory_potential_acoustic(i,j,k,ispec_CPML,3)=0.d0
- endif
-
- !---------------------- 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)
- if( ispec_is_elastic(ispec) ) then
- 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+0.0) * deltat * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- elseif( ispec_is_acoustic(ispec) ) then
- 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+0.5) * deltat * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- endif
- 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
-
- fac1 = wgllwgll_yz(j,k)
- fac2 = wgllwgll_xz(i,k)
- fac3 = wgllwgll_xy(i,j)
- fac4 = sqrt(fac1 * fac2 * fac3)
-
- if( ispec_is_elastic(ispec) ) then
-
- accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
- )
- endif
-
- elseif( CPML_regions(ispec_CPML) == 7 ) 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
- end if
-
- coef0_2 = coef0_1
- coef1_2 = coef1_1
- coef2_2 = coef2_1
-
- coef0_3 = coef0_1
- coef1_3 = coef1_1
- coef2_3 = coef2_1
-
- if( ispec_is_elastic(ispec) ) then
-
- 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+0.0) * deltat * coef1_2 &
- + displ(1,iglob) * (it-0.0) * 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+0.0) * deltat)**2 * coef1_3 &
- + displ(1,iglob) * ((it-0.0) * 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+0.0) * deltat * coef1_2 &
- + displ(2,iglob) * (it-0.0) * 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+0.0) * deltat)**2 * coef1_3 &
- + displ(2,iglob) * ((it-0.0) * 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+0.0) * deltat * coef1_2 &
- + displ(3,iglob) * (it-0.0) * 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+0.0) * deltat)**2 * coef1_3 &
- + displ(3,iglob) * ((it-0.0) * deltat)**2 * coef2_3
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- 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+0.5)*deltat * coef1_2 &
- + potential_acoustic(iglob) * (it-0.5)*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+0.5)*deltat)**2 * coef1_3 &
- + potential_acoustic(iglob) * ((it-0.5)*deltat)**2 * coef2_3
- endif
-
- !---------------------- 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
-
- if( ispec_is_elastic(ispec) ) then
- 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
- elseif( ispec_is_acoustic(ispec)) then
- A3 = temp_A3 + (it+0.5)*deltat*temp_A4 !+ ((it+0.5)*deltat)**2*temp_A5
- A4 = -temp_A4 !-2.0*(it+0.5)*deltat*temp_A5
- endif
- A5 = 0.0 ! temp_A5
-
- fac1 = wgllwgll_yz(j,k)
- fac2 = wgllwgll_xz(i,k)
- fac3 = wgllwgll_xy(i,j)
- fac4 = sqrt(fac1 * fac2 * fac3)
-
- if( ispec_is_elastic(ispec) ) then
-
- accel_elastic_CPML(1,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(2,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- accel_elastic_CPML(3,i,j,k,ispec_CPML) = fac4 * 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) &
- )
-
- elseif( ispec_is_acoustic(ispec) ) then
-
- potential_dot_dot_acoustic_CPML(i,j,k,ispec_CPML) = fac4 * 1.0/kappal *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) &
- )
- endif
- endif
- enddo
- enddo
- enddo
-
-end subroutine pml_set_accel_contribution
Deleted: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_set_memory_variables.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_set_memory_variables.f90 2013-01-19 17:59:58 UTC (rev 21280)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_set_memory_variables.f90 2013-01-19 18:03:21 UTC (rev 21281)
@@ -1,2190 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 2 . 1
-! ---------------------------------------
-!
-! Main authors: Dimitri Komatitsch and Jeroen Tromp
-! Princeton University, USA and CNRS / INRIA / University of Pau
-! (c) Princeton University / California Institute of Technology and CNRS / INRIA / University of Pau
-! July 2012
-!
-! This program is free software; you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation; either version 2 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along
-! with this program; if not, write to the Free Software Foundation, Inc.,
-! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-!
-!=====================================================================
-!
-! United States and French Government Sponsorship Acknowledged.
-
-subroutine pml_set_memory_variables(ispec,ispec_CPML,deltat,jacobianl,tempx1,tempy1,tempz1,tempx2,tempy2,tempz2, &
- tempx3,tempy3,tempz3,sigma_xx,sigma_yy,sigma_zz,sigma_xy,sigma_xz,sigma_yz, &
- sigma_yx,sigma_zx,sigma_zy,lambdal,mul,lambdalplus2mul,xixl,xiyl,xizl, &
- etaxl,etayl,etazl,gammaxl,gammayl,gammazl)
-
- ! calculates C-PML elastic memory variables and computes stress sigma
-
- use specfem_par, only: it
- use specfem_par_elastic, only: ispec_is_elastic
- use specfem_par_acoustic, only: ispec_is_acoustic
- use pml_par
- use constants, only: NGLLX,NGLLY,NGLLZ
-
- implicit none
-
- integer, intent(in) :: ispec,ispec_CPML
-
- real(kind=CUSTOM_REAL), intent(in) :: lambdal,mul,lambdalplus2mul
- real(kind=CUSTOM_REAL), intent(in) :: deltat,xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl,jacobianl
-
- 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
-
- ! local parameters
- integer :: i,j,k
-
- real(kind=CUSTOM_REAL) :: sigma_xx,sigma_yy,sigma_zz,sigma_xy,sigma_xz,sigma_yz,sigma_yx,sigma_zx,sigma_zy
- 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) :: 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,A15,A16,A17 ! for convolution of strain(complex)
- real(kind=CUSTOM_REAL) :: A18,A19,A20 ! for convolution of strain(simple)
-
- if( CPML_regions(ispec_CPML) == 1 ) then
-
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
-
- !------------------------------------------------------------------------------
- !---------------------------- X-surface C-PML ---------------------------------
- !------------------------------------------------------------------------------
-
- !---------------------- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_2
-
- duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
- duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
- duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dpotential_dxl(i,j,k,ispec_CPML) * coef2_2
-
- dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2)
- 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
-
- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
- duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
- duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dpotential_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = 0.d0
-
- dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2)
- 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
-
- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
- duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
- duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dpotential_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = 0.d0
-
- dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
- endif
-
- if( ispec_is_elastic(ispec) ) then
- !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) &
- + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) &
- + PML_duz_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
- duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
-
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) &
- + PML_duy_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) &
- + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
- duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
-
-
- !---------------------- A17 and A18 --------------------------
- A17 = 1.d0
- A18 = 0.0
-
- rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
- duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
- duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
-
-
- !---------------------- A19 and A20 --------------------------
- A19 = 1.d0
- A20 = 0.0
-
- rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
- duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
- duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
- endif
-
- enddo
- enddo
- enddo
- endif
-
- if( CPML_regions(ispec_CPML) == 2 ) then
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- !------------------------------------------------------------------------------
- !---------------------------- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
- duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
- duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dpotential_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = 0.d0
-
- dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2)
- endif
-
- !---------------------- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_2
-
- duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
- duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
- duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dpotential_dyl(i,j,k,ispec_CPML) * coef2_2
-
- dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2)
- endif
-
- !---------------------- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
- duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
- duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dpotential_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = 0.d0
-
- dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
- endif
-
- if( ispec_is_elastic(ispec) ) then
- !---------------------- A15 and A16 --------------------------
- A15 = 1.d0
- A16 = 0.d0
-
- rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
- duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
-
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
- duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
-
- !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) &
- + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) &
- + PML_duz_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
- duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) &
- + PML_dux_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) &
- + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
- duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
-
-
- !---------------------- A19 and A20--------------------------
- A19 = 1.d0
- A20 = 0.0
-
- rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
- duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
- duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
- endif
-
- enddo
- enddo
- enddo
- endif
-
- if( CPML_regions(ispec_CPML) == 3 ) then
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
-
- !------------------------------------------------------------------------------
- !---------------------------- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
- duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
- duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dpotential_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = 0.d0
-
- dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2)
- endif
-
- !---------------------- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
- duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
- duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dpotential_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = 0.d0
-
- dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2)
- endif
-
- !---------------------- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_2
-
- duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
- duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
- duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dpotential_dzl(i,j,k,ispec_CPML) * coef2_2
-
- dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
- endif
-
- if( ispec_is_elastic(ispec) ) then
- !---------------------- A15 and A16 --------------------------
- A15 = 1.d0
- A16 = 0.d0
-
- rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
- duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
-
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
- duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
-
- !---------------------- A17 and A18 --------------------------
- A17 = 1.d0
- A18 = 0.d0
-
- rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
- duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
- duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
-
- !---------------------- 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,1) = coef0_1 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) &
- + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) &
- + PML_duy_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
- duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) &
- + PML_dux_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) &
- + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
- duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
- endif
-
- enddo
- enddo
- enddo
- endif
-
- if( CPML_regions(ispec_CPML) == 4 ) then
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
-
- !------------------------------------------------------------------------------
- !---------------------------- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_2
-
- duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
- duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
- duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dpotential_dxl(i,j,k,ispec_CPML) * coef2_2
-
- dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2)
- 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)
-
- 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( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_2
-
- duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
- duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
- duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dpotential_dyl(i,j,k,ispec_CPML) * coef2_2
-
- dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2)
- endif
-
- !---------------------- A12, A13 and A14 --------------------------
- A12 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML)
- if( ispec_is_elastic(ispec) ) then
- 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+0.0) * deltat * d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)
- else if( ispec_is_acoustic(ispec) ) then
- 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+0.5)*deltat*d_store_x(i,j,k,ispec_CPML)*d_store_y(i,j,k,ispec_CPML)
- endif
- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_dux_dzl(i,j,k,ispec_CPML) * (it-0.0) * 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,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_duy_dzl(i,j,k,ispec_CPML) * (it-0.0) * 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,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_duz_dzl(i,j,k,ispec_CPML) * (it-0.0) * deltat * coef2_2
-
- duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
- duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
- duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dpotential_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) *(it+0.5)*deltat * coef1_2 &
- + PML_dpotential_dzl(i,j,k,ispec_CPML) *(it-0.5)*deltat * coef2_2
-
- dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
- endif
-
- if( ispec_is_elastic(ispec) ) then
- !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) &
- + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) &
- + PML_duz_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
- duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
-
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) &
- + PML_duy_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) &
- + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
- duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
-
- !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) &
- + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) &
- + PML_duz_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
- duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) &
- + PML_dux_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) &
- + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
- duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
-
- !---------------------- A19 and A20--------------------------
- A19 = 1.d0
- A20 = 0.0
-
- rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
- duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
- duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
- endif
-
- enddo
- enddo
- enddo
- endif
-
- if(CPML_regions(ispec_CPML)==5) then
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
-
- !------------------------------------------------------------------------------
- !---------------------------- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_2
-
- duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
- duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
- duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dpotential_dxl(i,j,k,ispec_CPML) * coef2_2
-
- dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2)
- endif
-
- !---------------------- A9, A10 and A11 --------------------------
- A9 = k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML)
- if( ispec_is_elastic(ispec) ) then
- 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+0.0) * deltat * d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- else if( ispec_is_acoustic(ispec) ) then
- 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+0.5)*deltat*d_store_x(i,j,k,ispec_CPML)*d_store_z(i,j,k,ispec_CPML)
- endif
- 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
-
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * coef2_1
- 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_dux_dyl(i,j,k,ispec_CPML) * (it-0.0) * 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,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
- 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_duy_dyl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
- 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_duz_dyl(i,j,k,ispec_CPML) * (it-0.0) * deltat * coef2_2
-
- duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
- duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
- duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dpotential_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) *(it+0.5)*deltat* coef1_2 &
- + PML_dpotential_dyl(i,j,k,ispec_CPML) *(it-0.5)*deltat* coef2_2
-
- dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2)
- 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
-
- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_2
-
- duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
- duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
- duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dpotential_dzl(i,j,k,ispec_CPML) * coef2_2
-
- dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
- endif
-
- if( ispec_is_elastic(ispec) ) then
- !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) &
- + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) &
- + PML_duz_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
- duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
-
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) &
- + PML_duy_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) &
- + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
- duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
-
- !---------------------- A17 and A18 --------------------------
- A17 = 1.0d0
- A18 = 0.d0
-
- rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
- duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
- duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
-
- !---------------------- 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,1) = coef0_1 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) &
- + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) &
- + PML_duy_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
- duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) &
- + PML_dux_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) &
- + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
- duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
- endif
-
- enddo
- enddo
- enddo
- endif
-
- if( CPML_regions(ispec_CPML) == 6 ) then
-
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- !------------------------------------------------------------------------------
- !---------------------------- 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)
- if( ispec_is_elastic(ispec) ) then
- 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+0.0) * deltat * d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)
- else if( ispec_is_acoustic(ispec) ) then
- 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+0.5)*deltat*d_store_y(i,j,k,ispec_CPML)*d_store_z(i,j,k,ispec_CPML)
- endif
- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_dux_dxl(i,j,k,ispec_CPML) * (it-0.0) * 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,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_duy_dxl(i,j,k,ispec_CPML) * (it-0.0) * 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,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_duz_dxl(i,j,k,ispec_CPML) * (it-0.0) * deltat * coef2_2
-
- duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
- duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
- duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dpotential_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.5)*deltat* coef1_2 &
- + PML_dpotential_dxl(i,j,k,ispec_CPML) *(it-0.5)*deltat* coef2_2
-
- dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2)
- endif
-
- !---------------------- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_2
-
- duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
- duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
- duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dpotential_dyl(i,j,k,ispec_CPML) * coef2_2
-
- dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2)
- endif
-
- !---------------------- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_2
-
- duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
- duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
- duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_2 + PML_dpotential_dzl(i,j,k,ispec_CPML) * coef2_2
-
- dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
- endif
-
- if( ispec_is_elastic(ispec) ) then
- !---------------------- A15 and A16 --------------------------
- A15 = 1.0d0
- A16 = 0.0d0
-
- rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
- duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
-
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = 0.d0
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
- duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
-
- !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) &
- + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) &
- + PML_duz_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
- duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) &
- + PML_dux_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) &
- + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
- duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
-
- !---------------------- 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,1) = coef0_1 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) &
- + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) &
- + PML_duy_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
- duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) &
- + PML_dux_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) &
- + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
- duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
- endif
-
- enddo
- enddo
- enddo
- endif
-
- if( CPML_regions(ispec_CPML) == 7 ) then
-
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- !------------------------------------------------------------------------------
- !---------------------------- 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)) .gt. 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
- if( ispec_is_elastic(ispec) ) then
- 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+0.0)*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)
- else if( ispec_is_acoustic(ispec) ) then
- 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+0.5)*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)
- endif
- 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
-
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
-
- if( abs(d_store_x(i,j,k,ispec_CPML)) .gt. 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,ispec_CPML) * coef1_2 + PML_dux_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_dux_dxl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_duy_dxl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_duz_dxl(i,j,k,ispec_CPML) * (it-0.0)*deltat * coef2_2
- endif
-
- duxdxl_x = A6 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,1) + A8 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2)
- duydxl_y = A6 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,1) + A8 * rmemory_duy_dxl_y(i,j,k,ispec_CPML,2)
- duzdxl_z = A6 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,1) + A8 * rmemory_duz_dxl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dpotential_dxl(i,j,k,ispec_CPML) * coef2_1
-
- if(abs(d_store_x(i,j,k,ispec_CPML)).gt. 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,ispec_CPML) * coef1_2 + PML_dpotential_dxl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.5)*deltat* coef1_2 &
- + PML_dpotential_dxl(i,j,k,ispec_CPML) * (it-0.5)*deltat* coef2_2
- endif
-
- dpotentialdxl = A6 * PML_dpotential_dxl(i,j,k,ispec_CPML) &
- + A7 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,1) + A8 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,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)) .gt. 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
- if( ispec_is_elastic(ispec) ) then
- 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+0.0)*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)
- else if( ispec_is_acoustic(ispec) ) then
- 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+0.5)*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)
- endif
- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
-
- if( abs(d_store_y(i,j,k,ispec_CPML)) .gt. 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,ispec_CPML) * coef1_2 + PML_dux_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_dux_dyl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_duy_dyl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_duz_dyl(i,j,k,ispec_CPML) * (it-0.0)*deltat * coef2_2
- endif
-
- duxdyl_x = A9 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,1) + A11 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2)
- duydyl_y = A9 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,1) + A11 * rmemory_duy_dyl_y(i,j,k,ispec_CPML,2)
- duzdyl_z = A9 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,1) + A11 * rmemory_duz_dyl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
- 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,ispec_CPML) * coef1_1 + PML_dpotential_dyl(i,j,k,ispec_CPML) * coef2_1
-
- if(abs(d_store_y(i,j,k,ispec_CPML)).gt. 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,ispec_CPML) * coef1_2 + PML_dpotential_dyl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.5)*deltat* coef1_2 &
- + PML_dpotential_dyl(i,j,k,ispec_CPML) * (it-0.5)*deltat* coef2_2
- endif
-
- dpotentialdyl = A9 * PML_dpotential_dyl(i,j,k,ispec_CPML) &
- + A10 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,1) + A11 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,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)) .gt. 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
- if( ispec_is_elastic(ispec) ) then
- 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+0.0)*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)
- else if( ispec_is_acoustic(ispec) ) then
- 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+0.5)*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)
- endif
- 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
-
- if( ispec_is_elastic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
-
- if( abs(d_store_z(i,j,k,ispec_CPML)) .gt. 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,ispec_CPML) * coef1_2 + PML_dux_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duy_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * coef1_2 + PML_duz_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_dux_dzl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_duy_dzl(i,j,k,ispec_CPML) * (it-0.0)*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,ispec_CPML) * (it+0.0) * deltat * coef1_2 &
- + PML_duz_dzl(i,j,k,ispec_CPML) * (it-0.0)*deltat * coef2_2
- endif
-
- duxdzl_x = A12 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,1) + A14 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2)
- duydzl_y = A12 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,1) + A14 * rmemory_duy_dzl_y(i,j,k,ispec_CPML,2)
- duzdzl_z = A12 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,1) + A14 * rmemory_duz_dzl_z(i,j,k,ispec_CPML,2)
-
- else if( ispec_is_acoustic(ispec) ) then
-
- 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,ispec_CPML) * coef1_1 + PML_dpotential_dzl(i,j,k,ispec_CPML) * coef2_1
-
- if(abs(d_store_z(i,j,k,ispec_CPML)).gt. 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,ispec_CPML) * coef1_2 + PML_dpotential_dzl(i,j,k,ispec_CPML) * 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,ispec_CPML) * (it+0.5)*deltat* coef1_2 &
- + PML_dpotential_dzl(i,j,k,ispec_CPML) * (it-0.5)*deltat* coef2_2
- endif
-
- dpotentialdzl = A12 * PML_dpotential_dzl(i,j,k,ispec_CPML) &
- + A13 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,1) + A14 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2)
- endif
-
- if( ispec_is_elastic(ispec) ) then
- !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) &
- + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dzl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) &
- + PML_duz_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_y = A15 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dzl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_y(i,j,k,ispec_CPML,2)
- duzdyl_y = A15 * PML_duz_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duz_dyl_y(i,j,k,ispec_CPML,1) + rmemory_duz_dyl_y(i,j,k,ispec_CPML,2)
-
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) &
- + PML_duy_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) &
- + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dyl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duydzl_z = A15 * PML_duy_dzl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dzl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dzl_z(i,j,k,ispec_CPML,2)
- duydyl_z = A15 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A16 * rmemory_duy_dyl_z(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_z(i,j,k,ispec_CPML,2)
-
- !---------------------- 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,1) = coef0_1 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) &
- + PML_duz_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dzl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) &
- + PML_duz_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duz_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duz_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duzdzl_x = A17 * PML_duz_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dzl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dzl_x(i,j,k,ispec_CPML,2)
- duzdxl_x = A17 * PML_duz_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_duz_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duz_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) &
- + PML_dux_dzl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dzl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dzl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) &
- + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dxl_z(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdzl_z = A17 * PML_dux_dzl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dzl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dzl_z(i,j,k,ispec_CPML,2)
- duxdxl_z = A17 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
-
- !---------------------- 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,1) = coef0_1 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) &
- + PML_duy_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dyl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) &
- + PML_duy_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_duy_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_duy_dxl_x(i,j,k,ispec_CPML,2) = 0.d0
-
- duydyl_x = A19 * PML_duy_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dyl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dyl_x(i,j,k,ispec_CPML,2)
- duydxl_x = A19 * PML_duy_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_duy_dxl_x(i,j,k,ispec_CPML,1) + rmemory_duy_dxl_x(i,j,k,ispec_CPML,2)
-
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) &
- + PML_dux_dyl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dyl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dyl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) = coef0_1 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) &
- + PML_dux_dxl_new(i,j,k,ispec_CPML) * coef1_1 + PML_dux_dxl(i,j,k,ispec_CPML) * coef2_1
- rmemory_dux_dxl_y(i,j,k,ispec_CPML,2) = 0.d0
-
- duxdyl_y = A19 * PML_dux_dyl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dyl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dyl_y(i,j,k,ispec_CPML,2)
- duxdxl_y = A19 * PML_dux_dxl(i,j,k,ispec_CPML) &
- + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
- endif
-
- enddo
- enddo
- enddo
- endif
-
-
- if( ispec_is_elastic(ispec) ) then
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- ! compute stress sigma
- sigma_xx = lambdalplus2mul*duxdxl_x + lambdal*duydyl_x + lambdal*duzdzl_x
- sigma_yx = mul*duxdyl_x + mul*duydxl_x
- sigma_zx = mul*duzdxl_x + mul*duxdzl_x
-
- sigma_xy = mul*duxdyl_y + mul*duydxl_y
- sigma_yy = lambdal*duxdxl_y + lambdalplus2mul*duydyl_y + lambdal*duzdzl_y
- sigma_zy = mul*duzdyl_y + mul*duydzl_y
-
- sigma_xz = mul*duzdxl_z + mul*duxdzl_z
- sigma_yz = mul*duzdyl_z + mul*duydzl_z
- sigma_zz = lambdal*duxdxl_z + lambdal*duydyl_z + lambdalplus2mul*duzdzl_z
-
- ! form dot product with test vector, non-symmetric form
- tempx1(i,j,k) = jacobianl * (sigma_xx*xixl + sigma_yx*xiyl + sigma_zx*xizl) ! this goes to accel_x
- tempy1(i,j,k) = jacobianl * (sigma_xy*xixl + sigma_yy*xiyl + sigma_zy*xizl) ! this goes to accel_y
- tempz1(i,j,k) = jacobianl * (sigma_xz*xixl + sigma_yz*xiyl + sigma_zz*xizl) ! this goes to accel_z
-
- tempx2(i,j,k) = jacobianl * (sigma_xx*etaxl + sigma_yx*etayl + sigma_zx*etazl) ! this goes to accel_x
- tempy2(i,j,k) = jacobianl * (sigma_xy*etaxl + sigma_yy*etayl + sigma_zy*etazl) ! this goes to accel_y
- tempz2(i,j,k) = jacobianl * (sigma_xz*etaxl + sigma_yz*etayl + sigma_zz*etazl) ! this goes to accel_z
-
- tempx3(i,j,k) = jacobianl * (sigma_xx*gammaxl + sigma_yx*gammayl + sigma_zx*gammazl) ! this goes to accel_x
- tempy3(i,j,k) = jacobianl * (sigma_xy*gammaxl + sigma_yy*gammayl + sigma_zy*gammazl) ! this goes to accel_y
- tempz3(i,j,k) = jacobianl * (sigma_xz*gammaxl + sigma_yz*gammayl + sigma_zz*gammazl) ! this goes to accel_z
- enddo
- enddo
- enddo
- endif
-
-end subroutine pml_set_memory_variables
-
More information about the CIG-COMMITS
mailing list