[cig-commits] r21479 - in seismo/3D/SPECFEM3D/trunk/src: cuda decompose_mesh generate_databases shared specfem3D
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Fri Mar 8 17:15:51 PST 2013
Author: dkomati1
Date: 2013-03-08 17:15:50 -0800 (Fri, 08 Mar 2013)
New Revision: 21479
Modified:
seismo/3D/SPECFEM3D/trunk/src/cuda/compute_forces_viscoelastic_cuda.cu
seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/decompose_mesh.F90
seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/fault_scotch.f90
seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/part_decompose_mesh.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_mass_matrices.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/fault_generate_databases.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases_par.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_absorbing_boundary.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_global.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_model.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/memory_eval.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_tomography.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/pml_set_local_dampingcoeff.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/read_partition_files.f90
seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in
seismo/3D/SPECFEM3D/trunk/src/shared/force_ftz.c
seismo/3D/SPECFEM3D/trunk/src/shared/get_attenuation_model.f90
seismo/3D/SPECFEM3D/trunk/src/shared/get_force.f90
seismo/3D/SPECFEM3D/trunk/src/shared/read_parameter_file.f90
seismo/3D/SPECFEM3D/trunk/src/shared/read_value_parameters.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/assemble_MPI_vector.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_viscoelastic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_poroelastic_el.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_viscoelastic_po.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_noDev.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_Dev.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_dynamic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_kinematic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/finalize_simulation.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/iterate_time.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_source.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/model_update.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/noise_tomography.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_allocate_arrays.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_accel_contribution.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_memory_variables.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_output_VTKs.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_par.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_sources_receivers.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D_par.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_seismograms.f90
Log:
Zhinan Xie added support for Qkappa;
also removed useless white spaces in all routines
Modified: seismo/3D/SPECFEM3D/trunk/src/cuda/compute_forces_viscoelastic_cuda.cu
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/cuda/compute_forces_viscoelastic_cuda.cu 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/cuda/compute_forces_viscoelastic_cuda.cu 2013-03-09 01:15:50 UTC (rev 21479)
@@ -656,7 +656,7 @@
int* d_phase_ispec_inner_elastic, int num_phase_ispec_elastic,
int d_iphase,
int use_mesh_coloring_gpu,
- realw d_deltat,
+ realw d_deltat,
realw* d_displ,realw* d_veloc,realw* d_accel,
realw* d_xix, realw* d_xiy, realw* d_xiz,
realw* d_etax, realw* d_etay, realw* d_etaz,
@@ -801,7 +801,7 @@
// JC JC here we will need to add GPU support for the new C-PML routines
if(ATTENUATION){
- // use first order Taylor expansion of displacement for local storage of stresses
+ // use first order Taylor expansion of displacement for local storage of stresses
// at this current time step, to fix attenuation in a consistent way
#ifdef USE_TEXTURES_FIELDS
s_dummyx_loc_att[tx] = s_dummyx_loc[tx] + d_deltat * tex1Dfetch(d_veloc_tex, iglob);
@@ -882,23 +882,23 @@
tempz3l_att = 0.f;
for (l=0;l<NGLLX;l++) {
- hp1 = sh_hprime_xx[l*NGLLX+I];
- offset = K*NGLL2+J*NGLLX+l;
- tempx1l_att += s_dummyx_loc_att[offset]*hp1;
- tempy1l_att += s_dummyy_loc_att[offset]*hp1;
- tempz1l_att += s_dummyz_loc_att[offset]*hp1;
+ hp1 = sh_hprime_xx[l*NGLLX+I];
+ offset = K*NGLL2+J*NGLLX+l;
+ tempx1l_att += s_dummyx_loc_att[offset]*hp1;
+ tempy1l_att += s_dummyy_loc_att[offset]*hp1;
+ tempz1l_att += s_dummyz_loc_att[offset]*hp1;
- hp2 = sh_hprime_xx[l*NGLLX+J];
- offset = K*NGLL2+l*NGLLX+I;
- tempx2l_att += s_dummyx_loc_att[offset]*hp2;
- tempy2l_att += s_dummyy_loc_att[offset]*hp2;
- tempz2l_att += s_dummyz_loc_att[offset]*hp2;
+ hp2 = sh_hprime_xx[l*NGLLX+J];
+ offset = K*NGLL2+l*NGLLX+I;
+ tempx2l_att += s_dummyx_loc_att[offset]*hp2;
+ tempy2l_att += s_dummyy_loc_att[offset]*hp2;
+ tempz2l_att += s_dummyz_loc_att[offset]*hp2;
- hp3 = sh_hprime_xx[l*NGLLX+K];
- offset = l*NGLL2+J*NGLLX+I;
- tempx3l_att += s_dummyx_loc_att[offset]*hp3;
- tempy3l_att += s_dummyy_loc_att[offset]*hp3;
- tempz3l_att += s_dummyz_loc_att[offset]*hp3;
+ hp3 = sh_hprime_xx[l*NGLLX+K];
+ offset = l*NGLL2+J*NGLLX+I;
+ tempx3l_att += s_dummyx_loc_att[offset]*hp3;
+ tempy3l_att += s_dummyy_loc_att[offset]*hp3;
+ tempz3l_att += s_dummyz_loc_att[offset]*hp3;
}
}
@@ -964,58 +964,58 @@
// temporary variables used for fixing attenuation in a consistent way
tempx1l_att = s_dummyx_loc_att[K*NGLL2+J*NGLLX]*d_hprime_xx[I]
- + s_dummyx_loc_att[K*NGLL2+J*NGLLX+1]*d_hprime_xx[NGLLX+I]
- + s_dummyx_loc_att[K*NGLL2+J*NGLLX+2]*d_hprime_xx[2*NGLLX+I]
- + s_dummyx_loc_att[K*NGLL2+J*NGLLX+3]*d_hprime_xx[3*NGLLX+I]
- + s_dummyx_loc_att[K*NGLL2+J*NGLLX+4]*d_hprime_xx[4*NGLLX+I];
+ + s_dummyx_loc_att[K*NGLL2+J*NGLLX+1]*d_hprime_xx[NGLLX+I]
+ + s_dummyx_loc_att[K*NGLL2+J*NGLLX+2]*d_hprime_xx[2*NGLLX+I]
+ + s_dummyx_loc_att[K*NGLL2+J*NGLLX+3]*d_hprime_xx[3*NGLLX+I]
+ + s_dummyx_loc_att[K*NGLL2+J*NGLLX+4]*d_hprime_xx[4*NGLLX+I];
tempy1l_att = s_dummyy_loc_att[K*NGLL2+J*NGLLX]*d_hprime_xx[I]
- + s_dummyy_loc_att[K*NGLL2+J*NGLLX+1]*d_hprime_xx[NGLLX+I]
- + s_dummyy_loc_att[K*NGLL2+J*NGLLX+2]*d_hprime_xx[2*NGLLX+I]
- + s_dummyy_loc_att[K*NGLL2+J*NGLLX+3]*d_hprime_xx[3*NGLLX+I]
- + s_dummyy_loc_att[K*NGLL2+J*NGLLX+4]*d_hprime_xx[4*NGLLX+I];
+ + s_dummyy_loc_att[K*NGLL2+J*NGLLX+1]*d_hprime_xx[NGLLX+I]
+ + s_dummyy_loc_att[K*NGLL2+J*NGLLX+2]*d_hprime_xx[2*NGLLX+I]
+ + s_dummyy_loc_att[K*NGLL2+J*NGLLX+3]*d_hprime_xx[3*NGLLX+I]
+ + s_dummyy_loc_att[K*NGLL2+J*NGLLX+4]*d_hprime_xx[4*NGLLX+I];
tempz1l_att = s_dummyz_loc_att[K*NGLL2+J*NGLLX]*d_hprime_xx[I]
- + s_dummyz_loc_att[K*NGLL2+J*NGLLX+1]*d_hprime_xx[NGLLX+I]
- + s_dummyz_loc_att[K*NGLL2+J*NGLLX+2]*d_hprime_xx[2*NGLLX+I]
- + s_dummyz_loc_att[K*NGLL2+J*NGLLX+3]*d_hprime_xx[3*NGLLX+I]
- + s_dummyz_loc_att[K*NGLL2+J*NGLLX+4]*d_hprime_xx[4*NGLLX+I];
+ + s_dummyz_loc_att[K*NGLL2+J*NGLLX+1]*d_hprime_xx[NGLLX+I]
+ + s_dummyz_loc_att[K*NGLL2+J*NGLLX+2]*d_hprime_xx[2*NGLLX+I]
+ + s_dummyz_loc_att[K*NGLL2+J*NGLLX+3]*d_hprime_xx[3*NGLLX+I]
+ + s_dummyz_loc_att[K*NGLL2+J*NGLLX+4]*d_hprime_xx[4*NGLLX+I];
tempx2l_att = s_dummyx_loc_att[K*NGLL2+I]*d_hprime_xx[J]
- + s_dummyx_loc_att[K*NGLL2+NGLLX+I]*d_hprime_xx[NGLLX+J]
- + s_dummyx_loc_att[K*NGLL2+2*NGLLX+I]*d_hprime_xx[2*NGLLX+J]
- + s_dummyx_loc_att[K*NGLL2+3*NGLLX+I]*d_hprime_xx[3*NGLLX+J]
- + s_dummyx_loc_att[K*NGLL2+4*NGLLX+I]*d_hprime_xx[4*NGLLX+J];
+ + s_dummyx_loc_att[K*NGLL2+NGLLX+I]*d_hprime_xx[NGLLX+J]
+ + s_dummyx_loc_att[K*NGLL2+2*NGLLX+I]*d_hprime_xx[2*NGLLX+J]
+ + s_dummyx_loc_att[K*NGLL2+3*NGLLX+I]*d_hprime_xx[3*NGLLX+J]
+ + s_dummyx_loc_att[K*NGLL2+4*NGLLX+I]*d_hprime_xx[4*NGLLX+J];
tempy2l_att = s_dummyy_loc_att[K*NGLL2+I]*d_hprime_xx[J]
- + s_dummyy_loc_att[K*NGLL2+NGLLX+I]*d_hprime_xx[NGLLX+J]
- + s_dummyy_loc_att[K*NGLL2+2*NGLLX+I]*d_hprime_xx[2*NGLLX+J]
- + s_dummyy_loc_att[K*NGLL2+3*NGLLX+I]*d_hprime_xx[3*NGLLX+J]
- + s_dummyy_loc_att[K*NGLL2+4*NGLLX+I]*d_hprime_xx[4*NGLLX+J];
+ + s_dummyy_loc_att[K*NGLL2+NGLLX+I]*d_hprime_xx[NGLLX+J]
+ + s_dummyy_loc_att[K*NGLL2+2*NGLLX+I]*d_hprime_xx[2*NGLLX+J]
+ + s_dummyy_loc_att[K*NGLL2+3*NGLLX+I]*d_hprime_xx[3*NGLLX+J]
+ + s_dummyy_loc_att[K*NGLL2+4*NGLLX+I]*d_hprime_xx[4*NGLLX+J];
tempz2l_att = s_dummyz_loc_att[K*NGLL2+I]*d_hprime_xx[J]
- + s_dummyz_loc_att[K*NGLL2+NGLLX+I]*d_hprime_xx[NGLLX+J]
- + s_dummyz_loc_att[K*NGLL2+2*NGLLX+I]*d_hprime_xx[2*NGLLX+J]
- + s_dummyz_loc_att[K*NGLL2+3*NGLLX+I]*d_hprime_xx[3*NGLLX+J]
- + s_dummyz_loc_att[K*NGLL2+4*NGLLX+I]*d_hprime_xx[4*NGLLX+J];
+ + s_dummyz_loc_att[K*NGLL2+NGLLX+I]*d_hprime_xx[NGLLX+J]
+ + s_dummyz_loc_att[K*NGLL2+2*NGLLX+I]*d_hprime_xx[2*NGLLX+J]
+ + s_dummyz_loc_att[K*NGLL2+3*NGLLX+I]*d_hprime_xx[3*NGLLX+J]
+ + s_dummyz_loc_att[K*NGLL2+4*NGLLX+I]*d_hprime_xx[4*NGLLX+J];
tempx3l_att = s_dummyx_loc_att[J*NGLLX+I]*d_hprime_xx[K]
- + s_dummyx_loc_att[NGLL2+J*NGLLX+I]*d_hprime_xx[NGLLX+K]
- + s_dummyx_loc_att[2*NGLL2+J*NGLLX+I]*d_hprime_xx[2*NGLLX+K]
- + s_dummyx_loc_att[3*NGLL2+J*NGLLX+I]*d_hprime_xx[3*NGLLX+K]
- + s_dummyx_loc_att[4*NGLL2+J*NGLLX+I]*d_hprime_xx[4*NGLLX+K];
+ + s_dummyx_loc_att[NGLL2+J*NGLLX+I]*d_hprime_xx[NGLLX+K]
+ + s_dummyx_loc_att[2*NGLL2+J*NGLLX+I]*d_hprime_xx[2*NGLLX+K]
+ + s_dummyx_loc_att[3*NGLL2+J*NGLLX+I]*d_hprime_xx[3*NGLLX+K]
+ + s_dummyx_loc_att[4*NGLL2+J*NGLLX+I]*d_hprime_xx[4*NGLLX+K];
tempy3l_att = s_dummyy_loc_att[J*NGLLX+I]*d_hprime_xx[K]
- + s_dummyy_loc_att[NGLL2+J*NGLLX+I]*d_hprime_xx[NGLLX+K]
- + s_dummyy_loc_att[2*NGLL2+J*NGLLX+I]*d_hprime_xx[2*NGLLX+K]
- + s_dummyy_loc_att[3*NGLL2+J*NGLLX+I]*d_hprime_xx[3*NGLLX+K]
- + s_dummyy_loc_att[4*NGLL2+J*NGLLX+I]*d_hprime_xx[4*NGLLX+K];
+ + s_dummyy_loc_att[NGLL2+J*NGLLX+I]*d_hprime_xx[NGLLX+K]
+ + s_dummyy_loc_att[2*NGLL2+J*NGLLX+I]*d_hprime_xx[2*NGLLX+K]
+ + s_dummyy_loc_att[3*NGLL2+J*NGLLX+I]*d_hprime_xx[3*NGLLX+K]
+ + s_dummyy_loc_att[4*NGLL2+J*NGLLX+I]*d_hprime_xx[4*NGLLX+K];
tempz3l_att = s_dummyz_loc_att[J*NGLLX+I]*d_hprime_xx[K]
- + s_dummyz_loc_att[NGLL2+J*NGLLX+I]*d_hprime_xx[NGLLX+K]
- + s_dummyz_loc_att[2*NGLL2+J*NGLLX+I]*d_hprime_xx[2*NGLLX+K]
- + s_dummyz_loc_att[3*NGLL2+J*NGLLX+I]*d_hprime_xx[3*NGLLX+K]
- + s_dummyz_loc_att[4*NGLL2+J*NGLLX+I]*d_hprime_xx[4*NGLLX+K];
+ + s_dummyz_loc_att[NGLL2+J*NGLLX+I]*d_hprime_xx[NGLLX+K]
+ + s_dummyz_loc_att[2*NGLL2+J*NGLLX+I]*d_hprime_xx[2*NGLLX+K]
+ + s_dummyz_loc_att[3*NGLL2+J*NGLLX+I]*d_hprime_xx[3*NGLLX+K]
+ + s_dummyz_loc_att[4*NGLL2+J*NGLLX+I]*d_hprime_xx[4*NGLLX+K];
}
#endif
@@ -1078,42 +1078,42 @@
// computes deviatoric strain attenuation and/or for kernel calculations
if(COMPUTE_AND_STORE_STRAIN) {
- realw templ = 0.33333333333333333333f * (duxdxl_att + duydyl_att + duzdzl_att); // 1./3. = 0.33333
+ realw templ = 0.33333333333333333333f * (duxdxl_att + duydyl_att + duzdzl_att); // 1./3. = 0.33333
- // local storage: stresses at this current time step
- epsilondev_xx_loc = duxdxl_att - templ;
- epsilondev_yy_loc = duydyl_att - templ;
- epsilondev_xy_loc = 0.5f * duxdyl_plus_duydxl_att;
- epsilondev_xz_loc = 0.5f * duzdxl_plus_duxdzl_att;
- epsilondev_yz_loc = 0.5f * duzdyl_plus_duydzl_att;
+ // local storage: stresses at this current time step
+ epsilondev_xx_loc = duxdxl_att - templ;
+ epsilondev_yy_loc = duydyl_att - templ;
+ epsilondev_xy_loc = 0.5f * duxdyl_plus_duydxl_att;
+ epsilondev_xz_loc = 0.5f * duzdxl_plus_duxdzl_att;
+ epsilondev_yz_loc = 0.5f * duzdyl_plus_duydzl_att;
- if(SIMULATION_TYPE == 3) {
- epsilon_trace_over_3[tx + working_element*NGLL3] = templ;
- }
-
- // JC JC here we will need to add GPU support for the new C-PML routines
+ if(SIMULATION_TYPE == 3) {
+ epsilon_trace_over_3[tx + working_element*NGLL3] = templ;
+ }
+
+ // JC JC here we will need to add GPU support for the new C-PML routines
}
}else{
// computes deviatoric strain attenuation and/or for kernel calculations
if(COMPUTE_AND_STORE_STRAIN) {
- realw templ = 0.33333333333333333333f * (duxdxl + duydyl + duzdzl); // 1./3. = 0.33333
- /*
- epsilondev_xx[offset] = duxdxl - templ;
- epsilondev_yy[offset] = duydyl - templ;
- epsilondev_xy[offset] = 0.5f * duxdyl_plus_duydxl;
- epsilondev_xz[offset] = 0.5f * duzdxl_plus_duxdzl;
- epsilondev_yz[offset] = 0.5f * duzdyl_plus_duydzl;
- */
- // local storage: stresses at this current time step
- epsilondev_xx_loc = duxdxl - templ;
- epsilondev_yy_loc = duydyl - templ;
- epsilondev_xy_loc = 0.5f * duxdyl_plus_duydxl;
- epsilondev_xz_loc = 0.5f * duzdxl_plus_duxdzl;
- epsilondev_yz_loc = 0.5f * duzdyl_plus_duydzl;
+ realw templ = 0.33333333333333333333f * (duxdxl + duydyl + duzdzl); // 1./3. = 0.33333
+ /*
+ epsilondev_xx[offset] = duxdxl - templ;
+ epsilondev_yy[offset] = duydyl - templ;
+ epsilondev_xy[offset] = 0.5f * duxdyl_plus_duydxl;
+ epsilondev_xz[offset] = 0.5f * duzdxl_plus_duxdzl;
+ epsilondev_yz[offset] = 0.5f * duzdyl_plus_duydzl;
+ */
+ // local storage: stresses at this current time step
+ epsilondev_xx_loc = duxdxl - templ;
+ epsilondev_yy_loc = duydyl - templ;
+ epsilondev_xy_loc = 0.5f * duxdyl_plus_duydxl;
+ epsilondev_xz_loc = 0.5f * duzdxl_plus_duxdzl;
+ epsilondev_yz_loc = 0.5f * duzdyl_plus_duydzl;
- if(SIMULATION_TYPE == 3) {
- epsilon_trace_over_3[tx + working_element*NGLL3] = templ;
- }
+ if(SIMULATION_TYPE == 3) {
+ epsilon_trace_over_3[tx + working_element*NGLL3] = templ;
+ }
}
}
@@ -1512,7 +1512,7 @@
mp->num_phase_ispec_elastic,
d_iphase,
mp->use_mesh_coloring_gpu,
- d_deltat,
+ d_deltat,
mp->d_displ,mp->d_veloc,mp->d_accel,
d_xix, d_xiy, d_xiz,
d_etax, d_etay, d_etaz,
@@ -1571,7 +1571,7 @@
mp->num_phase_ispec_elastic,
d_iphase,
mp->use_mesh_coloring_gpu,
- d_deltat,
+ d_deltat,
mp->d_b_displ,mp->d_b_veloc,mp->d_b_accel,
d_xix, d_xiy, d_xiz,
d_etax, d_etay, d_etaz,
@@ -1643,7 +1643,7 @@
void FC_FUNC_(compute_forces_viscoelastic_cuda,
COMPUTE_FORCES_VISCOELASTIC_CUDA)(long* Mesh_pointer_f,
int* iphase,
- realw* deltat,
+ realw* deltat,
int* nspec_outer_elastic,
int* nspec_inner_elastic,
int* COMPUTE_AND_STORE_STRAIN,
Modified: seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/decompose_mesh.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/decompose_mesh.F90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/decompose_mesh.F90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -404,7 +404,7 @@
! #(3) material_id_for_material_below #(4) material_id_for_material_above
! example: 2 -1 interface 1 2
! - for tomography models
- ! #(6) material_domain_id #(1) material_id(<0) #(2) type_name (="tomography")
+ ! #(6) material_domain_id #(1) material_id(<0) #(2) type_name (="tomography")
! #(3) block_name (="elastic") #(4) file_name
! example: 2 -1 tomography elastic tomography_model.xyz
! - for C-PML absorbing boundaries
@@ -432,7 +432,7 @@
undef_mat_prop(3,imat),undef_mat_prop(4,imat)
undef_mat_prop(5,imat) = "0" ! dummy value
elseif( num_mat <= -2001 .and. num_mat >= -2007 ) then
- ! line will have 5 arguments, e.g.: 2 -2001 2300.0 2800.0 1500.0
+ ! line will have 5 arguments, e.g.: 2 -2001 2300.0 2800.0 1500.0
read(line,*) undef_mat_prop(6,imat),undef_mat_prop(1,imat),undef_mat_prop(2,imat),&
undef_mat_prop(3,imat),undef_mat_prop(4,imat)
undef_mat_prop(5,imat) = "0" ! dummy value
@@ -626,13 +626,13 @@
close(98)
print*, ' nspec2D_top = ', nspec2D_top
- ! reads in absorbing_cpml boundary file
+ ! reads in absorbing_cpml boundary file
open(unit=98, file=localpath_name(1:len_trim(localpath_name))//'/absorbing_cpml_file', &
status='old', form='formatted',iostat=ier)
if( ier /= 0 ) then
nspec_cpml = 0
else
- read(98,*) nspec_cpml, CPML_width
+ read(98,*) nspec_cpml, CPML_width
endif
! C-PML spectral elements global indexing
@@ -661,9 +661,9 @@
! sets mask of C-PML elements for all elements in this partition
allocate(CPML_mask_ibool(nspec),stat=ier)
if(ier /= 0) stop 'error allocating array CPML_mask_ibool'
- CPML_mask_ibool(:) = .false.
+ CPML_mask_ibool(:) = .false.
do ispec_CPML=1,nspec_cpml
- if( (CPML_regions(ispec_CPML).ge.1) .and. (CPML_regions(ispec_CPML).le.7) ) then
+ if( (CPML_regions(ispec_CPML)>=1) .and. (CPML_regions(ispec_CPML)<=7) ) then
CPML_mask_ibool(CPML_to_spec(ispec_CPML)) = .true.
endif
enddo
@@ -688,10 +688,10 @@
if( nspec2D_moho > 0 ) print*, ' nspec2D_moho = ', nspec2D_moho
call read_fault_files(localpath_name)
- if (ANY_FAULT) then
+ if (ANY_FAULT) then
call save_nodes_coords(nodes_coords,nnodes)
- call close_faults(nodes_coords,nnodes)
- end if
+ call close_faults(nodes_coords,nnodes)
+ end if
end subroutine read_mesh_files
@@ -1042,7 +1042,7 @@
glob2loc_elmnts, glob2loc_nodes_nparts, &
glob2loc_nodes_parts, glob2loc_nodes, part, mat, NGNOD, 2)
- ! writes out absorbing/free-surface boundaries
+ ! writes out absorbing/free-surface boundaries
call write_boundaries_database(IIN_database, ipart, nspec, nspec2D_xmin, nspec2D_xmax, nspec2D_ymin, &
nspec2D_ymax, nspec2D_bottom, nspec2D_top, &
ibelm_xmin, ibelm_xmax, ibelm_ymin, &
@@ -1052,7 +1052,7 @@
glob2loc_elmnts, glob2loc_nodes_nparts, &
glob2loc_nodes_parts, glob2loc_nodes, part, NGNOD2D)
- ! writes out C-PML elements indices, CPML-regions and thickness of C-PML layer
+ ! writes out C-PML elements indices, CPML-regions and thickness of C-PML layer
call write_cpml_database(IIN_database, ipart, nspec, nspec_cpml, CPML_width, CPML_to_spec, &
CPML_regions, CPML_mask_ibool, glob2loc_elmnts, part)
@@ -1093,7 +1093,7 @@
print*,'error file open:',outputpath_name(1:len_trim(outputpath_name))//'/proc'//prname
print*
print*,'check if path exists:',outputpath_name(1:len_trim(outputpath_name))
- stop
+ stop
endif
call write_fault_database(16, ipart, nspec, &
glob2loc_elmnts, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
Modified: seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/fault_scotch.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/fault_scotch.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/fault_scotch.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -2,42 +2,42 @@
implicit none
include "../shared/constants.h"
- private
+ private
type fault_type
- private
+ private
integer :: nspec
- integer, dimension(:), pointer :: ispec1, ispec2 !, iface1, iface2
- integer, dimension(:,:), pointer :: inodes1, inodes2
+ integer, dimension(:), pointer :: ispec1, ispec2 !, iface1, iface2
+ integer, dimension(:,:), pointer :: inodes1, inodes2
end type fault_type
- type(fault_type), allocatable, save :: faults(:)
+ type(fault_type), allocatable, save :: faults(:)
double precision, dimension(:,:), allocatable, save :: nodes_coords_open
logical, save :: ANY_FAULT = .false.
logical, parameter :: PARALLEL_FAULT = .true.
- ! NOTE: PARALLEL_FAULT has to be the same
+ ! NOTE: PARALLEL_FAULT has to be the same
! in fault_solver_common.f90, fault_generate_databases.f90 and fault_scotch.f90
-
+
integer, parameter :: long = SELECTED_INT_KIND(18)
- double precision, parameter :: FAULT_GAP_TOLERANCE = 1.0d0
- ! must be larger than the fault offset in the mesh,
+ double precision, parameter :: FAULT_GAP_TOLERANCE = 1.0d0
+ ! must be larger than the fault offset in the mesh,
! but smaller than the smallest element size
public :: read_fault_files, fault_repartition, close_faults, write_fault_database, &
save_nodes_coords, nodes_coords_open, ANY_FAULT
-CONTAINS
+CONTAINS
!==========================================================================================
Subroutine read_fault_files(localpath_name)
- character(len=256),intent(in) :: localpath_name
- integer :: nbfaults, iflt, ier
+ character(len=256),intent(in) :: localpath_name
+ integer :: nbfaults, iflt, ier
open(101,file='../DATA/Par_file_faults',status='old',action='read',iostat=ier)
- if (ier==0) then
+ if (ier==0) then
read(101,*) nbfaults
else
nbfaults = 0
@@ -46,12 +46,12 @@
close(101)
ANY_FAULT = (nbfaults>0)
- if (.not. ANY_FAULT) return
+ if (.not. ANY_FAULT) return
allocate(faults(nbfaults))
! NOTE: asumes that the fault ids follow a contiguous numbering, starting at 1, with unit increment
! The user must assign that numbering during mesh generation
- do iflt = 1 , nbfaults
+ do iflt = 1 , nbfaults
call read_single_fault_file(faults(iflt),iflt,localpath_name)
enddo
@@ -63,22 +63,22 @@
Subroutine read_single_fault_file(f,ifault,localpath_name)
type(fault_type), intent(inout) :: f
- character(len=256),intent(in) :: localpath_name
-
- character(len=256) :: filename
+ character(len=256),intent(in) :: localpath_name
+
+ character(len=256) :: filename
integer,intent(in) :: ifault
character(len=5) :: NTchar
- integer :: e,ier,nspec_side1,nspec_side2
-
+ integer :: e,ier,nspec_side1,nspec_side2
+
write(NTchar,'(I5)') ifault
NTchar = adjustl(NTchar)
-
+
filename = localpath_name(1:len_trim(localpath_name))//'/fault_file_'//&
NTchar(1:len_trim(NTchar))//'.dat'
filename = adjustl(filename)
! reads fault elements and nodes
- ! File format:
- ! Line 1:
+ ! File format:
+ ! Line 1:
! number_of_elements_in_side_1 number_of_elements_in_side_2
! Then for all elements that have a face on side 1:
! #id_element #id_global_node1 .. #id_global_node4
@@ -86,11 +86,11 @@
! Note: element ids start at 1, not 0 (see cubit2specfem3d.py)
open(unit=101, file=filename, status='old', form='formatted', iostat = ier)
if( ier /= 0 ) then
- write(6,*) 'Fatal error: file '//filename//' not found'
+ write(6,*) 'Fatal error: file '//filename//' not found'
write(6,*) 'Abort'
stop
endif
-
+
read(101,*) nspec_side1,nspec_side2
if (nspec_side1 /= nspec_side2) stop 'Number of fault nodes at do not match.'
f%nspec = nspec_side1
@@ -119,19 +119,19 @@
! ---------------------------------------------------------------------------------------------------
! Saving nodes_coords to be used in SESAME for ibool_fault_side1 and side2
subroutine save_nodes_coords(nodes_coords,nnodes)
-
+
integer, intent(in) :: nnodes
double precision, dimension(3,nnodes), intent(in) :: nodes_coords
-
- allocate(nodes_coords_open(3,nnodes))
- nodes_coords_open = nodes_coords
-
- end subroutine save_nodes_coords
+ allocate(nodes_coords_open(3,nnodes))
+ nodes_coords_open = nodes_coords
+
+ end subroutine save_nodes_coords
+
! ---------------------------------------------------------------------------------------------------
subroutine close_faults(nodes_coords,nnodes)
-
+
integer, intent(in) :: nnodes
double precision, dimension(3,nnodes), intent(inout) :: nodes_coords
@@ -145,7 +145,7 @@
! ---------------------------------------------------------------------------------------------------
!jpa: to do this much faster:
-! 1. create a list of unique nodes from inodes1 and inodes2,
+! 1. create a list of unique nodes from inodes1 and inodes2,
! inodes1_u = unique(isort1)
! inodes2_u = unique(isort2)
! 2. sort the nodes by coordinates. Now both faces correspond.
@@ -157,13 +157,13 @@
! coords(k1) = 0.5*( coords(k1)+coords(k2) )
! coords(k2) = coords(k1)
subroutine close_fault_single(f,nodes_coords,nnodes)
-
+
type(fault_type), intent(in) :: f
integer, intent(in) :: nnodes
- double precision, dimension(3,nnodes), intent(inout) :: nodes_coords
-
- double precision, dimension(3) :: xyz_1, xyz_2, xyz
-
+ double precision, dimension(3,nnodes), intent(inout) :: nodes_coords
+
+ double precision, dimension(3) :: xyz_1, xyz_2, xyz
+
double precision :: dist
integer :: iglob1, iglob2, i, j, k1, k2
logical :: found_it
@@ -180,29 +180,29 @@
xyz_1 = nodes_coords(:,iglob1)
xyz = xyz_2-xyz_1
dist = sqrt(xyz(1)*xyz(1) + xyz(2)*xyz(2) + xyz(3)*xyz(3))
-
+
!jpa: Closing nodes that are already closed is not a problem
!jpa: I process them again to leave the loop as early as possible
- !jpa: and to test if a facing node was found (see below).
-
+ !jpa: and to test if a facing node was found (see below).
+
if (dist <= FAULT_GAP_TOLERANCE) then
xyz = (xyz_1 + xyz_2)*0.5d0
nodes_coords(:,iglob2) = xyz
nodes_coords(:,iglob1) = xyz
found_it = .true.
- exit
+ exit
endif
-
+
enddo
- if (found_it) exit
+ if (found_it) exit
enddo
- ! jpa: If the two fault sides have been meshed independently they might not match. Test it here:
+ ! jpa: If the two fault sides have been meshed independently they might not match. Test it here:
if (.not.found_it) stop 'Inconsistent fault mesh: corresponding node in the other fault face was not found'
enddo
enddo
-
+
end subroutine close_fault_single
!===================================================================================================
@@ -215,7 +215,7 @@
double precision,dimension(3,nnodes), intent(in) :: nodes_coords
integer :: i
-
+
do i=1,size(faults)
call reorder_fault_elements_single(faults(i),nodes_coords,nnodes)
enddo
@@ -243,7 +243,7 @@
enddo
xyz_c = xyz_c / 4d0
! reorder
- call lex_order(xyz_c,new_index_list,f%nspec)
+ call lex_order(xyz_c,new_index_list,f%nspec)
f%ispec1 = f%ispec1(new_index_list)
f%inodes1 = f%inodes1(:,new_index_list)
@@ -261,14 +261,14 @@
f%inodes2 = f%inodes2(:,new_index_list)
end subroutine reorder_fault_elements_single
-
+
! ---------------------------------------------------------------------------------------------------
subroutine lex_order(xyz_c,loc,nspec)
integer, intent(in) :: nspec
integer, intent(out) :: loc(nspec)
double precision, intent(in) :: xyz_c(3,nspec)
-
+
double precision, dimension(nspec) :: work,xp,yp,zp
integer, dimension(nspec) :: ind,ninseg,iwork
logical :: ifseg(nspec)
@@ -287,7 +287,7 @@
do ispec=1,nspec
loc(ispec)=ispec
enddo
-
+
ifseg(:)=.false.
nseg=1
@@ -308,7 +308,7 @@
endif
call swap_all(loc(ioff),xp(ioff),yp(ioff),zp(ioff),iwork,work,ind,ninseg(iseg))
ioff=ioff+ninseg(iseg)
- enddo
+ enddo
! check for jumps in current coordinate
! compare the coordinates of the points within a small tolerance
@@ -316,11 +316,11 @@
do i=2,nspec
if(dabs(xp(i)-xp(i-1)) > SMALLVALTOL) ifseg(i)=.true.
enddo
- else if(j == 2) then
+ else if(j == 2) then
do i=2,nspec
if(dabs(yp(i)-yp(i-1)) > SMALLVALTOL) ifseg(i)=.true.
enddo
- else
+ else
do i=2,nspec
if(dabs(zp(i)-zp(i-1)) > SMALLVALTOL) ifseg(i)=.true.
enddo
@@ -348,12 +348,12 @@
subroutine fault_repartition (nelmnts, nnodes, elmnts, nsize, nproc, part, esize, nodes_coords)
integer, intent(in) :: nelmnts,nsize
- integer, intent(in) :: nnodes, nproc, esize
+ integer, intent(in) :: nnodes, nproc, esize
integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
integer, dimension(0:nelmnts-1), intent(inout) :: part
double precision, dimension(3,nnodes), intent(in) :: nodes_coords
- if (PARALLEL_FAULT) then
+ if (PARALLEL_FAULT) then
call fault_repartition_parallel (nelmnts,part,nodes_coords,nnodes)
else
! move all fault elements to the same partition (proc=0)
@@ -371,7 +371,7 @@
subroutine fault_repartition_not_parallel (nelmnts, nnodes, elmnts, nsize, nproc, part, esize)
integer, intent(in) :: nelmnts,nsize
- integer, intent(in) :: nnodes, nproc, esize
+ integer, intent(in) :: nnodes, nproc, esize
integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
integer, dimension(0:nelmnts-1), intent(inout) :: part
@@ -388,7 +388,7 @@
print*, nproc_null
if ( nproc_null /= 0 ) then
-
+
allocate(elem_proc_null(nproc_null))
! Filling up proc = 0 elements
nproc_null = 0
@@ -397,10 +397,10 @@
nproc_null = nproc_null + 1
elem_proc_null(nproc_null) = i
end if
- end do
+ end do
! Redistributing proc-0 elements on the rest of processors
ipart=1
- if (nproc > 1) then
+ if (nproc > 1) then
do i = 1, nproc_null
part(elem_proc_null(i)) = ipart
if ( ipart == nproc-1 ) ipart = 0
@@ -414,10 +414,10 @@
print *, "Fault zone layer :"
! List of elements per node
-! nnodes_elmnts(i) = number of elements containing node #i (i=0:nnodes-1)
-! nodes_elmnts(nsize*i:nsize*i+nnodes_elmnts(i)-1) = index of elements (starting at 0) containing node #i
+! nnodes_elmnts(i) = number of elements containing node #i (i=0:nnodes-1)
+! nodes_elmnts(nsize*i:nsize*i+nnodes_elmnts(i)-1) = index of elements (starting at 0) containing node #i
! nsize = maximun number of elements in a node.
-! esize = nodes per element.
+! esize = nodes per element.
nnodes_elmnts(:) = 0
nodes_elmnts(:) = 0
@@ -435,7 +435,7 @@
k1 = nsize*inode
k2 = k1 + nnodes_elmnts(inode) -1
part( nodes_elmnts(k1:k2) ) = 0
- inode = faults(iflt)%inodes2(k,e)-1
+ inode = faults(iflt)%inodes2(k,e)-1
k1 = nsize*inode
k2 = k1 + nnodes_elmnts(inode) -1
part( nodes_elmnts(k1:k2) ) = 0
@@ -445,7 +445,7 @@
end do
nproc_null_final = count( part == 0 )
- print *, nproc_null_final
+ print *, nproc_null_final
end subroutine fault_repartition_not_parallel
@@ -462,7 +462,7 @@
! Reorder both fault sides so that elements facing each other have the same index
call reorder_fault_elements(nodes_coords,nnodes)
-!JPA loop over all faults
+!JPA loop over all faults
!JPA loop over all fault element pairs
!JPA assign both elements to the processor with lowest rank among the pair
@@ -484,7 +484,7 @@
! ---------------------------------------------------------------------------------------------------
! See subroutine write_boundaries_database in part_decompose_mesh_SCOTCH.f90
!
-! File format:
+! File format:
! one block for each fault
! first line of each block = number of fault elements in this processor
! next lines: #id_(element containing the face) #id_node1_face .. #id_node4_face
@@ -507,7 +507,7 @@
integer :: loc_nodes(4),inodes(4)
do iflt=1,size(faults)
-
+
! get number of fault elements in this partition
nspec_fault_1 = count( part(faults(iflt)%ispec1-1) == iproc )
nspec_fault_2 = count( part(faults(iflt)%ispec2-1) == iproc )
@@ -517,13 +517,13 @@
print *, ' ispec1 : ', nspec_fault_1
print *, ' ispec2 : ', nspec_fault_2
print *, 'Fatal error: Number of fault elements do not coincide. Abort.'
- stop
+ stop
end if
!write(IIN_database,*) nspec_fault_1
write(IIN_database) nspec_fault_1
! if no fault element in this partition, move to next fault
- if (nspec_fault_1==0) cycle
+ if (nspec_fault_1==0) cycle
! export fault element data, side 1
do i=1,faults(iflt)%nspec
@@ -638,33 +638,33 @@
integer IND(n)
integer IA(n),IW(n)
double precision A(n),B(n),C(n),W(n)
-
+
integer i
-
+
IW(:) = IA(:)
W(:) = A(:)
-
+
do i=1,n
IA(i)=IW(ind(i))
A(i)=W(ind(i))
enddo
-
+
W(:) = B(:)
-
+
do i=1,n
B(i)=W(ind(i))
enddo
-
+
W(:) = C(:)
-
+
do i=1,n
C(i)=W(ind(i))
- enddo
-
+ enddo
+
end subroutine swap_all
-
+
! ------------------------------------------------------------------
-
+
end module fault_scotch
Modified: seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/part_decompose_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/part_decompose_mesh.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/part_decompose_mesh.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -733,7 +733,7 @@
endif
enddo
write(IIN_database) 6, loc_nspec2D_top
-
+
! outputs element index and element node indices
! note: assumes that element indices in ibelm_* arrays are in the range from 1 to nspec
! (this is assigned by CUBIT, if this changes the following indexing must be changed as well)
@@ -972,7 +972,7 @@
end subroutine write_boundaries_database
!--------------------------------------------------
- ! Write C-PML elements indices, CPML-regions and thickness of C-PML layer
+ ! Write C-PML elements indices, CPML-regions and thickness of C-PML layer
! pertaining to iproc partition in the corresponding Database
!--------------------------------------------------
subroutine write_cpml_database(IIN_database, iproc, nspec, nspec_cpml, CPML_width, CPML_to_spec, &
@@ -983,7 +983,7 @@
integer, intent(in) :: nspec
integer, intent(in) :: nspec_cpml
- integer, dimension(nspec_cpml), intent(in) :: CPML_to_spec
+ integer, dimension(nspec_cpml), intent(in) :: CPML_to_spec
integer, dimension(nspec_cpml), intent(in) :: CPML_regions
logical, dimension(nspec), intent(in) :: CPML_mask_ibool
@@ -1009,12 +1009,12 @@
endif
enddo
- write(IIN_database) nspec_cpml_local
+ write(IIN_database) nspec_cpml_local
! writes thickness of C-PML layers for the global mesh
write(IIN_database) CPML_width
- ! writes C-PML regions and C-PML spectral elements global indexing
+ ! writes C-PML regions and C-PML spectral elements global indexing
do i=1,nspec_cpml
! #id_cpml_regions = 1 : X_surface C-PML
! #id_cpml_regions = 2 : Y_surface C-PML
@@ -1024,7 +1024,7 @@
! #id_cpml_regions = 6 : YZ_edge C-PML
! #id_cpml_regions = 7 : XYZ_corner C-PML
!
- ! format: #id_cpml_element #id_cpml_regions
+ ! format: #id_cpml_element #id_cpml_regions
if( part(CPML_to_spec(i)) == iproc ) then
write(IIN_database) glob2loc_elmnts(CPML_to_spec(i)-1)+1, CPML_regions(i)
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_mass_matrices.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_mass_matrices.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_mass_matrices.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -99,10 +99,10 @@
do j=1,NGLLY
do i=1,NGLLX
iglob = ibool(i,j,k,ispec)
-
+
weight = wxgll(i)*wygll(j)*wzgll(k)
jacobianl = jacobianstore(i,j,k,ispec)
-
+
! distinguish between single and double precision for reals
if(CUSTOM_REAL == SIZE_REAL) then
rmass_acoustic(iglob) = rmass_acoustic(iglob) + &
@@ -424,7 +424,7 @@
!
subroutine create_mass_matrices_pml(nspec,ibool)
-
+
use generate_databases_par, only: CPML_mask_ibool,CPML_regions,d_store_x,d_store_y,d_store_z, &
K_store_x,K_store_y,K_store_z,nspec_cpml,CPML_to_spec,DT
@@ -435,7 +435,7 @@
integer, intent(in) :: nspec
integer, dimension(NGLLX,NGLLY,NGLLZ,nspec), intent(in) :: ibool
-
+
! local parameters
double precision :: weight
real(kind=CUSTOM_REAL) :: jacobianl,deltat,mat_coef
@@ -448,7 +448,7 @@
deltat = DT
endif
- ! loops over physical mesh elements
+ ! loops over physical mesh elements
do ispec=1,nspec
if( .not. CPML_mask_ibool(ispec) ) then
do k=1,NGLLZ
@@ -494,7 +494,7 @@
mat_coef = rhostore(i,j,k,ispec)
elseif( ispec_is_acoustic(ispec) ) then
mat_coef = 1.d0 / kappastore(i,j,k,ispec)
- endif
+ endif
iglob = ibool(i,j,k,ispec)
@@ -524,7 +524,7 @@
mat_coef = rhostore(i,j,k,ispec)
elseif( ispec_is_acoustic(ispec) ) then
mat_coef = 1.d0 / kappastore(i,j,k,ispec)
- endif
+ endif
iglob = ibool(i,j,k,ispec)
@@ -554,7 +554,7 @@
mat_coef = rhostore(i,j,k,ispec)
elseif( ispec_is_acoustic(ispec) ) then
mat_coef = 1.d0 / kappastore(i,j,k,ispec)
- endif
+ endif
iglob = ibool(i,j,k,ispec)
@@ -584,7 +584,7 @@
mat_coef = rhostore(i,j,k,ispec)
elseif( ispec_is_acoustic(ispec) ) then
mat_coef = 1.d0 / kappastore(i,j,k,ispec)
- endif
+ endif
iglob = ibool(i,j,k,ispec)
@@ -618,7 +618,7 @@
mat_coef = rhostore(i,j,k,ispec)
elseif( ispec_is_acoustic(ispec) ) then
mat_coef = 1.d0 / kappastore(i,j,k,ispec)
- endif
+ endif
iglob = ibool(i,j,k,ispec)
@@ -652,7 +652,7 @@
mat_coef = rhostore(i,j,k,ispec)
elseif( ispec_is_acoustic(ispec) ) then
mat_coef = 1.d0 / kappastore(i,j,k,ispec)
- endif
+ endif
iglob = ibool(i,j,k,ispec)
@@ -686,7 +686,7 @@
mat_coef = rhostore(i,j,k,ispec)
elseif( ispec_is_acoustic(ispec) ) then
mat_coef = 1.d0 / kappastore(i,j,k,ispec)
- endif
+ endif
iglob = ibool(i,j,k,ispec)
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -113,7 +113,7 @@
end if
if (ANY_FAULT) then
- ! recalculate *store with faults closed
+ ! recalculate *store with faults closed
call sync_all()
if (myrank == 0) write(IMAIN,*) ' ... resetting up jacobian in fault domains'
if (ANY_FAULT_IN_THIS_PROC) call crm_ext_setup_jacobian(myrank, &
@@ -276,7 +276,7 @@
! saves binary mesh files for attenuation
if( ATTENUATION ) then
call get_attenuation_model(myrank,nspec,USE_OLSEN_ATTENUATION,OLSEN_ATTENUATION_RATIO, &
- mustore,rho_vs,qmu_attenuation_store, &
+ mustore,rho_vs,kappastore,rho_vp,qmu_attenuation_store, & !ZN
ispec_is_elastic,min_resolved_period,prname)
endif
@@ -288,7 +288,7 @@
deallocate(kappastore,mustore,rho_vp,rho_vs)
deallocate(rho_vpI,rho_vpII,rho_vsI)
deallocate(rhoarraystore,kappaarraystore,etastore,phistore,tortstore,permstore)
-
+
if( .not. SAVE_MOHO_MESH ) then
deallocate(xstore_dummy,ystore_dummy,zstore_dummy)
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/fault_generate_databases.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/fault_generate_databases.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/fault_generate_databases.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -1,6 +1,6 @@
! Generates database for faults (dynamic or kinematic)
!
-! Splitting fault nodes (with opening) is done in CUBIT.
+! Splitting fault nodes (with opening) is done in CUBIT.
! See sections "Mesh generation with split nodes"
! and "Cubit-python scripts for faults" in the README_SPECFEM3D_FAULT file.
!
@@ -8,14 +8,14 @@
! Percy Galvez, Jean-Paul Ampuero and Tarje Nissen-Meyer
module fault_generate_databases
-
+
use create_regions_mesh_ext_par, only: NGLLX,NGLLY,NGLLZ,NGLLSQUARE,NDIM,CUSTOM_REAL,IMAIN
use generate_databases_par, only : NGNOD2D
implicit none
- private
-
- type fault_db_type
+ private
+
+ type fault_db_type
private
integer :: nspec=0,nglob=0
real(kind=CUSTOM_REAL) :: eta
@@ -36,9 +36,9 @@
logical, save :: ANY_FAULT = .false.
logical, parameter :: PARALLEL_FAULT = .true.
- ! NOTE: PARALLEL_FAULT has to be the same
+ ! NOTE: PARALLEL_FAULT has to be the same
! in fault_solver_common.f90, fault_generate_databases.f90 and fault_scotch.f90
-
+
! corners indices of reference cube faces
integer,dimension(3,4),parameter :: iface1_corner_ijk = &
reshape( (/ 1,1,1, 1,NGLLY,1, 1,NGLLY,NGLLZ, 1,1,NGLLZ /),(/3,4/)) ! xmin
@@ -51,7 +51,7 @@
integer,dimension(3,4),parameter :: iface5_corner_ijk = &
reshape( (/ 1,1,1, 1,NGLLY,1, NGLLX,NGLLY,1, NGLLX,1,1 /),(/3,4/)) ! bottom
integer,dimension(3,4),parameter :: iface6_corner_ijk = &
- reshape( (/ 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),(/3,4/)) ! top
+ reshape( (/ 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),(/3,4/)) ! top
integer,dimension(3,4,6),parameter :: iface_all_corner_ijk = &
reshape( (/ iface1_corner_ijk,iface2_corner_ijk, &
iface3_corner_ijk,iface4_corner_ijk, &
@@ -65,16 +65,16 @@
!=================================================================================================================
subroutine fault_read_input(prname,myrank)
- character(len=256), intent(in) :: prname
+ character(len=256), intent(in) :: prname
integer, intent(in) :: myrank
integer :: nb,i,iflt,ier,nspec,dummy_node
- integer, parameter :: IIN_PAR = 100
-
+ integer, parameter :: IIN_PAR = 100
+
! read fault input file
nb = 0
open(unit=IIN_PAR,file='../DATA/Par_file_faults',status='old',action='read',iostat=ier)
- if (ier==0) then
+ if (ier==0) then
read(IIN_PAR,*) nb
if (myrank==0) write(IMAIN,*) ' ... reading ', nb,' faults from file DATA/Par_file_faults'
else
@@ -83,12 +83,12 @@
end if
ANY_FAULT = (nb>0)
- if (.not. ANY_FAULT) return
+ if (.not. ANY_FAULT) return
allocate(fault_db(nb))
do i=1,nb
- read(IIN_PAR,*) fault_db(i)%eta
- enddo
+ read(IIN_PAR,*) fault_db(i)%eta
+ enddo
close(IIN_PAR)
! read fault database file
@@ -100,9 +100,9 @@
stop
endif
- do iflt=1,size(fault_db)
+ do iflt=1,size(fault_db)
- read(IIN_PAR) nspec
+ read(IIN_PAR) nspec
fault_db(iflt)%nspec = nspec
if (nspec == 0) cycle
@@ -120,7 +120,7 @@
do i=1,nspec
read(IIN_PAR) fault_db(iflt)%ispec2(i), fault_db(iflt)%inodes2(:,i)
enddo
-
+
! loading ispec1 ispec2 iface1 iface2 of fault elements.
! allocate(fault_db(iflt)%iface1(nspec))
! allocate(fault_db(iflt)%iface2(nspec))
@@ -167,7 +167,7 @@
! saving gll indices for each fault face, needed for ibulks
call setup_ijk(fault_db(iflt))
- ! ibools = mapping from local indices on the fault (GLL index, element index)
+ ! ibools = mapping from local indices on the fault (GLL index, element index)
! to global indices on the fault
call setup_ibools(fault_db(iflt),xstore,ystore,zstore,nspec,fault_db(iflt)%nspec*NGLLSQUARE)
@@ -176,10 +176,10 @@
call setup_ibulks(fault_db(iflt),ibool,nspec)
! close the fault in (xyz)store_dummy
- call close_fault(fault_db(iflt))
+ call close_fault(fault_db(iflt))
call setup_Kelvin_Voigt_eta(fault_db(iflt),nspec)
-
+
call save_fault_xyzcoord_ibulk(fault_db(iflt))
call setup_normal_jacobian(fault_db(iflt),ibool,nspec,nglob,myrank)
@@ -197,12 +197,12 @@
use create_regions_mesh_ext_par, only: xstore_dummy,ystore_dummy,zstore_dummy
- type(fault_db_type), intent(inout) :: fdb
- integer, intent(in) :: nnodes_ext_mesh,nspec,nglob
+ type(fault_db_type), intent(inout) :: fdb
+ integer, intent(in) :: nnodes_ext_mesh,nspec,nglob
double precision, dimension(NDIM,nnodes_ext_mesh), intent(in) :: nodes_coords_ext_mesh
integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
- real(kind=CUSTOM_REAL), dimension(NGNOD2D) :: xcoord,ycoord,zcoord
+ real(kind=CUSTOM_REAL), dimension(NGNOD2D) :: xcoord,ycoord,zcoord
integer :: icorner,e
allocate(fdb%iface1(fdb%nspec))
@@ -235,8 +235,8 @@
!=============================================================================================================
subroutine setup_ijk(fdb)
- type(fault_db_type), intent(inout) :: fdb
-
+ type(fault_db_type), intent(inout) :: fdb
+
integer :: e,i,j,igll
integer :: ijk_face1(3,NGLLX,NGLLY), ijk_face2(3,NGLLX,NGLLY)
@@ -250,7 +250,7 @@
do j=1,NGLLY
do i=1,NGLLX
igll = igll + 1
- fdb%ijk1(:,igll,e)=ijk_face1(:,i,j)
+ fdb%ijk1(:,igll,e)=ijk_face1(:,i,j)
fdb%ijk2(:,igll,e)=ijk_face2(:,i,j)
enddo
enddo
@@ -260,13 +260,13 @@
!=============================================================================================================
subroutine setup_Kelvin_Voigt_eta(fdb,nspec)
-
- type(fault_db_type), intent(in) :: fdb
+
+ type(fault_db_type), intent(in) :: fdb
integer, intent(in) :: nspec ! number of spectral elements in each block
if (fdb%eta > 0.0_CUSTOM_REAL) then
if (.not.allocated(Kelvin_Voigt_eta)) then
- allocate(Kelvin_Voigt_eta(nspec))
+ allocate(Kelvin_Voigt_eta(nspec))
Kelvin_Voigt_eta(:) = 0.0_CUSTOM_REAL
endif
Kelvin_Voigt_eta(fdb%ispec1) = fdb%eta
@@ -277,7 +277,7 @@
!===============================================================================================================
! The lexicographic ordering of node coordinates
-! guarantees that the fault nodes are
+! guarantees that the fault nodes are
! consistently ordered on both sides of the fault,
! such that the K-th node of side 1 is facing the K-th node of side 2
@@ -298,7 +298,7 @@
xmax = maxval(nodes_coords_ext_mesh(1,:))
k = 0
- do e = 1,fdb%nspec
+ do e = 1,fdb%nspec
ispec = fdb%ispec1(e)
do igll=1,NGLLSQUARE
ie=fdb%ijk1(1,igll,e)
@@ -313,12 +313,12 @@
allocate( fdb%ibool1(NGLLSQUARE,fdb%nspec) )
call get_global(fdb%nspec,xp,yp,zp,fdb%ibool1,loc,ifseg,fdb%nglob,npointot,xmin,xmax)
-! xp,yp,zp need to be recomputed on side 2
-! because they are generally not in the same order as on side 1,
-! because ispec1(e) is not necessarily facing ispec2(e).
+! xp,yp,zp need to be recomputed on side 2
+! because they are generally not in the same order as on side 1,
+! because ispec1(e) is not necessarily facing ispec2(e).
k = 0
- do e = 1,fdb%nspec
+ do e = 1,fdb%nspec
ispec = fdb%ispec2(e)
do igll=1,NGLLSQUARE
ie=fdb%ijk2(1,igll,e)
@@ -339,7 +339,7 @@
!=================================================================================
subroutine setup_ibulks(fdb,ibool,nspec)
-
+
type(fault_db_type), intent(inout) :: fdb
integer, intent(in) :: nspec, ibool(NGLLX,NGLLY,NGLLZ,nspec)
@@ -347,23 +347,23 @@
allocate( fdb%ibulk1(fdb%nglob) )
allocate( fdb%ibulk2(fdb%nglob) )
-
+
do e=1, fdb%nspec
do k=1, NGLLSQUARE
-
+
ie=fdb%ijk1(1,k,e)
je=fdb%ijk1(2,k,e)
ke=fdb%ijk1(3,k,e)
K1= fdb%ibool1(k,e)
fdb%ibulk1(K1)=ibool(ie,je,ke,fdb%ispec1(e))
-
+
ie=fdb%ijk2(1,k,e)
je=fdb%ijk2(2,k,e)
ke=fdb%ijk2(3,k,e)
K2= fdb%ibool2(k,e)
fdb%ibulk2(K2)=ibool(ie,je,ke,fdb%ispec2(e))
-
- enddo
+
+ enddo
enddo
end subroutine setup_ibulks
@@ -373,10 +373,10 @@
! Fortunately only *store_dummy is needed to compute jacobians and normals
subroutine close_fault(fdb)
-
+
use create_regions_mesh_ext_par, only: xstore_dummy,ystore_dummy,zstore_dummy
- type(fault_db_type), intent(inout) :: fdb
+ type(fault_db_type), intent(inout) :: fdb
integer :: i,K1,K2
@@ -409,14 +409,14 @@
allocate( fdb%xcoordbulk2(fdb%nglob) )
allocate( fdb%ycoordbulk2(fdb%nglob) )
allocate( fdb%zcoordbulk2(fdb%nglob) )
-
+
do i=1, fdb%nglob
K1 =fdb%ibulk1(i)
K2 =fdb%ibulk2(i)
fdb%xcoordbulk1(i) = xstore_dummy(K1)
fdb%ycoordbulk1(i) = ystore_dummy(K1)
- fdb%zcoordbulk1(i) = zstore_dummy(K1)
-
+ fdb%zcoordbulk1(i) = zstore_dummy(K1)
+
fdb%xcoordbulk2(i) = xstore_dummy(K2)
fdb%ycoordbulk2(i) = ystore_dummy(K2)
fdb%zcoordbulk2(i) = zstore_dummy(K2)
@@ -428,7 +428,7 @@
!=================================================================================
subroutine setup_normal_jacobian(fdb,ibool,nspec,nglob,myrank)
-
+
use create_regions_mesh_ext_par, only: xstore_dummy,ystore_dummy,zstore_dummy, &
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz
@@ -441,19 +441,19 @@
integer, intent(in) :: myrank
! (assumes NGLLX=NGLLY=NGLLZ)
- real(kind=CUSTOM_REAL),dimension(NGNOD2D) :: xcoord,ycoord,zcoord
+ real(kind=CUSTOM_REAL),dimension(NGNOD2D) :: xcoord,ycoord,zcoord
real(kind=CUSTOM_REAL) :: jacobian2Dw_face(NGLLX,NGLLY)
real(kind=CUSTOM_REAL) :: normal_face(NDIM,NGLLX,NGLLY)
integer,dimension(NGNOD2D) :: iglob_corners_ref
integer :: ispec_flt,ispec,i,j,k,igll
integer :: iface_ref,icorner
-
+
allocate(fdb%normal(NDIM,NGLLSQUARE,fdb%nspec))
allocate(fdb%jacobian2Dw(NGLLSQUARE,fdb%nspec))
do ispec_flt=1,fdb%nspec
- iface_ref= fdb%iface1(ispec_flt)
+ iface_ref= fdb%iface1(ispec_flt)
ispec = fdb%ispec1(ispec_flt)
! takes indices of corners of reference face
@@ -468,7 +468,7 @@
! reference corner coordinates
xcoord(icorner) = xstore_dummy(iglob_corners_ref(icorner))
ycoord(icorner) = ystore_dummy(iglob_corners_ref(icorner))
- zcoord(icorner) = zstore_dummy(iglob_corners_ref(icorner))
+ zcoord(icorner) = zstore_dummy(iglob_corners_ref(icorner))
enddo
! gets face GLL 2Djacobian, weighted from element face
@@ -478,7 +478,7 @@
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
ispec,iface_ref,jacobian2Dw_face,normal_face,NGLLX,NGLLY,NGNOD2D)
- ! normal convention: points away from domain1, reference element.
+ ! normal convention: points away from domain1, reference element.
do j=1,NGLLY
do i=1,NGLLX
! directs normals such that they point outwards of element
@@ -494,15 +494,15 @@
do j=1,NGLLY
do i=1,NGLLX
! adds all gll points on that face
- igll = igll + 1
+ igll = igll + 1
! stores weighted jacobian and normals
fdb%jacobian2Dw(igll,ispec_flt) = jacobian2Dw_face(i,j)
fdb%normal(:,igll,ispec_flt) = normal_face(:,i,j)
enddo
enddo
- enddo ! ispec_flt
-
+ enddo ! ispec_flt
+
end subroutine setup_normal_jacobian
!====================================================================================
@@ -513,7 +513,7 @@
integer, parameter :: IOUT = 121 !WARNING: not very robust. Could instead look for an available ID
integer :: nbfaults,iflt,ier
- character(len=256) :: filename
+ character(len=256) :: filename
if (.not.ANY_FAULT) return
@@ -521,14 +521,14 @@
filename = prname(1:len_trim(prname))//'fault_db.txt'
open(unit=IOUT,file=trim(filename),status='unknown',action='write',iostat=ier)
if( ier /= 0 ) stop 'error opening database proc######_external_mesh.bin'
-
+
nbfaults = size(fault_db)
write(IOUT,*) 'NBFAULTS = ',nbfaults
do iflt=1,nbfaults
write(IOUT,*) 'BEGIN FAULT # ',iflt
call save_one_fault_test(fault_db(iflt),IOUT)
write(IOUT,*) 'END FAULT # ',iflt
- enddo
+ enddo
close(IOUT)
end subroutine fault_save_arrays_test
@@ -536,7 +536,7 @@
!-------------------------------------------------------------------------------------
subroutine save_one_fault_test(f,IOUT)
-
+
type(fault_db_type), intent(in) :: f
integer, intent(in) :: IOUT
@@ -549,7 +549,7 @@
write(IOUT,*) 'NSPEC NGLOB NGLL = ',f%nspec,f%nglob,NGLLX
if (f%nspec==0) return
do e=1,f%nspec
- write(IOUT,*) 'FLT_ELEM = ',e
+ write(IOUT,*) 'FLT_ELEM = ',e
write(IOUT,*) 'ISPEC1 ISPEC2 = ',f%ispec1(e),f%ispec2(e)
write(IOUT,fmt1) 'IBOOL1 = ',f%ibool1(:,e)
write(IOUT,fmt1) 'IBOOL2 = ',f%ibool2(:,e)
@@ -564,12 +564,12 @@
write(IOUT,fmt2) 'N2 = ',f%normal(2,:,e)
write(IOUT,fmt2) 'N3 = ',f%normal(3,:,e)
enddo
-
+
write(IOUT,*) 'FLT_NODE IBULK1 IBULK2'
do k=1,f%nglob
write(IOUT,*) k,f%ibulk1(k),f%ibulk2(k)
enddo
-
+
write(IOUT,*) 'FLT_NODE xcoordbulk ycoordbulk zcoordbulk'
do k=1,f%nglob
write(IOUT,*) f%ibulk1(k),f%xcoordbulk1(k),f%ycoordbulk1(k),f%zcoordbulk1(k)
@@ -579,7 +579,7 @@
end subroutine save_one_fault_test
!=================================================================================
-! saves fault data needed by the solver in binary files
+! saves fault data needed by the solver in binary files
subroutine fault_save_arrays(prname)
character(len=256), intent(in) :: prname ! 'proc***'
@@ -597,17 +597,17 @@
open(unit=IOUT,file=trim(filename),status='unknown',action='write',form='unformatted',iostat=ier)
if( ier /= 0 ) then
write(IMAIN,*) 'error opening file ',trim(filename)
- stop
+ stop
endif
-
+
! saves mesh file proc***_Kelvin_voigt_eta.bin
if (allocated(Kelvin_Voigt_eta)) then
size_Kelvin_Voigt = size(Kelvin_Voigt_eta)
- else
+ else
size_Kelvin_Voigt = 0
endif
write(IOUT) size_Kelvin_Voigt
- if (size_Kelvin_Voigt /= 0) Write(IOUT) Kelvin_Voigt_eta
+ if (size_Kelvin_Voigt /= 0) Write(IOUT) Kelvin_Voigt_eta
close(IOUT)
! saves mesh file proc***_fault_db.bin
@@ -615,26 +615,26 @@
open(unit=IOUT,file=trim(filename),status='unknown',action='write',form='unformatted',iostat=ier)
if( ier /= 0 ) then
write(IMAIN,*) 'error opening file ',trim(filename)
- stop
+ stop
endif
-
+
nbfaults = size(fault_db)
write(IOUT) nbfaults
do iflt=1,nbfaults
call save_one_fault_bin(fault_db(iflt),IOUT)
- enddo
+ enddo
close(IOUT)
-
+
end subroutine fault_save_arrays
!----------------------------------------------
subroutine save_one_fault_bin(f,IOUT)
-
+
type(fault_db_type), intent(in) :: f
integer, intent(in) :: IOUT
-
+
write(IOUT) f%nspec,f%nglob
if (f%nspec==0) return
write(IOUT) f%ibool1
@@ -642,7 +642,7 @@
write(IOUT) f%normal
write(IOUT) f%ibulk1
write(IOUT) f%ibulk2
- write(IOUT) f%xcoordbulk1
+ write(IOUT) f%xcoordbulk1
write(IOUT) f%ycoordbulk1
write(IOUT) f%zcoordbulk1
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases_par.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases_par.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases_par.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -123,10 +123,10 @@
! C-PML absorbing boundary conditions
- ! local number of C-PML spectral elements
+ ! local number of C-PML spectral elements
integer :: nspec_cpml
- ! global number of C-PML spectral elements
+ ! global number of C-PML spectral elements
integer :: nspec_cpml_tot
! C-PML spectral elements global indexing
@@ -138,7 +138,7 @@
! mask of C-PML elements for the global mesh
logical, dimension(:), allocatable :: CPML_mask_ibool
- ! thickness of C-PML layers
+ ! thickness of C-PML layers
real(kind=CUSTOM_REAL) :: CPML_width,CPML_width_x,CPML_width_y,CPML_width_z
! C-PML damping profile arrays
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_absorbing_boundary.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_absorbing_boundary.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_absorbing_boundary.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -456,7 +456,7 @@
free_surface_jacobian2Dw(igllfree,ifree) = jacobian2Dw_face(i,j)
free_surface_normal(:,igllfree,ifree) = normal_face(:,i,j)
enddo
- enddo
+ enddo
else
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_global.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_global.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_global.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -59,9 +59,9 @@
!jpampuero For volumes NGLLCUBE = NGLLX * NGLLY * NGLLZ
!jpampuero For surfaces NGLLCUBE = NGLLX * NGLLY
integer :: NGLLCUBE_local
-
+
NGLLCUBE_local=npointot/nspec
-! for vectorization of loops
+! for vectorization of loops
! integer, parameter :: NGLLCUBE_NDIM = NGLLCUBE * NDIM
! define geometrical tolerance based upon typical size of the model
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_model.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_model.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_model.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -330,7 +330,7 @@
call any_all_l( ANY(ispec_is_elastic), ELASTIC_SIMULATION )
call any_all_l( ANY(ispec_is_poroelastic), POROELASTIC_SIMULATION )
- ! deallocates tomographic arrays
+ ! deallocates tomographic arrays
if( nundefMat_ext_mesh > 0 .or. IMODEL == IMODEL_TOMO ) then
call deallocate_tomography_files()
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/memory_eval.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/memory_eval.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/memory_eval.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -85,7 +85,7 @@
! see: read_mesh_databases.f90 and pml_allocate_arrays.f90
! C-PML arrays
if( PML_CONDITIONS ) then
- ! CPML_regions,CPML_to_spec,CPML_type
+ ! CPML_regions,CPML_to_spec,CPML_type
memory_size = memory_size + 3.d0*nspec_cpml*dble(SIZE_INTEGER)
! spec_to_CPML
@@ -129,7 +129,7 @@
! accel_elastic_CPML
memory_size = memory_size + dble(NDIM)*dble(NGLLX)*dble(NGLLY)*dble(NGLLZ)*nspec_cpml*dble(CUSTOM_REAL)
- ! second derivative of the potential
+ ! second derivative of the potential
memory_size = memory_size + dble(NGLLX)*dble(NGLLY)*dble(NGLLZ)*nspec_cpml*dble(CUSTOM_REAL)
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_tomography.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_tomography.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_tomography.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -48,8 +48,8 @@
! determines the number of external tomographic models and allocates tomographic arrays
call init_tomography_files(myrank)
-
- ! reads Vp Vs and rho from extracted text file
+
+ ! reads Vp Vs and rho from extracted text file
call read_model_tomography(myrank)
! otherwise:
@@ -128,7 +128,7 @@
! checks the number of records for points definition
nlines = 0
- do while(ier == 0)
+ do while(ier == 0)
read(27,*,iostat=ier)
if (ier == 0) nlines = nlines + 1
end do
@@ -222,7 +222,7 @@
open(unit=27,file=trim(tomo_filename),status='old',action='read',iostat=ier)
if(ier /= 0) call exit_MPI(myrank,'error reading tomography file')
- rewind(unit=27,iostat=ier)
+ rewind(unit=27,iostat=ier)
if(ier /= 0) call exit_MPI(myrank,'error rewinding tomography file')
! reads in model dimensions
@@ -334,7 +334,7 @@
implicit none
- integer, intent(in) :: imaterial_id
+ integer, intent(in) :: imaterial_id
double precision, intent(in) :: xmesh,ymesh,zmesh
@@ -355,8 +355,8 @@
vs1,vs2,vs3,vs4,vs5,vs6,vs7,vs8,rho1,rho2,rho3,rho4,rho5,rho6,rho7,rho8
real(kind=CUSTOM_REAL), dimension(NFILES_TOMO) :: vp_final,vs_final,rho_final
-
+
if( imaterial_id < 0 .and. trim(undef_mat_prop(2,abs(imaterial_id))) == 'tomography' ) then
imat = 0
@@ -587,6 +587,6 @@
! deallocates models min/max statistics
deallocate(VP_MIN,VS_MIN,RHO_MIN)
- deallocate(VP_MAX,VS_MAX,RHO_MAX)
+ deallocate(VP_MAX,VS_MAX,RHO_MAX)
end subroutine deallocate_tomography_files
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/pml_set_local_dampingcoeff.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/pml_set_local_dampingcoeff.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/pml_set_local_dampingcoeff.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -47,7 +47,7 @@
! local parameters
integer :: i,j,k,ispec,iglob,ispec_CPML,ier
- ! JC JC: Remove the parameter definition here and make the calculation of ALPHA_MAX_PML automatic
+ ! JC JC: Remove the parameter definition here and make the calculation of ALPHA_MAX_PML automatic
! by recovering the value of hdur in FORCESOLUTION/CMTSOLUTION
real(kind=CUSTOM_REAL) :: ALPHA_MAX_PML
@@ -73,7 +73,7 @@
if(ier /= 0) stop 'error allocating array K_store_z'
allocate(alpha_store(NGLLX,NGLLY,NGLLZ,nspec_cpml),stat=ier)
if(ier /= 0) stop 'error allocating array alpha_store'
-
+
d_store_x = 0._CUSTOM_REAL
d_store_y = 0._CUSTOM_REAL
d_store_z = 0._CUSTOM_REAL
@@ -83,7 +83,7 @@
K_store_z = 0._CUSTOM_REAL
alpha_store = 0._CUSTOM_REAL
-
+
ALPHA_MAX_PML = PI*f0_FOR_PML ! ELASTIC from Festa and Vilotte (2005)
ALPHA_MAX_PML = PI*f0_FOR_PML*2.0 ! ACOUSTIC from Festa and Vilotte (2005)
@@ -92,7 +92,7 @@
CPML_width_z = CPML_width
! determines equations of C-PML/mesh interface planes
- xoriginleft = minval(xstore(:)) + CPML_width_x
+ xoriginleft = minval(xstore(:)) + CPML_width_x
xoriginright = maxval(xstore(:)) - CPML_width_x
yoriginback = minval(ystore(:)) + CPML_width_y
yoriginfront = maxval(ystore(:)) - CPML_width_y
@@ -110,7 +110,7 @@
write(IMAIN,*) minval(ystore(:)), maxval(ystore(:))
write(IMAIN,*) minval(zstore(:)), maxval(zstore(:))
write(IMAIN,*)
- write(IMAIN,*) 'Origins of right/left X-surface C-PML',xoriginright,xoriginleft
+ write(IMAIN,*) 'Origins of right/left X-surface C-PML',xoriginright,xoriginleft
write(IMAIN,*) 'Origins of front/back Y-surface C-PML',yoriginfront,yoriginback
write(IMAIN,*) 'Origin of bottom Z-surface C-PML',zoriginbottom
if( PML_INSTEAD_OF_FREE_SURFACE ) then
@@ -120,7 +120,7 @@
write(IMAIN,*) 'CPML_width_x: ',CPML_width_x
write(IMAIN,*) 'CPML_width_y: ',CPML_width_y
write(IMAIN,*) 'CPML_width_z: ',CPML_width_z
- write(IMAIN,*)
+ write(IMAIN,*)
endif
call sync_all()
@@ -139,21 +139,21 @@
else
print*,'element index',ispec
print*,'C-PML element index ',ispec_CPML
- call exit_mpi(myrank,'C-PML error: element has an unvalid P-velocity')
+ call exit_mpi(myrank,'C-PML error: element has an unvalid P-velocity')
endif
iglob = ibool(i,j,k,ispec)
- if( CPML_regions(ispec_CPML) == 1 ) then
+ if( CPML_regions(ispec_CPML) == 1 ) then
!------------------------------------------------------------------------------
!---------------------------- X-surface C-PML ---------------------------------
!------------------------------------------------------------------------------
- if( xstore(iglob) .gt. 0.d0 ) then
+ if( xstore(iglob) > 0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xstore(iglob) - xoriginright
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -171,7 +171,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xoriginleft - xstore(iglob)
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -201,16 +201,16 @@
alpha_store(i,j,k,ispec_CPML) = alpha_x
- elseif( CPML_regions(ispec_CPML) == 2 ) then
+ elseif( CPML_regions(ispec_CPML) == 2 ) then
!------------------------------------------------------------------------------
!---------------------------- Y-surface C-PML ---------------------------------
!------------------------------------------------------------------------------
- if( ystore(iglob) .gt. 0.d0 ) then
+ if( ystore(iglob) > 0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = ystore(iglob) - yoriginfront
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -228,7 +228,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = yoriginback - ystore(iglob)
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -262,15 +262,15 @@
!---------------------------- Z-surface C-PML ---------------------------------
!------------------------------------------------------------------------------
- if( zstore(iglob) .gt. 0.d0 ) then
+ if( zstore(iglob) > 0.d0 ) then
if( PML_INSTEAD_OF_FREE_SURFACE ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zstore(iglob) - zorigintop
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
-
+
! gets damping profile at the C-PML element's GLL point
d_z = pml_damping_profile_l(myrank,iglob,dist,vp,CPML_width_z)
alpha_z = ALPHA_MAX_PML / 2.d0
@@ -285,7 +285,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zoriginbottom - zstore(iglob)
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -318,12 +318,12 @@
!------------------------------------------------------------------------------
!---------------------------- XY-edge C-PML -----------------------------------
!------------------------------------------------------------------------------
-
- if( xstore(iglob).gt.0.d0 .and. ystore(iglob).gt.0.d0 ) then
+
+ if( xstore(iglob)>0.d0 .and. ystore(iglob)>0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xstore(iglob) - xoriginright
-
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -340,7 +340,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = ystore(iglob) - yoriginfront
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -354,11 +354,11 @@
K_y = 1.d0
endif
- elseif( xstore(iglob).gt.0.d0 .and. ystore(iglob).lt.0.d0 ) then
+ elseif( xstore(iglob)>0.d0 .and. ystore(iglob)<0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xstore(iglob) - xoriginright
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -375,7 +375,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = yoriginback - ystore(iglob)
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -389,11 +389,11 @@
K_y = 1.d0
endif
- elseif( xstore(iglob).lt.0.d0 .and. ystore(iglob).gt.0.d0 ) then
+ elseif( xstore(iglob)<0.d0 .and. ystore(iglob)>0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xoriginleft - xstore(iglob)
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -410,7 +410,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = ystore(iglob) - yoriginfront
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -424,11 +424,11 @@
K_y = 1.d0
endif
- elseif( xstore(iglob).lt.0.d0 .and. ystore(iglob).lt.0.d0 ) then
+ elseif( xstore(iglob)<0.d0 .and. ystore(iglob)<0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xoriginleft - xstore(iglob)
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -445,7 +445,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = yoriginback - ystore(iglob)
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -480,12 +480,12 @@
!---------------------------- XZ-edge C-PML -----------------------------------
!------------------------------------------------------------------------------
- if( xstore(iglob).gt.0.d0 .and. zstore(iglob).gt.0.d0 ) then
+ if( xstore(iglob)>0.d0 .and. zstore(iglob)>0.d0 ) then
if( PML_INSTEAD_OF_FREE_SURFACE ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xstore(iglob) - xoriginright
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -502,7 +502,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zstore(iglob) - zorigintop
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -517,11 +517,11 @@
endif
endif
- elseif( xstore(iglob).gt.0.d0 .and. zstore(iglob).lt.0.d0 ) then
+ elseif( xstore(iglob)>0.d0 .and. zstore(iglob)<0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xstore(iglob) - xoriginright
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -538,7 +538,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zoriginbottom - zstore(iglob)
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -552,12 +552,12 @@
K_z = 1.d0
endif
- elseif( xstore(iglob).lt.0.d0 .and. zstore(iglob).gt.0.d0 ) then
+ elseif( xstore(iglob)<0.d0 .and. zstore(iglob)>0.d0 ) then
if( PML_INSTEAD_OF_FREE_SURFACE ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xoriginleft - xstore(iglob)
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -574,7 +574,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zstore(iglob) - zorigintop
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -589,11 +589,11 @@
endif
endif
- elseif( xstore(iglob).lt.0.d0 .and. zstore(iglob).lt.0.d0 ) then
+ elseif( xstore(iglob)<0.d0 .and. zstore(iglob)<0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xoriginleft - xstore(iglob)
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -610,7 +610,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zoriginbottom - zstore(iglob)
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -644,12 +644,12 @@
!---------------------------- YZ-edge C-PML -----------------------------------
!------------------------------------------------------------------------------
- if( ystore(iglob).gt.0.d0 .and. zstore(iglob).gt.0.d0 ) then
+ if( ystore(iglob)>0.d0 .and. zstore(iglob)>0.d0 ) then
if( PML_INSTEAD_OF_FREE_SURFACE ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = ystore(iglob) - yoriginfront
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -666,7 +666,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zstore(iglob) - zorigintop
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -681,11 +681,11 @@
endif
endif
- elseif( ystore(iglob).gt.0.d0 .and. zstore(iglob).lt.0.d0 ) then
+ elseif( ystore(iglob)>0.d0 .and. zstore(iglob)<0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = ystore(iglob) - yoriginfront
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -702,7 +702,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zoriginbottom - zstore(iglob)
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -716,12 +716,12 @@
K_z = 1.d0
endif
- elseif( ystore(iglob).lt.0.d0 .and. zstore(iglob).gt.0.d0 ) then
+ elseif( ystore(iglob)<0.d0 .and. zstore(iglob)>0.d0 ) then
if( PML_INSTEAD_OF_FREE_SURFACE ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = yoriginback - ystore(iglob)
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -738,7 +738,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zstore(iglob) - zorigintop
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -753,11 +753,11 @@
endif
endif
- elseif( ystore(iglob).lt.0.d0 .and. zstore(iglob).lt.0.d0 ) then
+ elseif( ystore(iglob)<0.d0 .and. zstore(iglob)<0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = yoriginback - ystore(iglob)
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -774,7 +774,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zoriginbottom - zstore(iglob)
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -807,12 +807,12 @@
!---------------------------- XYZ-corner C-PML --------------------------------
!------------------------------------------------------------------------------
- if( xstore(iglob).gt.0.d0 .and. ystore(iglob).gt.0.d0 .and. zstore(iglob).gt.0.d0 ) then
+ if( xstore(iglob)>0.d0 .and. ystore(iglob)>0.d0 .and. zstore(iglob)>0.d0 ) then
if( PML_INSTEAD_OF_FREE_SURFACE ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xstore(iglob) - xoriginright
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -829,7 +829,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = ystore(iglob) - yoriginfront
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -846,7 +846,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zstore(iglob) - zorigintop
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -861,11 +861,11 @@
endif
endif
- elseif( xstore(iglob).gt.0.d0 .and. ystore(iglob).gt.0.d0 .and. zstore(iglob).lt.0.d0 ) then
+ elseif( xstore(iglob)>0.d0 .and. ystore(iglob)>0.d0 .and. zstore(iglob)<0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xstore(iglob) - xoriginright
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -882,7 +882,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = ystore(iglob) - yoriginfront
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -899,7 +899,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zoriginbottom - zstore(iglob)
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -913,12 +913,12 @@
K_z = 1.d0
endif
- elseif( xstore(iglob).gt.0.d0 .and. ystore(iglob).lt.0.d0 .and. zstore(iglob).gt.0.d0 ) then
+ elseif( xstore(iglob)>0.d0 .and. ystore(iglob)<0.d0 .and. zstore(iglob)>0.d0 ) then
if( PML_INSTEAD_OF_FREE_SURFACE ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xstore(iglob) - xoriginright
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -928,14 +928,14 @@
K_x = 1.d0 + (K_MAX_PML - 1.d0) * dist**NPOWER
else
d_x = 0.d0
- alpha_x = 0.d0
+ alpha_x = 0.d0
K_x = 1.d0
endif
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = yoriginback - ystore(iglob)
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -952,7 +952,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zstore(iglob) - zorigintop
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -967,11 +967,11 @@
endif
endif
- elseif( xstore(iglob).gt.0.d0 .and. ystore(iglob).lt.0.d0 .and. zstore(iglob) .lt. 0.d0 ) then
+ elseif( xstore(iglob)>0.d0 .and. ystore(iglob)<0.d0 .and. zstore(iglob) < 0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xstore(iglob) - xoriginright
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -988,7 +988,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = yoriginback - ystore(iglob)
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -1005,7 +1005,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zoriginbottom - zstore(iglob)
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -1019,12 +1019,12 @@
K_z = 1.d0
endif
- elseif( xstore(iglob).lt.0.d0 .and. ystore(iglob).gt.0.d0 .and. zstore(iglob).gt.0.d0 ) then
+ elseif( xstore(iglob)<0.d0 .and. ystore(iglob)>0.d0 .and. zstore(iglob)>0.d0 ) then
if( PML_INSTEAD_OF_FREE_SURFACE ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xoriginleft - xstore(iglob)
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -1041,7 +1041,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = ystore(iglob) - yoriginfront
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -1058,7 +1058,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zstore(iglob) - zorigintop
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -1073,11 +1073,11 @@
endif
endif
- elseif( xstore(iglob).lt.0.d0 .and. ystore(iglob).gt.0.d0 .and. zstore(iglob).lt.0.d0 ) then
+ elseif( xstore(iglob)<0.d0 .and. ystore(iglob)>0.d0 .and. zstore(iglob)<0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xoriginleft - xstore(iglob)
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -1094,7 +1094,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = ystore(iglob) - yoriginfront
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -1111,7 +1111,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zoriginbottom - zstore(iglob)
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -1125,12 +1125,12 @@
K_z = 1.d0
endif
- elseif( xstore(iglob).lt.0.d0 .and. ystore(iglob).lt.0.d0 .and. zstore(iglob).gt.0.d0 ) then
+ elseif( xstore(iglob)<0.d0 .and. ystore(iglob)<0.d0 .and. zstore(iglob)>0.d0 ) then
if( PML_INSTEAD_OF_FREE_SURFACE ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xoriginleft - xstore(iglob)
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -1140,14 +1140,14 @@
K_x = 1.d0 + (K_MAX_PML - 1.d0) * dist**NPOWER
else
d_x = 0.d0
- alpha_x = 0.d0
+ alpha_x = 0.d0
K_x = 1.d0
endif
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = yoriginback - ystore(iglob)
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -1164,7 +1164,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zstore(iglob) - zorigintop
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -1179,11 +1179,11 @@
endif
endif
- elseif( xstore(iglob).lt.0.d0 .and. ystore(iglob).lt.0.d0 .and. zstore(iglob) .lt. 0.d0 ) then
+ elseif( xstore(iglob)<0.d0 .and. ystore(iglob)<0.d0 .and. zstore(iglob) < 0.d0 ) then
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_x = xoriginleft - xstore(iglob)
- if( abscissa_in_PML_x .ge. 0.d0 ) then
+ if( abscissa_in_PML_x >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_x / CPML_width_x
@@ -1200,7 +1200,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_y = yoriginback - ystore(iglob)
- if( abscissa_in_PML_y .ge. 0.d0 ) then
+ if( abscissa_in_PML_y >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_y / CPML_width_y
@@ -1217,7 +1217,7 @@
! gets abscissa of current grid point along the damping profile
abscissa_in_PML_z = zoriginbottom - zstore(iglob)
- if( abscissa_in_PML_z .ge. 0.d0 ) then
+ if( abscissa_in_PML_z >= 0.d0 ) then
! determines distance to C-PML/mesh interface
dist = abscissa_in_PML_z / CPML_width_z
@@ -1275,11 +1275,11 @@
real(kind=CUSTOM_REAL) :: pml_damping_profile_l
! gets damping profile
- if( NPOWER .ge. 1 ) then
+ if( NPOWER >= 1 ) then
! INRIA research report section 6.1: http://hal.inria.fr/docs/00/07/32/19/PDF/RR-3471.pdf
pml_damping_profile_l = - ((NPOWER + 1) * vp * log(CPML_Rcoef) / (2.d0 * delta) * damping_factor) * dist**NPOWER
else
- call exit_mpi(myrank,'C-PML error: NPOWER must be greater than or equal to 1')
+ call exit_mpi(myrank,'C-PML error: NPOWER must be greater than or equal to 1')
endif
!!$ JC JC (from Daniel in his PML_init.f90 file) dominant wavelength has to be set differently
@@ -1302,7 +1302,7 @@
print*,'C-PML thickness ',delta
call exit_mpi(myrank,'C-PML error: thickness of C-PML layer is out of bounds')
!!$ else if( delta < dominant_wavelength/2.0 ) then ! JC JC
-!!$ print*,'dominant wavelength/2 ',dominant_wavelength/2.0
+!!$ print*,'dominant wavelength/2 ',dominant_wavelength/2.0
!!$ print*,'C-PML thickness ',delta
!!$ call exit_mpi(myrank,'C-PML error: thickness of C-PML layer must be set according to dominant wavelength')
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/read_partition_files.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/read_partition_files.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/read_partition_files.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -231,7 +231,7 @@
! reads thickness of C-PML layers for the global mesh
read(IIN) CPML_width
- ! reads C-PML regions and C-PML spectral elements global indexing
+ ! reads C-PML regions and C-PML spectral elements global indexing
allocate(CPML_to_spec(nspec_cpml),stat=ier)
if(ier /= 0) stop 'error allocating array CPML_to_spec'
allocate(CPML_regions(nspec_cpml),stat=ier)
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in 2013-03-09 01:15:50 UTC (rev 21479)
@@ -306,6 +306,11 @@
integer, parameter :: ATTENUATION_COMP_RESOLUTION = 1
integer, parameter :: ATTENUATION_COMP_MAXIMUM = 9000
+! Add Q_Kappa effect in viscoelastic simulation
+ logical, parameter :: FULL_ATTENUATION_SOLID = .true.
+ real(kind=CUSTOM_REAL), parameter :: CONST_Q_KAPPA = 120._CUSTOM_REAL
+
+
! reference frequency for target velocity values in velocity model
! arbitrarily set to typical resolution of model (3 sec)
double precision, parameter :: ATTENUATION_f0_REFERENCE = 0.3d0
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/force_ftz.c
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/force_ftz.c 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/force_ftz.c 2013-03-09 01:15:50 UTC (rev 21479)
@@ -74,5 +74,5 @@
x |= (1 << UNDERFLOW_EXCEPTION_MASK);
_mm_setcsr(x);
#endif
-#endif // __GNUC__
+#endif // __GNUC__
}
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/get_attenuation_model.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/get_attenuation_model.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/get_attenuation_model.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -113,7 +113,7 @@
!
subroutine get_attenuation_model(myrank,nspec,USE_OLSEN_ATTENUATION,OLSEN_ATTENUATION_RATIO, &
- mustore,rho_vs,qmu_attenuation_store, &
+ mustore,rho_vs,kappastore,rho_vp,qmu_attenuation_store, & !ZN
ispec_is_elastic,min_resolved_period,prname)
! precalculates attenuation arrays and stores arrays into files
@@ -130,6 +130,9 @@
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,nspec) :: rho_vs
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,nspec) :: qmu_attenuation_store
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,nspec) :: kappastore !ZN
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,nspec) :: rho_vp !ZN
+
logical, dimension(nspec) :: ispec_is_elastic
real(kind=CUSTOM_REAL) :: min_resolved_period
character(len=256) :: prname
@@ -137,16 +140,19 @@
! local parameters
real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: one_minus_sum_beta
real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: factor_common
- real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: scale_factor
- double precision, dimension(N_SLS) :: tau_sigma_dble,beta_dble
- double precision factor_scale_dble,one_minus_sum_beta_dble
- double precision :: Q_mu
+ real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: one_minus_sum_beta_kappa !ZN
+ real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: factor_common_kappa !ZN
+ real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: scale_factor, scale_factor_kappa
+ double precision, dimension(N_SLS) :: tau_sigma_dble,beta_dble,beta_dble_kappa
+ double precision factor_scale_dble,one_minus_sum_beta_dble,&
+ factor_scale_dble_kappa,one_minus_sum_beta_dble_kappa
+ double precision :: Q_mu,Q_kappa,Q_p,Q_s !ZN
double precision :: f_c_source
double precision :: MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD
real(kind=CUSTOM_REAL), dimension(N_SLS) :: tau_sigma
real(kind=CUSTOM_REAL), dimension(N_SLS) :: tauinv
- real(kind=CUSTOM_REAL), dimension(N_SLS) :: beta
- real(kind=CUSTOM_REAL):: vs_val
+ real(kind=CUSTOM_REAL), dimension(N_SLS) :: beta,beta_kappa
+ real(kind=CUSTOM_REAL):: vs_val,vp_val !ZN
integer :: i,j,k,ispec,ier
double precision :: qmin,qmax,qmin_all,qmax_all
@@ -156,10 +162,25 @@
scale_factor(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
if( ier /= 0 ) call exit_mpi(myrank,'error allocation attenuation arrays')
+ if(FULL_ATTENUATION_SOLID)then !ZN
+ allocate(one_minus_sum_beta_kappa(NGLLX,NGLLY,NGLLZ,nspec), & !ZN
+ factor_common_kappa(N_SLS,NGLLX,NGLLY,NGLLZ,nspec), & !ZN
+ scale_factor_kappa(NGLLX,NGLLY,NGLLZ,nspec),stat=ier) !ZN
+ if( ier /= 0 ) call exit_mpi(myrank,'error allocation attenuation arrays') !ZN
+ else
+ allocate(one_minus_sum_beta_kappa(NGLLX,NGLLY,NGLLZ,1), & !ZN
+ factor_common_kappa(N_SLS,NGLLX,NGLLY,NGLLZ,1), & !ZN
+ scale_factor_kappa(NGLLX,NGLLY,NGLLZ,1),stat=ier) !ZN
+ if( ier /= 0 ) call exit_mpi(myrank,'error allocation attenuation arrays') !ZN
+ endif !ZN
+
one_minus_sum_beta(:,:,:,:) = 1._CUSTOM_REAL
factor_common(:,:,:,:,:) = 1._CUSTOM_REAL
scale_factor(:,:,:,:) = 1._CUSTOM_REAL
+ one_minus_sum_beta_kappa(:,:,:,:) = 1._CUSTOM_REAL !ZN
+ factor_common_kappa(:,:,:,:,:) = 1._CUSTOM_REAL !ZN
+ scale_factor_kappa(:,:,:,:) = 1._CUSTOM_REAL !ZN
! gets stress relaxation times tau_sigma, i.e.
! precalculates tau_sigma depending on period band (constant for all Q_mu), and
@@ -206,27 +227,44 @@
! use scaling rule similar to Olsen et al. (2003)
vs_val = mustore(i,j,k,ispec) / rho_vs(i,j,k,ispec)
call get_attenuation_model_olsen(vs_val,Q_mu,OLSEN_ATTENUATION_RATIO)
+ if(FULL_ATTENUATION_SOLID)then
+ vp_val = (kappastore(i,j,k,ispec) + 2.0d0 * mustore(i,j,k,ispec) / 3.0d0) / rho_vp(i,j,k,ispec)
+ Q_s = Q_mu
+ Q_p = 1.5d0 * Q_s
+ Q_kappa = 1.0d0 / ((1.0/Q_p - 4.0d0/3.0d0*(vp_val/vs_val)**2*(1.d0/Q_mu)) /(1.0d0 - 4.0d0/3.0d0*(vp_val/vs_val)**2))
+ if( Q_kappa < 1.0d0 ) Q_kappa = 1.0d0 !ZN
+ if( Q_kappa > ATTENUATION_COMP_MAXIMUM ) Q_kappa = ATTENUATION_COMP_MAXIMUM !ZN
+ endif
else
! takes Q set in (CUBIT) mesh
Q_mu = qmu_attenuation_store(i,j,k,ispec)
+ Q_kappa = CONST_Q_KAPPA !ZN
! attenuation zero
if( Q_mu <= 1.e-5 ) cycle
+ if( Q_kappa <= 1.e-5 ) cycle !ZN
! limits Q
if( Q_mu < 1.0d0 ) Q_mu = 1.0d0
if( Q_mu > ATTENUATION_COMP_MAXIMUM ) Q_mu = ATTENUATION_COMP_MAXIMUM
+ if( Q_kappa < 1.0d0 ) Q_kappa = 1.0d0 !ZN
+ if( Q_kappa > ATTENUATION_COMP_MAXIMUM ) Q_kappa = ATTENUATION_COMP_MAXIMUM !ZN
+
endif
! statistics
if( Q_mu < qmin ) qmin = Q_mu
if( Q_mu > qmax ) qmax = Q_mu
+ if( Q_kappa < qmin ) qmin = CONST_Q_KAPPA !ZN
+ if( Q_kappa > qmax ) qmax = CONST_Q_KAPPA !ZN
+
! gets beta, on_minus_sum_beta and factor_scale
! based on calculation of strain relaxation times tau_eps
call get_attenuation_factors(myrank,Q_mu,MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD, &
f_c_source,tau_sigma_dble, &
- beta_dble,one_minus_sum_beta_dble,factor_scale_dble)
+ beta_dble,one_minus_sum_beta_dble,factor_scale_dble,&
+ Q_kappa,beta_dble_kappa,one_minus_sum_beta_dble_kappa,factor_scale_dble_kappa) !ZN
! stores factor for unrelaxed parameter
one_minus_sum_beta(i,j,k,ispec) = one_minus_sum_beta_dble
@@ -241,6 +279,15 @@
! stores scale factor for mu moduli
scale_factor(i,j,k,ispec) = factor_scale_dble
+ if(FULL_ATTENUATION_SOLID)then !ZN
+ one_minus_sum_beta_kappa(i,j,k,ispec) = one_minus_sum_beta_dble_kappa !ZN
+ beta_kappa(:) = beta_dble_kappa(:) !ZN
+ factor_common_kappa(:,i,j,k,ispec) = beta_kappa(:) * tauinv(:) !ZN
+
+ ! stores scale factor for mu moduli !ZN
+ scale_factor_kappa(i,j,k,ispec) = factor_scale_dble_kappa !ZN
+ endif !ZN
+
enddo
enddo
enddo
@@ -257,10 +304,21 @@
write(27) one_minus_sum_beta
write(27) factor_common
write(27) scale_factor
+
+ if(FULL_ATTENUATION_SOLID)then !ZN
+ write(27) one_minus_sum_beta_kappa !ZN
+ write(27) factor_common_kappa !ZN
+ write(27) scale_factor_kappa !ZN
+ endif !ZN
+
close(27)
deallocate(one_minus_sum_beta,factor_common,scale_factor)
+ if(FULL_ATTENUATION_SOLID)then !ZN
+ deallocate(one_minus_sum_beta_kappa,factor_common_kappa,scale_factor_kappa) !ZN
+ endif !ZN
+
! statistics
call min_all_dp(qmin,qmin_all)
call max_all_dp(qmax,qmax_all)
@@ -358,7 +416,8 @@
subroutine get_attenuation_factors(myrank,Q_mu,MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD, &
f_c_source,tau_sigma, &
- beta,one_minus_sum_beta,factor_scale)
+ beta,one_minus_sum_beta,factor_scale,& !ZN
+ Q_kappa,beta_kappa,one_minus_sum_beta_kappa,factor_scale_kappa) !ZN
! returns: attenuation mechanisms beta,one_minus_sum_beta,factor_scale
@@ -376,14 +435,16 @@
integer:: myrank
double precision :: MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD
- double precision :: f_c_source,Q_mu
+ double precision :: f_c_source,Q_mu,Q_kappa !ZN
double precision, dimension(N_SLS) :: tau_sigma
- double precision, dimension(N_SLS) :: beta
- double precision :: one_minus_sum_beta
- double precision :: factor_scale
+ double precision, dimension(N_SLS) :: beta,beta_kappa !ZN
+ double precision :: one_minus_sum_beta,one_minus_sum_beta_kappa !ZN
+ double precision :: factor_scale,factor_scale_kappa !ZN
! local parameters
- double precision, dimension(N_SLS) :: tau_eps
+ double precision, dimension(N_SLS) :: tau_eps,tau_eps_kappa
+
+
! determines tau_eps for Q_mu
call get_attenuation_tau_eps(Q_mu,tau_sigma,tau_eps, &
MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD)
@@ -394,6 +455,18 @@
! determines the "scale factor"
call get_attenuation_scale_factor(myrank,f_c_source,tau_eps,tau_sigma,Q_mu,factor_scale)
+ if(FULL_ATTENUATION_SOLID)then !ZN
+ ! determines tau_eps for Q_kappa
+ call get_attenuation_tau_eps(Q_kappa,tau_sigma,tau_eps_kappa, & !ZN
+ MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD) !ZN
+
+ ! determines one_minus_sum_beta
+ call get_attenuation_property_values(tau_sigma,tau_eps_kappa,beta_kappa,one_minus_sum_beta_kappa) !ZN
+
+ ! determines the "scale factor"
+ call get_attenuation_scale_factor(myrank,f_c_source,tau_eps_kappa,tau_sigma,Q_kappa,factor_scale_kappa) !ZN
+ endif !ZN
+
end subroutine get_attenuation_factors
!
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/get_force.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/get_force.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/get_force.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -140,7 +140,7 @@
! check (inclined) force source's direction vector
length = sqrt( comp_dir_vect_source_E(isource)**2 + comp_dir_vect_source_N(isource)**2 + &
comp_dir_vect_source_Z_UP(isource)**2 )
- if( length < TINYVAL) then
+ if( length < TINYVAL) then
print *, 'normal length: ', length
print *, 'isource: ',isource
stop 'error set force point normal length, make sure all forces have a non null direction vector'
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/read_parameter_file.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/read_parameter_file.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/read_parameter_file.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -174,7 +174,7 @@
if(err_occurred() /= 0) return
call read_value_logical(PRINT_SOURCE_TIME_FUNCTION, 'solver.PRINT_SOURCE_TIME_FUNCTION')
if(err_occurred() /= 0) return
-
+
! close parameter file
call close_parameter_file()
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/read_value_parameters.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/read_value_parameters.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/read_value_parameters.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -36,7 +36,7 @@
common /param_err_common/ ierr
call param_read(string_read, len(string_read), name, len(name), ierr)
- if (ierr .ne. 0) return
+ if (ierr /= 0) return
read(string_read,*) value_to_read
end subroutine read_value_integer
@@ -54,7 +54,7 @@
common /param_err_common/ ierr
call param_read(string_read, len(string_read), name, len(name), ierr)
- if (ierr .ne. 0) return
+ if (ierr /= 0) return
read(string_read,*) value_to_read
end subroutine read_value_double_precision
@@ -72,7 +72,7 @@
common /param_err_common/ ierr
call param_read(string_read, len(string_read), name, len(name), ierr)
- if (ierr .ne. 0) return
+ if (ierr /= 0) return
read(string_read,*) value_to_read
end subroutine read_value_logical
@@ -90,7 +90,7 @@
common /param_err_common/ ierr
call param_read(string_read, len(string_read), name, len(name), ierr)
- if (ierr .ne. 0) return
+ if (ierr /= 0) return
value_to_read = string_read
end subroutine read_value_string
@@ -106,7 +106,7 @@
filename = IN_DATA_FILES_PATH(1:len_trim(IN_DATA_FILES_PATH))//'Par_file'
call param_open(filename, len(filename), ierr);
- if (ierr .ne. 0) return
+ if (ierr /= 0) return
end subroutine open_parameter_file
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/assemble_MPI_vector.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/assemble_MPI_vector.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/assemble_MPI_vector.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -842,7 +842,7 @@
! assemble only if more than one partition
if (NPROC == 1) return
-! move interface values of array_val to local buffers
+! move interface values of array_val to local buffers
do iinterface = 1, num_interfaces_ext_mesh
do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
iglob = ibool_interfaces_ext_mesh(ipoin,iinterface)
@@ -877,7 +877,7 @@
contains
subroutine add_my_contrib()
-
+
integer :: my_iinterface,my_ipoin
do my_iinterface = 1, num_interfaces_ext_mesh
@@ -887,7 +887,7 @@
enddo
enddo
need_add_my_contrib = .false.
-
+
end subroutine add_my_contrib
end subroutine assemble_MPI_vector_ext_mesh_w_ordered
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_viscoelastic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_viscoelastic.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_viscoelastic.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -449,7 +449,7 @@
if(USE_FORCE_POINT_SOURCE) then
- !f0 = hdur(isource) !! using hdur as a FREQUENCY
+ !f0 = hdur(isource) !! using hdur as a FREQUENCY
!if (it == 1 .and. myrank == 0) then
! write(IMAIN,*) 'using a source of dominant frequency ',f0
! write(IMAIN,*) 'lambda_S at dominant frequency = ',3000./sqrt(3.)/f0
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_poroelastic_el.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_poroelastic_el.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_poroelastic_el.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -294,7 +294,7 @@
k = coupling_el_po_ijk(3,igll,iface)
iglob_po = ibool(i,j,k,ispec_po)
- if (iglob_el .ne. iglob_po) stop 'poroelastic-elastic coupling error'
+ if (iglob_el /= iglob_po) stop 'poroelastic-elastic coupling error'
! get poroelastic parameters of current local GLL
phil = phistore(i,j,k,ispec_po)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_viscoelastic_po.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_viscoelastic_po.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_viscoelastic_po.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -347,7 +347,7 @@
! (note: should be the same as for corresponding
! i',j',k',ispec_poroelastic or ispec_elastic )
iglob_el = ibool(i,j,k,ispec_el)
- if (iglob_el .ne. iglob_po) stop 'poroelastic-elastic coupling error'
+ if (iglob_el /= iglob_po) stop 'poroelastic-elastic coupling error'
tempx1l = 0.
tempx2l = 0.
tempx3l = 0.
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_noDev.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_noDev.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_noDev.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -284,7 +284,7 @@
enddo ! end of loop over all spectral elements
- ! C-PML boundary
+ ! C-PML boundary
if( PML_CONDITIONS ) then
! xmin
do ispec2D=1,nspec2D_xmin
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_Dev.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_Dev.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_Dev.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -34,10 +34,14 @@
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
kappastore,mustore,jacobian,ibool, &
ATTENUATION,deltat, &
- one_minus_sum_beta,factor_common,alphaval,betaval,gammaval,&
- NSPEC_ATTENUATION_AB, &
- R_xx,R_yy,R_xy,R_xz,R_yz, &
- epsilondev_xx,epsilondev_yy,epsilondev_xy, &
+ one_minus_sum_beta,factor_common,&
+ one_minus_sum_beta_kappa,factor_common_kappa,& !ZN
+ alphaval,betaval,gammaval,& !ZN
+ NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_Kappa, &
+!ZN R_xx,R_yy,R_xy,R_xz,R_yz, &
+ R_trace,R_xx,R_yy,R_xy,R_xz,R_yz, & !ZN
+!ZN epsilondev_xx,epsilondev_yy,epsilondev_xy, &
+ epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy, & !ZN
epsilondev_xz,epsilondev_yz,epsilon_trace_over_3, &
ANISOTROPY,NSPEC_ANISO, &
c11store,c12store,c13store,c14store,c15store,c16store,&
@@ -57,7 +61,7 @@
use constants,only: CUSTOM_REAL,NGLLX,NGLLY,NGLLZ,NDIM, &
N_SLS,SAVE_MOHO_MESH, &
- ONE_THIRD,FOUR_THIRDS,m1,m2
+ ONE_THIRD,FOUR_THIRDS,m1,m2,FULL_ATTENUATION_SOLID,CONST_Q_KAPPA,IOUT
use fault_solver_dynamic, only : Kelvin_Voigt_eta
implicit none
@@ -88,16 +92,20 @@
logical :: ATTENUATION
logical :: COMPUTE_AND_STORE_STRAIN
integer :: NSPEC_STRAIN_ONLY, NSPEC_ADJOINT
- integer :: NSPEC_ATTENUATION_AB
+ integer :: NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_Kappa
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB) :: one_minus_sum_beta
real(kind=CUSTOM_REAL), dimension(N_SLS,NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB) :: factor_common
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_Kappa) :: one_minus_sum_beta_kappa !ZN
+ real(kind=CUSTOM_REAL), dimension(N_SLS,NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_Kappa) :: factor_common_kappa !ZN
real(kind=CUSTOM_REAL), dimension(N_SLS) :: alphaval,betaval,gammaval
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB,N_SLS) :: &
R_xx,R_yy,R_xy,R_xz,R_yz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_Kappa,N_SLS) :: R_trace !ZN
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_STRAIN_ONLY) :: &
epsilondev_xx,epsilondev_yy,epsilondev_xy,epsilondev_xz,epsilondev_yz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_Kappa) :: epsilondev_trace !ZN
real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT) :: epsilon_trace_over_3
! anisotropy
@@ -191,9 +199,10 @@
equivalence(tempz3_att,C3_mxm_m2_m1_5points_att)
! local attenuation parameters
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: epsilondev_xx_loc, &
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: epsilondev_trace_loc,epsilondev_xx_loc, & !ZN
epsilondev_yy_loc, epsilondev_xy_loc, epsilondev_xz_loc, epsilondev_yz_loc
- real(kind=CUSTOM_REAL) R_xx_val1,R_yy_val1,R_xx_val2,R_yy_val2,R_xx_val3,R_yy_val3
+ real(kind=CUSTOM_REAL) R_xx_val1,R_yy_val1,R_xx_val2,R_yy_val2,R_xx_val3,R_yy_val3, & !ZN
+ R_trace_val1,R_trace_val2,R_trace_val3 !ZN
real(kind=CUSTOM_REAL) factor_loc,alphaval_loc,betaval_loc,gammaval_loc
real(kind=CUSTOM_REAL) Sn,Snp1
real(kind=CUSTOM_REAL) templ
@@ -248,7 +257,7 @@
! stores displacment values in local array
if (allocated(Kelvin_Voigt_eta)) then
- eta = Kelvin_Voigt_eta(ispec)
+ eta = Kelvin_Voigt_eta(ispec)
do k=1,NGLLZ
do j=1,NGLLY
do i=1,NGLLX
@@ -273,7 +282,7 @@
enddo
endif
- ! use first order Taylor expansion of displacement for local storage of stresses
+ ! use first order Taylor expansion of displacement for local storage of stresses
! at this current time step, to fix attenuation in a consistent way
if(ATTENUATION .and. COMPUTE_AND_STORE_STRAIN) then
do k=1,NGLLZ
@@ -316,7 +325,7 @@
! temporary variables used for fixing attenuation in a consistent way
do j=1,m2
do i=1,m1
- C1_m1_m2_5points_att(i,j) = C1_m1_m2_5points(i,j) + &
+ C1_m1_m2_5points_att(i,j) = C1_m1_m2_5points(i,j) + &
hprime_xx(i,1)*B1_m1_m2_5points_att(1,j) + &
hprime_xx(i,2)*B1_m1_m2_5points_att(2,j) + &
hprime_xx(i,3)*B1_m1_m2_5points_att(3,j) + &
@@ -527,6 +536,7 @@
! compute deviatoric strain
templ = ONE_THIRD * (duxdxl_att + duydyl_att + duzdzl_att)
if( SIMULATION_TYPE == 3 ) epsilon_trace_over_3(i,j,k,ispec) = templ
+ if(FULL_ATTENUATION_SOLID) epsilondev_trace_loc(i,j,k) = 3.0 * templ
epsilondev_xx_loc(i,j,k) = duxdxl_att - templ
epsilondev_yy_loc(i,j,k) = duydyl_att - templ
epsilondev_xy_loc(i,j,k) = 0.5 * duxdyl_plus_duydxl_att
@@ -537,6 +547,7 @@
if (COMPUTE_AND_STORE_STRAIN) then
templ = ONE_THIRD * (duxdxl + duydyl + duzdzl)
if( SIMULATION_TYPE == 3 ) epsilon_trace_over_3(i,j,k,ispec) = templ
+ if(FULL_ATTENUATION_SOLID) epsilondev_trace_loc(i,j,k) = 3.0 * templ
epsilondev_xx_loc(i,j,k) = duxdxl - templ
epsilondev_yy_loc(i,j,k) = duydyl - templ
epsilondev_xy_loc(i,j,k) = 0.5 * duxdyl_plus_duydxl
@@ -552,6 +563,9 @@
if(ATTENUATION) then
! use unrelaxed parameters if attenuation
mul = mul * one_minus_sum_beta(i,j,k,ispec)
+ if(FULL_ATTENUATION_SOLID) then !ZN
+ kappal = kappal * one_minus_sum_beta_kappa(i,j,k,ispec) !ZN
+ endif !ZN
endif
! full anisotropic case, stress calculations
@@ -628,11 +642,16 @@
! by default, N_SLS = 3, therefore we take steps of 3
if(imodulo_N_SLS >= 1) then
do i_sls = 1,imodulo_N_SLS
+ if(FULL_ATTENUATION_SOLID) then !! ZN: for performance, it would be better to avoid "if" statements inside loops
+ R_trace_val1 = R_trace(i,j,k,ispec,i_sls)
+ else
+ R_trace_val1 = 0.
+ endif
R_xx_val1 = R_xx(i,j,k,ispec,i_sls)
R_yy_val1 = R_yy(i,j,k,ispec,i_sls)
- sigma_xx = sigma_xx - R_xx_val1
- sigma_yy = sigma_yy - R_yy_val1
- sigma_zz = sigma_zz + R_xx_val1 + R_yy_val1
+ sigma_xx = sigma_xx - R_xx_val1 - R_trace_val1
+ sigma_yy = sigma_yy - R_yy_val1 - R_trace_val1
+ sigma_zz = sigma_zz + R_xx_val1 + R_yy_val1 - R_trace_val1
sigma_xy = sigma_xy - R_xy(i,j,k,ispec,i_sls)
sigma_xz = sigma_xz - R_xz(i,j,k,ispec,i_sls)
sigma_yz = sigma_yz - R_yz(i,j,k,ispec,i_sls)
@@ -641,29 +660,43 @@
if(N_SLS >= imodulo_N_SLS+1) then
do i_sls = imodulo_N_SLS+1,N_SLS,3
+ if(FULL_ATTENUATION_SOLID) then !! ZN: for performance, it would be better to avoid "if" statements inside loops
+ R_trace_val1 = R_trace(i,j,k,ispec,i_sls)
+ else
+ R_trace_val1 = 0.
+ endif
R_xx_val1 = R_xx(i,j,k,ispec,i_sls)
R_yy_val1 = R_yy(i,j,k,ispec,i_sls)
- sigma_xx = sigma_xx - R_xx_val1
- sigma_yy = sigma_yy - R_yy_val1
- sigma_zz = sigma_zz + R_xx_val1 + R_yy_val1
+ sigma_xx = sigma_xx - R_xx_val1 - R_trace_val1
+ sigma_yy = sigma_yy - R_yy_val1 - R_trace_val1
+ sigma_zz = sigma_zz + R_xx_val1 + R_yy_val1 - R_trace_val1
sigma_xy = sigma_xy - R_xy(i,j,k,ispec,i_sls)
sigma_xz = sigma_xz - R_xz(i,j,k,ispec,i_sls)
sigma_yz = sigma_yz - R_yz(i,j,k,ispec,i_sls)
-
+ if(FULL_ATTENUATION_SOLID) then
+ R_trace_val2 = R_trace(i,j,k,ispec,i_sls+1)
+ else
+ R_trace_val2 = 0.
+ endif
R_xx_val2 = R_xx(i,j,k,ispec,i_sls+1)
R_yy_val2 = R_yy(i,j,k,ispec,i_sls+1)
- sigma_xx = sigma_xx - R_xx_val2
- sigma_yy = sigma_yy - R_yy_val2
- sigma_zz = sigma_zz + R_xx_val2 + R_yy_val2
+ sigma_xx = sigma_xx - R_xx_val2 - R_trace_val2
+ sigma_yy = sigma_yy - R_yy_val2 - R_trace_val2
+ sigma_zz = sigma_zz + R_xx_val2 + R_yy_val2 - R_trace_val2
sigma_xy = sigma_xy - R_xy(i,j,k,ispec,i_sls+1)
sigma_xz = sigma_xz - R_xz(i,j,k,ispec,i_sls+1)
sigma_yz = sigma_yz - R_yz(i,j,k,ispec,i_sls+1)
+ if(FULL_ATTENUATION_SOLID) then
+ R_trace_val3 = R_trace(i,j,k,ispec,i_sls+2)
+ else
+ R_trace_val3 = 0.
+ endif
R_xx_val3 = R_xx(i,j,k,ispec,i_sls+2)
R_yy_val3 = R_yy(i,j,k,ispec,i_sls+2)
- sigma_xx = sigma_xx - R_xx_val3
- sigma_yy = sigma_yy - R_yy_val3
- sigma_zz = sigma_zz + R_xx_val3 + R_yy_val3
+ sigma_xx = sigma_xx - R_xx_val3 - R_trace_val3
+ sigma_yy = sigma_yy - R_yy_val3 - R_trace_val3
+ sigma_zz = sigma_zz + R_xx_val3 + R_yy_val3 - R_trace_val3
sigma_xy = sigma_xy - R_xy(i,j,k,ispec,i_sls+2)
sigma_xz = sigma_xz - R_xz(i,j,k,ispec,i_sls+2)
sigma_yz = sigma_yz - R_yz(i,j,k,ispec,i_sls+2)
@@ -788,12 +821,23 @@
! use Runge-Kutta scheme to march in time
do i_sls = 1,N_SLS
- factor_loc = mustore(i,j,k,ispec) * factor_common(i_sls,i,j,k,ispec)
-
alphaval_loc = alphaval(i_sls)
betaval_loc = betaval(i_sls)
gammaval_loc = gammaval(i_sls)
+ if(FULL_ATTENUATION_SOLID) then
+ ! term in trace !ZN
+ factor_loc = kappastore(i,j,k,ispec) * factor_common_kappa(i_sls,i,j,k,ispec) !ZN
+
+ Sn = factor_loc * epsilondev_trace(i,j,k,ispec) !ZN
+ Snp1 = factor_loc * epsilondev_trace_loc(i,j,k) !ZN
+ R_trace(i,j,k,ispec,i_sls) = alphaval_loc * R_trace(i,j,k,ispec,i_sls) + & !ZN
+ betaval_loc * Sn + gammaval_loc * Snp1 !ZN
+ endif
+
+ ! term in xx yy zz xy xz yz
+ factor_loc = mustore(i,j,k,ispec) * factor_common(i_sls,i,j,k,ispec)
+
! term in xx
Sn = factor_loc * epsilondev_xx(i,j,k,ispec)
Snp1 = factor_loc * epsilondev_xx_loc(i,j,k)
@@ -820,7 +864,6 @@
Snp1 = factor_loc * epsilondev_yz_loc(i,j,k)
R_yz(i,j,k,ispec,i_sls) = alphaval_loc * R_yz(i,j,k,ispec,i_sls) + &
betaval_loc * Sn + gammaval_loc * Snp1
-
enddo ! end of loop on memory variables
endif ! end attenuation
@@ -831,6 +874,7 @@
! save deviatoric strain for Runge-Kutta scheme
if ( COMPUTE_AND_STORE_STRAIN ) then
+ if(FULL_ATTENUATION_SOLID) epsilondev_trace(:,:,:,ispec) = epsilondev_trace_loc(:,:,:)
epsilondev_xx(:,:,:,ispec) = epsilondev_xx_loc(:,:,:)
epsilondev_yy(:,:,:,ispec) = epsilondev_yy_loc(:,:,:)
epsilondev_xy(:,:,:,ispec) = epsilondev_xy_loc(:,:,:)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -73,10 +73,13 @@
nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
one_minus_sum_beta,factor_common, &
+ one_minus_sum_beta_kappa,factor_common_kappa, & !ZN
alphaval,betaval,gammaval,&
- NSPEC_ATTENUATION_AB, &
- R_xx,R_yy,R_xy,R_xz,R_yz, &
- epsilondev_xx,epsilondev_yy,epsilondev_xy, &
+ NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa, & !ZN
+!ZN R_xx,R_yy,R_xy,R_xz,R_yz, &
+ R_trace,R_xx,R_yy,R_xy,R_xz,R_yz, &
+!ZN epsilondev_xx,epsilondev_yy,epsilondev_xy, &
+ epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy, &
epsilondev_xz,epsilondev_yz,epsilon_trace_over_3, &
ANISOTROPY,NSPEC_ANISO, &
c11store,c12store,c13store,c14store,c15store,c16store, &
@@ -104,10 +107,13 @@
nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
one_minus_sum_beta,factor_common, &
+ one_minus_sum_beta_kappa,factor_common_kappa, & !ZN
b_alphaval,b_betaval,b_gammaval, &
- NSPEC_ATTENUATION_AB, &
- b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz, &
- b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy, &
+ NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa, & !ZN
+!ZN b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz, &
+ b_R_trace,b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz, &
+!ZN b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy, &
+ b_epsilondev_trace,b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy, &
b_epsilondev_xz,b_epsilondev_yz,b_epsilon_trace_over_3, &
ANISOTROPY,NSPEC_ANISO, &
c11store,c12store,c13store,c14store,c15store,c16store, &
@@ -337,10 +343,10 @@
enddo
-!Percy , Fault boundary term B*tau is added to the assembled forces
+!Percy , Fault boundary term B*tau is added to the assembled forces
! which at this point are stored in the array 'accel'
if (SIMULATION_TYPE_DYN) call bc_dynflt_set3d_all(accel,veloc,displ)
-
+
if (SIMULATION_TYPE_KIN) call bc_kinflt_set_all(accel,veloc,displ)
! multiplies with inverse of mass matrix (note: rmass has been inverted already)
@@ -443,10 +449,13 @@
kappastore,mustore,jacobian,ibool, &
ATTENUATION,deltat, &
one_minus_sum_beta,factor_common, &
+ one_minus_sum_beta_kappa,factor_common_kappa, & !ZN
alphaval,betaval,gammaval, &
- NSPEC_ATTENUATION_AB, &
- R_xx,R_yy,R_xy,R_xz,R_yz, &
- epsilondev_xx,epsilondev_yy,epsilondev_xy, &
+ NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa, & !ZN
+!ZN R_xx,R_yy,R_xy,R_xz,R_yz, &
+ R_trace,R_xx,R_yy,R_xy,R_xz,R_yz, & !ZN
+!ZN epsilondev_xx,epsilondev_yy,epsilondev_xy, &
+ epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy, & !ZN
epsilondev_xz,epsilondev_yz,epsilon_trace_over_3, &
ANISOTROPY,NSPEC_ANISO, &
c11store,c12store,c13store,c14store,c15store,c16store,&
@@ -469,10 +478,13 @@
kappastore,mustore,jacobian,ibool, &
ATTENUATION,deltat, &
one_minus_sum_beta,factor_common, &
+ one_minus_sum_beta_kappa,factor_common_kappa, & !ZN
alphaval,betaval,gammaval, &
- NSPEC_ATTENUATION_AB, &
- R_xx,R_yy,R_xy,R_xz,R_yz, &
- epsilondev_xx,epsilondev_yy,epsilondev_xy, &
+ NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa, & !ZN
+!ZN R_xx,R_yy,R_xy,R_xz,R_yz, &
+ R_trace,R_xx,R_yy,R_xy,R_xz,R_yz, & !ZN
+!ZN epsilondev_xx,epsilondev_yy,epsilondev_xy, &
+ epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy, & !ZN
epsilondev_xz,epsilondev_yz,epsilon_trace_over_3, &
ANISOTROPY,NSPEC_ANISO, &
c11store,c12store,c13store,c14store,c15store,c16store,&
@@ -525,10 +537,13 @@
kappastore,mustore,jacobian,ibool, &
ATTENUATION,deltat, &
one_minus_sum_beta,factor_common, &
+ one_minus_sum_beta_kappa,factor_common_kappa, & !ZN
b_alphaval,b_betaval,b_gammaval, &
- NSPEC_ATTENUATION_AB, &
- b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz, &
- b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy, &
+ NSPEC_ATTENUATION_AB, NSPEC_ATTENUATION_AB_kappa, & !ZN
+!ZN b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz, &
+ b_R_trace,b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz, & !ZN
+!ZN b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy, &
+ b_epsilondev_trace,b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy, & !ZN
b_epsilondev_xz,b_epsilondev_yz,b_epsilon_trace_over_3, &
ANISOTROPY,NSPEC_ANISO, &
c11store,c12store,c13store,c14store,c15store,c16store,&
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -35,10 +35,13 @@
nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
one_minus_sum_beta,factor_common, &
+ one_minus_sum_beta_kappa,factor_common_kappa, & !ZN
alphaval,betaval,gammaval, &
- NSPEC_ATTENUATION_AB, &
- R_xx,R_yy,R_xy,R_xz,R_yz, &
- epsilondev_xx,epsilondev_yy,epsilondev_xy,&
+ NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa, & !ZN
+!ZN R_xx,R_yy,R_xy,R_xz,R_yz, &
+ R_trace,R_xx,R_yy,R_xy,R_xz,R_yz, & !ZN
+!ZN epsilondev_xx,epsilondev_yy,epsilondev_xy,&
+ epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy,& !ZN
epsilondev_xz,epsilondev_yz,epsilon_trace_over_3, &
ANISOTROPY,NSPEC_ANISO, &
c11store,c12store,c13store,c14store,c15store,c16store, &
@@ -53,7 +56,7 @@
num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic, &
phase_ispec_inner_elastic)
- use constants, only: NGLLX,NGLLY,NGLLZ,NDIM,N_SLS,SAVE_MOHO_MESH,ONE_THIRD,FOUR_THIRDS
+ use constants, only: NGLLX,NGLLY,NGLLZ,NDIM,N_SLS,SAVE_MOHO_MESH,ONE_THIRD,FOUR_THIRDS,FULL_ATTENUATION_SOLID,IOUT !ZN
use pml_par
use fault_solver_dynamic, only : Kelvin_Voigt_eta
@@ -90,15 +93,19 @@
logical :: ATTENUATION
logical :: COMPUTE_AND_STORE_STRAIN
integer :: NSPEC_STRAIN_ONLY, NSPEC_ADJOINT
- integer :: NSPEC_ATTENUATION_AB
+ integer :: NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB) :: one_minus_sum_beta
real(kind=CUSTOM_REAL), dimension(N_SLS,NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB) :: factor_common
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa) :: one_minus_sum_beta_kappa !ZN
+ real(kind=CUSTOM_REAL), dimension(N_SLS,NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa) :: factor_common_kappa !ZN
real(kind=CUSTOM_REAL), dimension(N_SLS) :: alphaval,betaval,gammaval
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB,N_SLS) :: &
R_xx,R_yy,R_xy,R_xz,R_yz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa,N_SLS) :: R_trace !ZN
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_STRAIN_ONLY) :: &
- epsilondev_xx,epsilondev_yy,epsilondev_xy,epsilondev_xz,epsilondev_yz
+ epsilondev_xx,epsilondev_yy,epsilondev_xy,epsilondev_xz,epsilondev_yz !ZN
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa) :: epsilondev_trace
real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT) :: epsilon_trace_over_3
! anisotropy
@@ -168,9 +175,9 @@
c33,c34,c35,c36,c44,c45,c46,c55,c56,c66
! local attenuation parameters
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: epsilondev_xx_loc, &
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: epsilondev_trace_loc, epsilondev_xx_loc, & !ZN
epsilondev_yy_loc, epsilondev_xy_loc, epsilondev_xz_loc, epsilondev_yz_loc
- real(kind=CUSTOM_REAL) :: R_xx_val,R_yy_val
+ real(kind=CUSTOM_REAL) :: R_trace_val,R_xx_val,R_yy_val !ZN
real(kind=CUSTOM_REAL) :: factor_loc,alphaval_loc,betaval_loc,gammaval_loc,Sn,Snp1
real(kind=CUSTOM_REAL) :: templ
@@ -209,7 +216,7 @@
! Kelvin Voigt damping: artificial viscosity around dynamic faults
if (allocated(Kelvin_Voigt_eta)) then
- eta = Kelvin_Voigt_eta(ispec)
+ eta = Kelvin_Voigt_eta(ispec)
do k=1,NGLLZ
do j=1,NGLLY
do i=1,NGLLX
@@ -224,7 +231,7 @@
do j=1,NGLLY
do i=1,NGLLX
iglob = ibool(i,j,k,ispec)
- dloc(:,i,j,k) = displ(:,iglob)
+ dloc(:,i,j,k) = displ(:,iglob)
enddo
enddo
enddo
@@ -279,7 +286,7 @@
tempz2l_new = tempz2l
tempz3l_new = tempz3l
- ! use first order Taylor expansion of displacement for local storage of stresses
+ ! use first order Taylor expansion of displacement for local storage of stresses
! at this current time step, to fix attenuation in a consistent way
do l=1,NGLLX
hp1 = hprime_xx(i,l)
@@ -404,6 +411,7 @@
! compute deviatoric strain
if( SIMULATION_TYPE == 3 ) epsilon_trace_over_3(i,j,k,ispec) = ONE_THIRD * (duxdxl_new + duydyl_new + duzdzl_new)
+ epsilondev_trace_loc(i,j,k) = 3.0 * epsilon_trace_over_3(i,j,k,ispec) !ZN
epsilondev_xx_loc(i,j,k) = duxdxl_new - epsilon_trace_over_3(i,j,k,ispec)
epsilondev_yy_loc(i,j,k) = duydyl_new - epsilon_trace_over_3(i,j,k,ispec)
epsilondev_xy_loc(i,j,k) = 0.5 * duxdyl_plus_duydxl_new
@@ -422,7 +430,7 @@
PML_duz_dxl_new(i,j,k,ispec_CPML) = duzdxl_new
PML_duz_dyl_new(i,j,k,ispec_CPML) = duzdyl_new
- PML_duz_dzl_new(i,j,k,ispec_CPML) = duzdzl_new
+ PML_duz_dzl_new(i,j,k,ispec_CPML) = duzdzl_new
endif
elseif( .not.(ATTENUATION .and. COMPUTE_AND_STORE_STRAIN) ) then
@@ -445,6 +453,9 @@
if(ATTENUATION) then
! use unrelaxed parameters if attenuation
mul = mul * one_minus_sum_beta(i,j,k,ispec)
+ if(FULL_ATTENUATION_SOLID)then !ZN
+ kappal = kappal * one_minus_sum_beta_kappa(i,j,k,ispec) !ZN
+ endif !ZN
endif
! full anisotropic case, stress calculations
@@ -504,18 +515,23 @@
! subtract memory variables if attenuation
if(ATTENUATION) then
do i_sls = 1,N_SLS
+ if(FULL_ATTENUATION_SOLID)then !ZN
+ R_trace_val = R_trace(i,j,k,ispec,i_sls) !ZN
+ else !ZN
+ R_trace_val = 0.0 !ZN
+ endif !ZN
R_xx_val = R_xx(i,j,k,ispec,i_sls)
R_yy_val = R_yy(i,j,k,ispec,i_sls)
- sigma_xx = sigma_xx - R_xx_val
- sigma_yy = sigma_yy - R_yy_val
- sigma_zz = sigma_zz + R_xx_val + R_yy_val
+ sigma_xx = sigma_xx - R_xx_val - R_trace_val
+ sigma_yy = sigma_yy - R_yy_val - R_trace_val
+ sigma_zz = sigma_zz + R_xx_val + R_yy_val - R_trace_val
sigma_xy = sigma_xy - R_xy(i,j,k,ispec,i_sls)
sigma_xz = sigma_xz - R_xz(i,j,k,ispec,i_sls)
sigma_yz = sigma_yz - R_yz(i,j,k,ispec,i_sls)
enddo
endif
- if( .not. PML_CONDITIONS ) then
+ if( .not. PML_CONDITIONS ) then
! define symmetric components of sigma
sigma_yx = sigma_xy
sigma_zx = sigma_xz
@@ -610,12 +626,23 @@
! use Runge-Kutta scheme to march in time
do i_sls = 1,N_SLS
- factor_loc = mustore(i,j,k,ispec) * factor_common(i_sls,i,j,k,ispec)
-
alphaval_loc = alphaval(i_sls)
betaval_loc = betaval(i_sls)
gammaval_loc = gammaval(i_sls)
+ if(FULL_ATTENUATION_SOLID)then
+ ! term in trace !ZN
+ factor_loc = kappastore(i,j,k,ispec) * factor_common_kappa(i_sls,i,j,k,ispec) !ZN
+
+ Sn = factor_loc * epsilondev_trace(i,j,k,ispec) !ZN
+ Snp1 = factor_loc * epsilondev_trace_loc(i,j,k) !ZN
+ R_trace(i,j,k,ispec,i_sls) = alphaval_loc * R_trace(i,j,k,ispec,i_sls) + & !ZN
+ betaval_loc * Sn + gammaval_loc * Snp1 !ZN
+ endif
+
+ ! term in xx yy zz xy xz yz
+ factor_loc = mustore(i,j,k,ispec) * factor_common(i_sls,i,j,k,ispec)
+
! term in xx
Sn = factor_loc * epsilondev_xx(i,j,k,ispec)
Snp1 = factor_loc * epsilondev_xx_loc(i,j,k)
@@ -658,6 +685,7 @@
! save deviatoric strain for Runge-Kutta scheme
if ( COMPUTE_AND_STORE_STRAIN ) then
+ if(FULL_ATTENUATION_SOLID)epsilondev_trace(:,:,:,ispec) = epsilondev_trace_loc(:,:,:) !ZN
epsilondev_xx(:,:,:,ispec) = epsilondev_xx_loc(:,:,:)
epsilondev_yy(:,:,:,ispec) = epsilondev_yy_loc(:,:,:)
epsilondev_xy(:,:,:,ispec) = epsilondev_xy_loc(:,:,:)
@@ -666,8 +694,8 @@
endif
enddo ! spectral element loop
-
- ! C-PML boundary
+
+ ! C-PML boundary
if( PML_CONDITIONS ) then
! xmin
do ispec2D=1,nspec2D_xmin
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_dynamic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_dynamic.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_dynamic.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -12,9 +12,9 @@
use fault_solver_common
use constants
-
- implicit none
+ implicit none
+
private
!! DK DK moved this to fault_common in order to use it there
@@ -24,9 +24,9 @@
! ! rupture time = first time when slip velocity = threshold V_RUPT (defined below)
! ! process zone time = first time when slip = Dc
! type dataXZ_type
-! real(kind=CUSTOM_REAL), dimension(:), pointer :: stg=>null(), sta=>null(), d1=>null(), d2=>null(), v1=>null(), v2=>null(), &
+! real(kind=CUSTOM_REAL), dimension(:), pointer :: stg=>null(), sta=>null(), d1=>null(), d2=>null(), v1=>null(), v2=>null(), &
! t1=>null(), t2=>null(), t3=>null(), tRUP=>null(), tPZ=>null()
-! real(kind=CUSTOM_REAL), dimension(:), pointer :: xcoord=>null(), ycoord=>null(), zcoord=>null()
+! real(kind=CUSTOM_REAL), dimension(:), pointer :: xcoord=>null(), ycoord=>null(), zcoord=>null()
! integer :: npoin=0
! end type dataXZ_type
@@ -64,10 +64,10 @@
!slip velocity threshold for healing
!WARNING: not very robust
- real(kind=CUSTOM_REAL), save :: V_HEALING
+ real(kind=CUSTOM_REAL), save :: V_HEALING
!slip velocity threshold for definition of rupture front
- real(kind=CUSTOM_REAL), save :: V_RUPT
+ real(kind=CUSTOM_REAL), save :: V_RUPT
!Number of time steps defined by the user : NTOUT
integer, save :: NTOUT,NSNAP
@@ -86,7 +86,7 @@
contains
!=====================================================================
-! BC_DYNFLT_init initializes dynamic faults
+! BC_DYNFLT_init initializes dynamic faults
!
! prname fault database is read from file prname_fault_db.bin
! Minv inverse mass matrix
@@ -96,7 +96,7 @@
use specfem_par, only : nt=>NSTEP
character(len=256), intent(in) :: prname ! 'proc***'
- double precision, intent(in) :: DTglobal
+ double precision, intent(in) :: DTglobal
integer, intent(in) :: myrank
real(kind=CUSTOM_REAL) :: dt
@@ -108,15 +108,15 @@
integer, parameter :: IIN_PAR =151
integer, parameter :: IIN_BIN =170
- NAMELIST / BEGIN_FAULT / dummy_idfault
+ NAMELIST / BEGIN_FAULT / dummy_idfault
dummy_idfault = 0
open(unit=IIN_PAR,file='../DATA/Par_file_faults',status='old',iostat=ier)
if( ier /= 0 ) then
if (myrank==0) write(IMAIN,*) 'File DATA/Par_file_faults not found: assume no faults'
- close(IIN_PAR)
- return
+ close(IIN_PAR)
+ return
endif
read(IIN_PAR,*) nbfaults
@@ -132,7 +132,7 @@
filename = prname(1:len_trim(prname))//'fault_db.bin'
open(unit=IIN_BIN,file=trim(filename),status='old',action='read',form='unformatted',iostat=ier)
if( ier /= 0 ) then
- write(IMAIN,*) 'Fatal error: file ',trim(filename),' not found. Abort'
+ write(IMAIN,*) 'Fatal error: file ',trim(filename),' not found. Abort'
stop
endif
! WARNING TO DO: should be an MPI abort
@@ -145,11 +145,11 @@
if ( SIMULATION_TYPE /= 1 ) then
close(IIN_BIN)
close(IIN_PAR)
- return
+ return
endif
SIMULATION_TYPE_DYN = .true.
read(IIN_PAR,*) NTOUT
- read(IIN_PAR,*) NSNAP
+ read(IIN_PAR,*) NSNAP
read(IIN_PAR,*) V_HEALING
read(IIN_PAR,*) V_RUPT
@@ -166,7 +166,7 @@
filename = prname(1:len_trim(prname))//'Kelvin_voigt_eta.bin'
open(unit=IIN_BIN,file=trim(filename),status='old',action='read',form='unformatted',iostat=ier)
if( ier /= 0 ) then
- write(IMAIN,*) 'Fatal error: file ',trim(filename),' not found. Abort'
+ write(IMAIN,*) 'Fatal error: file ',trim(filename),' not found. Abort'
stop
endif
read(IIN_BIN) size_Kelvin_Voigt
@@ -222,22 +222,22 @@
bc%T0(1,:) = S1
bc%T0(2,:) = S2
bc%T0(3,:) = S3
- call init_2d_distribution(bc%T0(1,:),bc%coord,IIN_PAR,n1)
- call init_2d_distribution(bc%T0(2,:),bc%coord,IIN_PAR,n2)
- call init_2d_distribution(bc%T0(3,:),bc%coord,IIN_PAR,n3)
+ call init_2d_distribution(bc%T0(1,:),bc%coord,IIN_PAR,n1)
+ call init_2d_distribution(bc%T0(2,:),bc%coord,IIN_PAR,n2)
+ call init_2d_distribution(bc%T0(3,:),bc%coord,IIN_PAR,n3)
bc%T = bc%T0
- !WARNING : Quick and dirty free surface condition at z=0
- ! do k=1,bc%nglob
+ !WARNING : Quick and dirty free surface condition at z=0
+ ! do k=1,bc%nglob
! if (abs(bc%zcoord(k)-0.e0_CUSTOM_REAL) <= SMALLVAL) bc%T0(2,k) = 0
- ! end do
+ ! end do
! Set friction parameters and initialize friction variables
allocate(bc%MU(bc%nglob))
if (RATE_AND_STATE) then
allocate(bc%rsf)
call rsf_init(bc%rsf,bc%T0,bc%V,bc%Fload,bc%coord,IIN_PAR)
- else
+ else
allocate(bc%swf)
call swf_init(bc%swf,bc%MU,bc%coord,IIN_PAR)
if (TPV16) call TPV16_init() !WARNING: ad hoc, initializes T0 and swf
@@ -247,18 +247,18 @@
if (RATE_AND_STATE) then
call init_dataT(bc%dataT,bc%coord,bc%nglob,NT,dt,8,iflt)
- bc%dataT%longFieldNames(8) = "log10 of state variable (log-seconds)"
- if (bc%rsf%StateLaw==1) then
+ bc%dataT%longFieldNames(8) = "log10 of state variable (log-seconds)"
+ if (bc%rsf%StateLaw==1) then
bc%dataT%shortFieldNames = trim(bc%dataT%shortFieldNames)//" log-theta"
else
bc%dataT%shortFieldNames = trim(bc%dataT%shortFieldNames)//" psi"
- endif
+ endif
else
call init_dataT(bc%dataT,bc%coord,bc%nglob,NT,dt,7,iflt)
endif
call init_dataXZ(bc%dataXZ,bc)
- ! output a fault snapshot at t=0
+ ! output a fault snapshot at t=0
if (.NOT. PARALLEL_FAULT) then
if (bc%nspec > 0) call write_dataXZ(bc%dataXZ,0,iflt)
else
@@ -289,13 +289,13 @@
Rstress_str(ipar),Rstress_dip(ipar),static_fc(ipar),dyn_fc(ipar),swcd(ipar),cohes(ipar),tim_forcedRup(ipar)
enddo
close(IIN_NUC)
-
+
minX = minval(bc%coord(1,:))
do i=1,bc%nglob
-
+
! WARNING: nearest neighbor interpolation
- ipar = minloc( (minX+loc_str(:)-bc%coord(1,i))**2 + (-loc_dip(:)-bc%coord(3,i))**2 , 1)
+ ipar = minloc( (minX+loc_str(:)-bc%coord(1,i))**2 + (-loc_dip(:)-bc%coord(3,i))**2 , 1)
!loc_dip is negative of Z-coord
bc%T0(3,i) = -sigma0(ipar)
@@ -328,13 +328,13 @@
real(kind=CUSTOM_REAL) :: val,valh, xc, yc, zc, r, l, lx,ly,lz
real(kind=CUSTOM_REAL) :: r1(size(a))
integer :: i
- real(kind=CUSTOM_REAL) :: SMALLVAL
+ real(kind=CUSTOM_REAL) :: SMALLVAL
NAMELIST / DIST2D / shape, val,valh, xc, yc, zc, r, l, lx,ly,lz
SMALLVAL = 1.e-10_CUSTOM_REAL
- if (n==0) return
+ if (n==0) return
do i=1,n
shape = ''
@@ -363,13 +363,13 @@
case ('ellipse')
b = heaviside( 1e0_CUSTOM_REAL - sqrt( (coord(1,:)-xc)**2/lx**2 + (coord(2,:)-yc)**2/ly**2 + (coord(3,:)-zc)**2/lz**2 ) ) *val
case ('square')
- b = heaviside((l/2._CUSTOM_REAL)-abs(coord(1,:)-xc)+SMALLVAL) * &
- heaviside((l/2._CUSTOM_REAL)-abs(coord(2,:)-yc)+SMALLVAL) * &
+ b = heaviside((l/2._CUSTOM_REAL)-abs(coord(1,:)-xc)+SMALLVAL) * &
+ heaviside((l/2._CUSTOM_REAL)-abs(coord(2,:)-yc)+SMALLVAL) * &
heaviside((l/2._CUSTOM_REAL)-abs(coord(3,:)-zc)+SMALLVAL) * &
val
case ('cylinder')
b = heaviside(r - sqrt((coord(1,:)-xc)**2 + (coord(2,:)-yc)**2)) * &
- heaviside((lz/2._CUSTOM_REAL)-abs(coord(3,:)-zc)+SMALLVAL) * &
+ heaviside((lz/2._CUSTOM_REAL)-abs(coord(3,:)-zc)+SMALLVAL) * &
val
case ('rectangle')
b = heaviside((lx/2._CUSTOM_REAL)-abs(coord(1,:)-xc)+SMALLVAL) * &
@@ -426,7 +426,7 @@
end subroutine bc_dynflt_set3d_all
!---------------------------------------------------------------------
-subroutine BC_DYNFLT_set3d(bc,MxA,V,D,iflt)
+subroutine BC_DYNFLT_set3d(bc,MxA,V,D,iflt)
use specfem_par, only: it,NSTEP,myrank
@@ -446,7 +446,7 @@
half_dt = 0.5e0_CUSTOM_REAL*bc%dt
Vf_old = sqrt(bc%V(1,:)*bc%V(1,:)+bc%V(2,:)*bc%V(2,:))
-
+
! get predicted values
dD = get_jump(bc,D) ! dD_predictor
dV = get_jump(bc,V) ! dV_predictor
@@ -455,27 +455,27 @@
! rotate to fault frame (tangent,normal)
! component 3 is normal to the fault
dD = rotate(bc,dD,1)
- dV = rotate(bc,dV,1)
- dA = rotate(bc,dA,1)
-
+ dV = rotate(bc,dV,1)
+ dA = rotate(bc,dA,1)
+
! T_stick
T(1,:) = bc%Z * ( dV(1,:) + half_dt*dA(1,:) )
T(2,:) = bc%Z * ( dV(2,:) + half_dt*dA(2,:) )
T(3,:) = bc%Z * ( dV(3,:) + half_dt*dA(3,:) )
-
- !Warning : dirty particular free surface condition z = 0.
+
+ !Warning : dirty particular free surface condition z = 0.
! where (bc%zcoord(:) > - SMALLVAL) T(2,:) = 0
- ! do k=1,bc%nglob
+ ! do k=1,bc%nglob
! if (abs(bc%zcoord(k)-0.e0_CUSTOM_REAL) < SMALLVAL) T(2,k) = 0.e0_CUSTOM_REAL
- ! end do
+ ! end do
! add initial stress
T = T + bc%T0
-
+
! Solve for normal stress (negative is compressive)
! Opening implies free stress
- if (bc%allow_opening) T(3,:) = min(T(3,:),0.e0_CUSTOM_REAL)
-
+ if (bc%allow_opening) T(3,:) = min(T(3,:),0.e0_CUSTOM_REAL)
+
! smooth loading within nucleation patch
!WARNING : ad hoc for SCEC benchmark TPV10x
if (RATE_AND_STATE) then
@@ -499,10 +499,10 @@
! WARNING: during opening the friction state variable should not evolve
theta_old = bc%swf%theta
call swf_update_state(bc%D,dD,bc%V,bc%swf)
-
+
! Update friction coeficient
- bc%MU = swf_mu(bc%swf)
-
+ bc%MU = swf_mu(bc%swf)
+
! combined with time-weakening for nucleation
! if (associated(bc%twf)) bc%MU = min( bc%MU, twf_mu(bc%twf,bc%coord,time) )
if (TPV16) then
@@ -511,10 +511,10 @@
! Update strength
strength = -bc%MU * min(T(3,:),0.e0_CUSTOM_REAL) + bc%swf%C
-
+
! Solve for shear stress
- tnew = min(tStick,strength)
-
+ tnew = min(tStick,strength)
+
else ! Update rate and state friction:
!JPA the solver below can be refactored into a loop with two passes
@@ -525,7 +525,7 @@
Vf_new(i)=rtsafe(funcd,0.0,Vf_old(i)+5.0,1e-5,tStick(i),-T(3,i),bc%Z(i),bc%rsf%f0(i), &
bc%rsf%V0(i),bc%rsf%a(i),bc%rsf%b(i),bc%rsf%L(i),bc%rsf%theta(i),bc%rsf%StateLaw)
enddo
-
+
! second pass
bc%rsf%theta = theta_old
call rsf_update_state(0.5e0_CUSTOM_REAL*(Vf_old + Vf_new),bc%dt,bc%rsf)
@@ -533,36 +533,36 @@
Vf_new(i)=rtsafe(funcd,0.0,Vf_old(i)+5.0,1e-5,tStick(i),-T(3,i),bc%Z(i),bc%rsf%f0(i), &
bc%rsf%V0(i),bc%rsf%a(i),bc%rsf%b(i),bc%rsf%L(i),bc%rsf%theta(i),bc%rsf%StateLaw)
enddo
-
+
tnew = tStick - bc%Z*Vf_new
endif
-
+
tStick = max(tStick,1e0_CUSTOM_REAL) ! to avoid division by zero
T(1,:) = tnew * T(1,:)/tStick
T(2,:) = tnew * T(2,:)/tStick
! Save total tractions
bc%T = T
-
+
! Subtract initial stress
T = T - bc%T0
- if (RATE_AND_STATE) T(1,:) = T(1,:) - TxExt
+ if (RATE_AND_STATE) T(1,:) = T(1,:) - TxExt
!JPA: this eliminates the effect of TxExt on the equations of motion. Why is it needed?
! Update slip acceleration da=da_free-T/(0.5*dt*Z)
dA(1,:) = dA(1,:) - T(1,:)/(bc%Z*half_dt)
dA(2,:) = dA(2,:) - T(2,:)/(bc%Z*half_dt)
dA(3,:) = dA(3,:) - T(3,:)/(bc%Z*half_dt)
-
+
! Update slip and slip rate, in fault frame
bc%D = dD
bc%V = dV + half_dt*dA
-
- ! Rotate tractions back to (x,y,z) frame
+
+ ! Rotate tractions back to (x,y,z) frame
T = rotate(bc,T,-1)
-
+
! Add boundary term B*T to M*a
call add_BT(bc,MxA,T)
@@ -575,7 +575,7 @@
theta_new = bc%rsf%theta
dc = bc%rsf%L
endif
-
+
call store_dataXZ(bc%dataXZ, strength, theta_old, theta_new, dc, &
Vf_old, Vf_new, it*bc%dt,bc%dt)
@@ -640,8 +640,8 @@
! WARNING: if V_HEALING is negative we turn off healing
f%healing = (V_HEALING > 0e0_CUSTOM_REAL)
- mus = 0.6e0_CUSTOM_REAL
- mud = 0.1e0_CUSTOM_REAL
+ mus = 0.6e0_CUSTOM_REAL
+ mud = 0.1e0_CUSTOM_REAL
dc = 1e0_CUSTOM_REAL
C = 0._CUSTOM_REAL
T = HUGEVAL
@@ -660,7 +660,7 @@
f%C = C
f%T = T
call init_2d_distribution(f%mus,coord,IIN_PAR,nmus)
- call init_2d_distribution(f%mud,coord,IIN_PAR,nmud)
+ call init_2d_distribution(f%mud,coord,IIN_PAR,nmud)
call init_2d_distribution(f%Dc ,coord,IIN_PAR,ndc)
call init_2d_distribution(f%C ,coord,IIN_PAR,nC)
call init_2d_distribution(f%T ,coord,IIN_PAR,nForcedRup)
@@ -683,7 +683,7 @@
f%theta = f%theta + sqrt( (dold(1,:)-dnew(1,:))**2 + (dold(2,:)-dnew(2,:))**2 )
if (f%healing) then
- npoin = size(vold,2)
+ npoin = size(vold,2)
do k=1,npoin
vnorm = sqrt(vold(1,k)**2 + vold(2,k)**2)
if (vnorm<V_HEALING) f%theta(k) = 0e0_CUSTOM_REAL
@@ -802,7 +802,7 @@
!!$ where(ystore < 0) init_vel(1,:) = V_init/2._CUSTOM_REAL
!!$ !init_vel = rotate(bc,init_vel,-1) ! directly assigned in global coordinates here as it is a simplified case
!!$ vel = vel + init_vel
-
+
! WARNING: below is an ad-hoc setting of a(x,z) for some SCEC benchmark
! This should be instead an option in init_2d_distribution
W1=15000._CUSTOM_REAL
@@ -827,7 +827,7 @@
else
B1 = 0._CUSTOM_REAL
endif
-
+
if (c3 .and. c4) then
b21 = w/(abs(z-hypo_z)-W2-w)
b22 = w/(abs(z-hypo_z)-W2)
@@ -837,7 +837,7 @@
else
B2 = 0._CUSTOM_REAL
endif
-
+
f%a(i) = 0.008 + 0.008 * (ONE - B1*B2)
f%Vw(i) = 0.1 + 0.9 * (ONE - B1*B2)
@@ -851,7 +851,7 @@
enddo
- ! WARNING: The line below scratches an earlier initialization of theta through theta_init
+ ! WARNING: The line below scratches an earlier initialization of theta through theta_init
! We should implement it as an option for the user
if(f%stateLaw == 1) then
f%theta = f%L/f%V0 &
@@ -886,7 +886,7 @@
!!$
!!$ arg = V/TWO/f%V0 * exp((f%f0 + f%b*log(f%theta*f%V0/f%L))/f%a )
!!$
-!!$ mu = f%a * asinh_slatec( arg ) ! Regularized
+!!$ mu = f%a * asinh_slatec( arg ) ! Regularized
!!$
!!$end function rsf_mu
@@ -905,9 +905,9 @@
! ageing law
if (f%StateLaw == 1) then
where(vDtL > 1.e-5_CUSTOM_REAL)
- f%theta = f%theta * exp(-vDtL) + f%L/V * (ONE - exp(-vDtL))
+ f%theta = f%theta * exp(-vDtL) + f%L/V * (ONE - exp(-vDtL))
elsewhere
- f%theta = f%theta * exp(-vDtL) + dt*( ONE - HALF*vDtL )
+ f%theta = f%theta * exp(-vDtL) + dt*( ONE - HALF*vDtL )
endwhere
! slip law : by default use strong rate-weakening
@@ -990,11 +990,11 @@
dataXZ%d1 => bc%d(1,:)
dataXZ%d2 => bc%d(2,:)
dataXZ%v1 => bc%v(1,:)
- dataXZ%v2 => bc%v(2,:)
+ dataXZ%v2 => bc%v(2,:)
dataXZ%t1 => bc%t(1,:)
dataXZ%t2 => bc%t(2,:)
dataXZ%t3 => bc%t(3,:)
- dataXZ%xcoord => bc%coord(1,:)
+ dataXZ%xcoord => bc%coord(1,:)
dataXZ%ycoord => bc%coord(2,:)
dataXZ%zcoord => bc%coord(3,:)
allocate(dataXZ%tRUP(bc%nglob))
@@ -1027,17 +1027,17 @@
allocate(bc%dataXZ_all%stg(npoin_all))
allocate(bc%dataXZ_all%sta(npoin_all))
endif
-
+
allocate(bc%npoin_perproc(NPROC))
bc%npoin_perproc=0
call gather_all_i(dataXZ%npoin,1,bc%npoin_perproc,1,NPROC)
-
+
allocate(bc%poin_offset(NPROC))
bc%poin_offset(1)=0
do iproc=2,NPROC
bc%poin_offset(iproc) = sum(bc%npoin_perproc(1:iproc-1))
enddo
-
+
call gatherv_all_cr(dataXZ%xcoord,dataXZ%npoin,bc%dataXZ_all%xcoord,bc%npoin_perproc,bc%poin_offset,bc%dataXZ_all%npoin,NPROC)
call gatherv_all_cr(dataXZ%ycoord,dataXZ%npoin,bc%dataXZ_all%ycoord,bc%npoin_perproc,bc%poin_offset,bc%dataXZ_all%npoin,NPROC)
call gatherv_all_cr(dataXZ%zcoord,dataXZ%npoin,bc%dataXZ_all%zcoord,bc%npoin_perproc,bc%poin_offset,bc%dataXZ_all%npoin,NPROC)
@@ -1067,7 +1067,7 @@
end subroutine gather_dataXZ
!---------------------------------------------------------------
-subroutine store_dataXZ(dataXZ,stg,dold,dnew,dc,vold,vnew,time,dt)
+subroutine store_dataXZ(dataXZ,stg,dold,dnew,dc,vold,vnew,time,dt)
type(dataXZ_type), intent(inout) :: dataXZ
real(kind=CUSTOM_REAL), dimension(:), intent(in) :: stg,dold,dnew,dc,vold,vnew
@@ -1202,7 +1202,7 @@
if (y >= xmax) asinh_slatec = aln2 + log(y)
asinh_slatec = sign(asinh_slatec, x)
-contains
+contains
! April 1977 version. W. Fullerton, C3, Los Alamos Scientific Lab.
@@ -1293,7 +1293,7 @@
if(statelaw == 1) then
arg = exp((f0+dble(b)*log(V0*theta/L))/a)/TWO/V0
- else
+ else
arg = exp(theta/a)/TWO/V0
endif
fn = tStick - Z*x - a*Seff*asinh_slatec(x*arg)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_kinematic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_kinematic.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_kinematic.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -8,7 +8,7 @@
use fault_solver_common
use constants
- implicit none
+ implicit none
private
@@ -17,7 +17,7 @@
! type dataXZ_type
! integer :: npoin=0
! real(kind=CUSTOM_REAL), dimension(:), pointer :: d1=>null(), d2=>null(), &
-! v1=>null(), v2=>null(), &
+! v1=>null(), v2=>null(), &
! t1=>null(), t2=>null(), t3=>null(), &
! xcoord=>null(), ycoord=>null(), zcoord=>null()
! end type dataXZ_type
@@ -32,15 +32,15 @@
! integer :: kin_it
! real(kind=CUSTOM_REAL), dimension(:,:), pointer :: v_kin_t1,v_kin_t2
! end type bc_kinflt_type
-
+
!! DK DK now use bc_dynandkinflt_type here instead
type(bc_dynandkinflt_type), allocatable, save :: faults(:)
-
+
!Number of time steps defined by the user : NTOUT
integer, save :: NTOUT,NSNAP
-
+
logical, save :: SIMULATION_TYPE_KIN = .false.
-
+
public :: BC_KINFLT_init, BC_KINFLT_set_all, SIMULATION_TYPE_KIN
@@ -48,7 +48,7 @@
!=====================================================================
-! BC_KINFLT_init initializes kinematic faults
+! BC_KINFLT_init initializes kinematic faults
!
! prname fault database is read from file prname_fault_db.bin
! Minv inverse mass matrix
@@ -56,9 +56,9 @@
!
subroutine BC_KINFLT_init(prname,DTglobal,myrank)
- use specfem_par, only : nt=>NSTEP
+ use specfem_par, only : nt=>NSTEP
character(len=256), intent(in) :: prname ! 'proc***'
- double precision, intent(in) :: DTglobal
+ double precision, intent(in) :: DTglobal
integer, intent(in) :: myrank
real(kind=CUSTOM_REAL) :: dt
@@ -68,17 +68,17 @@
character(len=256) :: filename
integer, parameter :: IIN_PAR =151
integer, parameter :: IIN_BIN =170
- real(kind=CUSTOM_REAL) :: DUMMY
+ real(kind=CUSTOM_REAL) :: DUMMY
- NAMELIST / BEGIN_FAULT / dummy_idfault
+ NAMELIST / BEGIN_FAULT / dummy_idfault
dummy_idfault = 0
open(unit=IIN_PAR,file='../DATA/Par_file_faults',status='old',iostat=ier)
if( ier /= 0 ) then
if (myrank==0) write(IMAIN,*) 'File DATA/Par_file_faults not found: assume no faults'
- close(IIN_PAR)
- return
+ close(IIN_PAR)
+ return
endif
read(IIN_PAR,*) nbfaults
@@ -94,7 +94,7 @@
filename = prname(1:len_trim(prname))//'fault_db.bin'
open(unit=IIN_BIN,file=trim(filename),status='old',action='read',form='unformatted',iostat=ier)
if( ier /= 0 ) then
- write(IMAIN,*) 'Fatal error: file ',trim(filename),' not found. Abort'
+ write(IMAIN,*) 'Fatal error: file ',trim(filename),' not found. Abort'
stop
endif
! WARNING TO DO: should be an MPI abort
@@ -106,14 +106,14 @@
read(IIN_PAR,*) NTOUT
read(IIN_PAR,*) NSNAP
read(IIN_PAR,*) DUMMY
- read(IIN_PAR,*) DUMMY
+ read(IIN_PAR,*) DUMMY
read(IIN_BIN) nbfaults ! should be the same as in IIN_PAR
allocate( faults(nbfaults) )
dt = real(DTglobal)
do iflt=1,nbfaults
read(IIN_PAR,nml=BEGIN_FAULT,end=100)
call init_one_fault(faults(iflt),IIN_BIN,IIN_PAR,dt,nt,iflt)
- enddo
+ enddo
endif
close(IIN_BIN)
close(IIN_PAR)
@@ -150,13 +150,13 @@
bc%T = 0e0_CUSTOM_REAL
bc%D = 0e0_CUSTOM_REAL
bc%V = 0e0_CUSTOM_REAL
-
+
! time interval between two loaded slip rates
- read(IIN_PAR,nml=KINPAR)
+ read(IIN_PAR,nml=KINPAR)
bc%kin_dt = kindt
-
+
bc%kin_it=0
- ! Always have in memory the slip-rate model at two times, t1 and t2,
+ ! Always have in memory the slip-rate model at two times, t1 and t2,
! spatially interpolated in the spectral element grid
allocate(bc%v_kin_t1(2,bc%nglob))
allocate(bc%v_kin_t2(2,bc%nglob))
@@ -184,27 +184,27 @@
if (.not. allocated(faults)) return
do iflt=1,size(faults)
if (faults(iflt)%nspec>0) call BC_KINFLT_set_single(faults(iflt),F,Vel,Dis,iflt)
- enddo
+ enddo
end subroutine BC_KINFLT_set_all
!---------------------------------------------------------------------
!
-!NOTE: On non-split nodes at fault edges, dD=dV=dA=0 but bc%T is corrupted.
+!NOTE: On non-split nodes at fault edges, dD=dV=dA=0 but bc%T is corrupted.
! That does not affect computations: the net contribution of B*T is =0.
! However, the output T in these nodes should be ignored.
! It is =0 if the user sets bc%V=0 there in the input slip rates.
!
-subroutine BC_KINFLT_set_single(bc,MxA,V,D,iflt)
+subroutine BC_KINFLT_set_single(bc,MxA,V,D,iflt)
- use specfem_par, only:it,NSTEP
+ use specfem_par, only:it,NSTEP
real(kind=CUSTOM_REAL), intent(inout) :: MxA(:,:)
!! DK DK now use bc_dynandkinflt_type here instead
type(bc_dynandkinflt_type), intent(inout) :: bc
real(kind=CUSTOM_REAL), intent(in) :: V(:,:),D(:,:)
integer,intent(in) :: iflt
- integer :: it_kin,itime
+ integer :: it_kin,itime
real(kind=CUSTOM_REAL), dimension(3,bc%nglob) :: T
real(kind=CUSTOM_REAL), dimension(3,bc%nglob) :: dD,dV,dA,dV_free
real(kind=CUSTOM_REAL) :: t1,t2
@@ -222,19 +222,19 @@
! rotate to fault frame (tangent,normal)
! component 3 is normal to the fault
dD = rotate(bc,dD,1)
- dV = rotate(bc,dV,1)
- dA = rotate(bc,dA,1)
+ dV = rotate(bc,dV,1)
+ dA = rotate(bc,dA,1)
! Time marching
time = it*bc%dt
! Slip_rate step "it_kin"
it_kin = bc%kin_it*nint(bc%kin_dt/bc%dt)
- ! (nint : fortran round (nearest whole number) ,
+ ! (nint : fortran round (nearest whole number) ,
! if nint(a)=0.5 then "a" get upper bound )
! Loading the next slip_rate one ahead it.
- ! This is done in case bc%kin_dt
- ! if (it_kin == it) it_kin=it_kin+1 !
+ ! This is done in case bc%kin_dt
+ ! if (it_kin == it) it_kin=it_kin+1 !
!NOTE : it and it_kin is being used due to integers are exact numbers.
@@ -246,14 +246,14 @@
bc%kin_it = bc%kin_it +1
bc%v_kin_t1 = bc%v_kin_t2
print*, 'loading v_kin_t2'
- !Temporal : just for snapshots file names kin_dt=0.1 , dt=0.0001
- !snapshot(100=itime).. : itime=kin_it*(kin_dt/dt)
+ !Temporal : just for snapshots file names kin_dt=0.1 , dt=0.0001
+ !snapshot(100=itime).. : itime=kin_it*(kin_dt/dt)
itime = bc%kin_it*nint(bc%kin_dt/bc%dt)
call load_vslip_snapshots(bc%dataXZ,itime,iflt)
-! loading slip rates
+! loading slip rates
bc%v_kin_t2(1,:)=bc%dataXZ%v1
bc%v_kin_t2(2,:)=bc%dataXZ%v2
-
+
!linear interpolation in time between t1 and t2
!REMARK , bc%kin_dt is the delta "t" between two snapshots.
@@ -269,7 +269,7 @@
bc%V(1,:) = ( (t2 - time)*bc%v_kin_t1(1,:) + (time - t1)*bc%v_kin_t2(1,:) )/ bc%kin_dt
bc%V(2,:) = ( (t2 - time)*bc%v_kin_t1(2,:) + (time - t1)*bc%v_kin_t2(2,:) )/ bc%kin_dt
- !dV_free = dV_predictor + (dt/2)*dA_free
+ !dV_free = dV_predictor + (dt/2)*dA_free
dV_free(1,:) = dV(1,:) + half_dt*dA(1,:)
dV_free(2,:) = dV(2,:) + half_dt*dA(2,:)
dV_free(3,:) = dV(3,:) + half_dt*dA(3,:)
@@ -286,7 +286,7 @@
! Update slip in fault frame
bc%D = dD
- ! Rotate tractions back to (x,y,z) frame
+ ! Rotate tractions back to (x,y,z) frame
T = rotate(bc,T,-1)
! Add boundary term B*T to M*a
@@ -327,7 +327,7 @@
end subroutine init_dataXZ
!---------------------------------------------------------------
-!LOAD_VSLIP_SNAPSHOTS(v,dataXZ,itime,coord,npoin,nglob,iflt)
+!LOAD_VSLIP_SNAPSHOTS(v,dataXZ,itime,coord,npoin,nglob,iflt)
!Loading slip velocity from snapshots.
! INPUT itime : iteration time
! coord : Receivers coordinates
@@ -337,9 +337,9 @@
! iflt : number of faults.
! OUTPUT v : slip rate on receivers.
-
-subroutine load_vslip_snapshots(dataXZ,itime,iflt)
+subroutine load_vslip_snapshots(dataXZ,itime,iflt)
+
integer, intent(in) :: itime,iflt
type(dataXZ_type), intent(inout) :: dataXZ
character(len=70) :: filename
@@ -353,11 +353,11 @@
open(unit=IIN_BIN, file= trim(filename), status='old', form='formatted',&
action='read',iostat=ier)
-! COMPILERS WRITE BINARY OUTPUTS IN DIFFERENT FORMATS !!!!!!!!!!
+! COMPILERS WRITE BINARY OUTPUTS IN DIFFERENT FORMATS !!!!!!!!!!
! open(unit=IIN_BIN, file= trim(filename), status='old', form='unformatted',&
! action='read',iostat=ier)
! if( ier /= 0 ) stop 'Snapshots have been found'
-
+
read(IIN_BIN,"(5F24.15)") dataXZ%xcoord,dataXZ%ycoord,dataXZ%zcoord,dataXZ%v1,dataXZ%v2
close(IIN_BIN)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/finalize_simulation.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/finalize_simulation.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/finalize_simulation.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -27,7 +27,7 @@
! United States and French Government Sponsorship Acknowledged.
subroutine finalize_simulation()
-
+
use pml_par
use specfem_par
@@ -57,11 +57,13 @@
write(27) accel
if (ATTENUATION) then
+ if(FULL_ATTENUATION_SOLID) write(27) R_trace !ZN
write(27) R_xx
write(27) R_yy
write(27) R_xy
write(27) R_xz
write(27) R_yz
+ if(FULL_ATTENUATION_SOLID) write(27) epsilondev_trace !ZN
write(27) epsilondev_xx
write(27) epsilondev_yy
write(27) epsilondev_xy
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -144,9 +144,15 @@
if( ATTENUATION ) then
!pll
NSPEC_ATTENUATION_AB = NSPEC_AB
+ if(FULL_ATTENUATION_SOLID) then !ZN
+ NSPEC_ATTENUATION_AB_kappa = NSPEC_AB !ZN
+ else !ZN
+ NSPEC_ATTENUATION_AB_kappa = 1 !ZN
+ endif !ZN
else
! if attenuation is off, set dummy size of arrays to one
NSPEC_ATTENUATION_AB = 1
+ NSPEC_ATTENUATION_AB_kappa = 1 !ZN
endif
! needed for attenuation and/or kernel computations
@@ -263,7 +269,7 @@
! gravity only on GPU supported
if( .not. GPU_MODE .and. GRAVITY ) &
stop 'GRAVITY only supported in GPU mode'
-
+
! absorbing surfaces
if( ABSORBING_CONDITIONS ) then
! for arbitrary orientation of elements, which face belongs to xmin,xmax,etc... -
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/iterate_time.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/iterate_time.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/iterate_time.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -60,6 +60,7 @@
! get MPI starting time
time_start = wtime()
+
! *********************************************************
! ************* MAIN LOOP OVER THE TIME STEPS *************
! *********************************************************
@@ -77,9 +78,9 @@
! acoustic solver
! (needs to be done first, before elastic one)
if( ACOUSTIC_SIMULATION ) call compute_forces_acoustic()
-
! elastic solver
! (needs to be done first, before poroelastic one)
+
if( ELASTIC_SIMULATION ) call compute_forces_viscoelastic()
! poroelastic solver
@@ -546,11 +547,13 @@
! memory variables if attenuation
if( ATTENUATION ) then
+ if(FULL_ATTENUATION_SOLID) read(27) b_R_trace !ZN
read(27) b_R_xx
read(27) b_R_yy
read(27) b_R_xy
read(27) b_R_xz
read(27) b_R_yz
+ if(FULL_ATTENUATION_SOLID) read(27) b_epsilondev_trace !ZN
read(27) b_epsilondev_xx
read(27) b_epsilondev_yy
read(27) b_epsilondev_xy
@@ -561,7 +564,10 @@
if(GPU_MODE) &
call transfer_b_fields_att_to_device(Mesh_pointer, &
b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz,size(b_R_xx), &
+!ZN b_R_trace,b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz,size(b_R_xx), & please change the above line with this
b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy,b_epsilondev_xz,b_epsilondev_yz, &
+!ZN b_epsilondev_trace,b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy,b_epsilondev_xz,b_epsilondev_yz, &
+!ZN please change the above line with this
size(b_epsilondev_xx))
endif
@@ -617,12 +623,13 @@
! wavefields
call transfer_b_fields_to_device(NDIM*NGLOB_AB,b_displ,b_veloc,b_accel, Mesh_pointer)
endif
-
+ if(FULL_ATTENUATION_SOLID) read(27) b_R_trace !ZN
read(27) b_R_xx
read(27) b_R_yy
read(27) b_R_xy
read(27) b_R_xz
read(27) b_R_yz
+ if(FULL_ATTENUATION_SOLID) read(27) b_epsilondev_trace !ZN
read(27) b_epsilondev_xx
read(27) b_epsilondev_yy
read(27) b_epsilondev_xy
@@ -634,7 +641,9 @@
! attenuation arrays
call transfer_b_fields_att_to_device(Mesh_pointer, &
b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz,size(b_R_xx), &
+!ZN b_R_trace,b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz,size(b_R_xx), &
b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy,b_epsilondev_xz,b_epsilondev_yz, &
+!ZN b_epsilondev_trace,b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy,b_epsilondev_xz,b_epsilondev_yz, &
size(b_epsilondev_xx))
endif
endif
@@ -672,15 +681,19 @@
! attenuation arrays
call transfer_fields_att_from_device(Mesh_pointer, &
R_xx,R_yy,R_xy,R_xz,R_yz,size(R_xx), &
+!ZN R_trace,R_xx,R_yy,R_xy,R_xz,R_yz,size(R_xx), &
epsilondev_xx,epsilondev_yy,epsilondev_xy,epsilondev_xz,epsilondev_yz, &
+!ZN epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy,epsilondev_xz,epsilondev_yz, &
size(epsilondev_xx))
endif
+ if(FULL_ATTENUATION_SOLID) write(27) R_trace !ZN
write(27) R_xx
write(27) R_yy
write(27) R_xy
write(27) R_xz
write(27) R_yz
+ if(FULL_ATTENUATION_SOLID) write(27) epsilondev_trace !ZN
write(27) epsilondev_xx
write(27) epsilondev_yy
write(27) epsilondev_xy
@@ -758,7 +771,9 @@
if (ATTENUATION) &
call transfer_fields_att_from_device(Mesh_pointer, &
R_xx,R_yy,R_xy,R_xz,R_yz,size(R_xx), &
+!ZN R_trace,R_xx,R_yy,R_xy,R_xz,R_yz,size(R_xx), &
epsilondev_xx,epsilondev_yy,epsilondev_xy,epsilondev_xz,epsilondev_yz, &
+!ZN epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy,epsilondev_xz,epsilondev_yz, &
size(epsilondev_xx))
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_source.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_source.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_source.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -41,7 +41,7 @@
use specfem_par,only: USE_FORCE_POINT_SOURCE,USE_RICKER_TIME_FUNCTION,factor_force_source, &
comp_dir_vect_source_E,comp_dir_vect_source_N,comp_dir_vect_source_Z_UP
-
+
implicit none
include "constants.h"
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/model_update.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/model_update.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/model_update.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -956,7 +956,7 @@
if( ATTENUATION ) then
call get_attenuation_model(myrank,NSPEC,USE_OLSEN_ATTENUATION,OLSEN_ATTENUATION_RATIO, &
- mustore_new,rho_vs_new,qmu_attenuation_store, &
+ mustore_new,rho_vs_new,kappastore_new,rho_vp_new,qmu_attenuation_store, & !ZN
ispec_is_elastic,min_resolved_period,prname_new)
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/noise_tomography.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/noise_tomography.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/noise_tomography.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -452,7 +452,7 @@
reclen=CUSTOM_REAL*NDIM*NGLLSQUARE*NSPEC_TOP
! only open files if there are surface faces in this paritition
- if(NSPEC_TOP .gt. 0) then
+ if(NSPEC_TOP > 0) then
! check integer size limit: size of b_reclen_field must fit onto an 4-byte integer
if( NSPEC_TOP > 2147483646 / (CUSTOM_REAL * NGLLSQUARE * NDIM) ) then
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_allocate_arrays.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_allocate_arrays.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_allocate_arrays.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -47,57 +47,57 @@
! stores derivatives of ux, uy and uz with respect to x, y and z
allocate(PML_dux_dxl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dux_dxl array'
+ if(ier /= 0) stop 'error allocating PML_dux_dxl array'
allocate(PML_dux_dyl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
if(ier /= 0) stop 'error allocating PML_dux_dyl array'
allocate(PML_dux_dzl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dux_dzl array'
+ if(ier /= 0) stop 'error allocating PML_dux_dzl array'
allocate(PML_duy_dxl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duy_dxl array'
+ if(ier /= 0) stop 'error allocating PML_duy_dxl array'
allocate(PML_duy_dyl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duy_dyl array'
+ if(ier /= 0) stop 'error allocating PML_duy_dyl array'
allocate(PML_duy_dzl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duy_dzl array'
+ if(ier /= 0) stop 'error allocating PML_duy_dzl array'
allocate(PML_duz_dxl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
if(ier /= 0) stop 'error allocating PML_duz_dxl array'
allocate(PML_duz_dyl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duz_dyl array'
+ if(ier /= 0) stop 'error allocating PML_duz_dyl array'
allocate(PML_duz_dzl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
if(ier /= 0) stop 'error allocating PML_duz_dzl array'
allocate(PML_dux_dxl_new(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dux_dxl_new array'
+ if(ier /= 0) stop 'error allocating PML_dux_dxl_new array'
allocate(PML_dux_dyl_new(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
if(ier /= 0) stop 'error allocating PML_dux_dyl_new array'
allocate(PML_dux_dzl_new(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dux_dzl_new array'
+ if(ier /= 0) stop 'error allocating PML_dux_dzl_new array'
allocate(PML_duy_dxl_new(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duy_dxl_new array'
+ if(ier /= 0) stop 'error allocating PML_duy_dxl_new array'
allocate(PML_duy_dyl_new(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duy_dyl_new array'
+ if(ier /= 0) stop 'error allocating PML_duy_dyl_new array'
allocate(PML_duy_dzl_new(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duy_dzl_new array'
+ if(ier /= 0) stop 'error allocating PML_duy_dzl_new array'
allocate(PML_duz_dxl_new(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
if(ier /= 0) stop 'error allocating PML_duz_dxl_new array'
allocate(PML_duz_dyl_new(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_duz_dyl_new array'
+ if(ier /= 0) stop 'error allocating PML_duz_dyl_new array'
allocate(PML_duz_dzl_new(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
if(ier /= 0) stop 'error allocating PML_duz_dzl_new array'
! stores derivatives of potential with respect to x, y and z
allocate(PML_dpotential_dxl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dpotential_dxl array'
+ if(ier /= 0) stop 'error allocating PML_dpotential_dxl array'
allocate(PML_dpotential_dyl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dpotential_dxl array'
+ if(ier /= 0) stop 'error allocating PML_dpotential_dxl array'
allocate(PML_dpotential_dzl(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dpotential_dxl array'
+ if(ier /= 0) stop 'error allocating PML_dpotential_dxl array'
allocate(PML_dpotential_dxl_new(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dpotential_dxl_new array'
+ if(ier /= 0) stop 'error allocating PML_dpotential_dxl_new array'
allocate(PML_dpotential_dyl_new(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dpotential_dxl_new array'
+ if(ier /= 0) stop 'error allocating PML_dpotential_dxl_new array'
allocate(PML_dpotential_dzl_new(NGLLX,NGLLY,NGLLZ,NSPEC_CPML),stat=ier)
- if(ier /= 0) stop 'error allocating PML_dpotential_dxl_new array'
+ if(ier /= 0) stop 'error allocating PML_dpotential_dxl_new array'
! stores C-PML memory variables
allocate(rmemory_dux_dxl_x(NGLLX,NGLLY,NGLLZ,NSPEC_CPML,3),stat=ier)
@@ -171,7 +171,7 @@
spec_to_CPML(:) = 0
CPML_type(:) = 0
-
+
PML_dux_dxl(:,:,:,:) = 0._CUSTOM_REAL
PML_dux_dyl(:,:,:,:) = 0._CUSTOM_REAL
PML_dux_dzl(:,:,:,:) = 0._CUSTOM_REAL
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_accel_contribution.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_accel_contribution.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_accel_contribution.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -29,7 +29,7 @@
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
@@ -40,7 +40,7 @@
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
@@ -50,7 +50,7 @@
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) :: A0,A1,A2,A3,A4,A5 ! for convolution of acceleration
real(kind=CUSTOM_REAL) :: temp_A3,temp_A4,temp_A5
do k=1,NGLLZ
@@ -65,7 +65,7 @@
!------------------------------------------------------------------------------
!---------------------------- X-surface C-PML ---------------------------------
!------------------------------------------------------------------------------
-
+
bb = alpha_store(i,j,k,ispec_CPML)
coef0_1 = exp(-bb * deltat)
@@ -105,7 +105,7 @@
endif
!---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_x(i,j,k,ispec_CPML)
+ 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
@@ -120,7 +120,7 @@
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) + &
+ ( 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) &
@@ -139,11 +139,11 @@
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) + &
+ ( 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) &
@@ -154,7 +154,7 @@
!------------------------------------------------------------------------------
!---------------------------- Y-surface C-PML ---------------------------------
!------------------------------------------------------------------------------
-
+
bb = alpha_store(i,j,k,ispec_CPML)
coef0_1 = exp(-bb * deltat)
@@ -194,7 +194,7 @@
endif
!---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_y(i,j,k,ispec_CPML)
+ 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
@@ -207,9 +207,9 @@
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) + &
+ ( 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) &
@@ -232,7 +232,7 @@
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) + &
+ ( 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) &
@@ -253,7 +253,7 @@
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
+ coef2_1 = deltat/2.0d0
end if
if( ispec_is_elastic(ispec) ) then
@@ -283,7 +283,7 @@
endif
!---------------------- A0, A1, A2, A3, A4 and A5 --------------------------
- A0 = k_store_z(i,j,k,ispec_CPML)
+ 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
@@ -298,7 +298,7 @@
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) + &
+ ( 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) &
@@ -321,7 +321,7 @@
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) + &
+ ( 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) &
@@ -384,7 +384,7 @@
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)
+ 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) &
@@ -412,7 +412,7 @@
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) + &
+ ( 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) &
@@ -435,14 +435,14 @@
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) + &
+ ( 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
+ elseif( CPML_regions(ispec_CPML) == 5 ) then
!------------------------------------------------------------------------------
!---------------------------- XZ-edge C-PML -----------------------------------
!------------------------------------------------------------------------------
@@ -456,7 +456,7 @@
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
+ coef2_1 = deltat/2.0d0
end if
coef0_2 = coef0_1
@@ -498,7 +498,7 @@
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)
+ 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) &
@@ -526,7 +526,7 @@
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) + &
+ ( 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) &
@@ -549,7 +549,7 @@
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) + &
+ ( 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) &
@@ -569,8 +569,8 @@
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
+ coef1_1 = deltat/2.0d0
+ coef2_1 = deltat/2.0d0
end if
coef0_2 = coef0_1
@@ -612,7 +612,7 @@
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)
+ 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) &
@@ -640,7 +640,7 @@
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) + &
+ ( 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) &
@@ -663,7 +663,7 @@
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) + &
+ ( 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) &
@@ -674,7 +674,7 @@
!------------------------------------------------------------------------------
!---------------------------- XYZ-corner C-PML --------------------------------
!------------------------------------------------------------------------------
-
+
bb = alpha_store(i,j,k,ispec_CPML)
coef0_1 = exp(-bb * deltat)
@@ -738,7 +738,7 @@
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)
+ 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)
@@ -758,14 +758,14 @@
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)
+ )
+ 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
@@ -788,7 +788,7 @@
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) + &
+ ( 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) &
@@ -811,7 +811,7 @@
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) + &
+ ( 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) &
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_memory_variables.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_memory_variables.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_compute_memory_variables.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -75,13 +75,13 @@
!---------------------- 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)
+ 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)
+ coef0_2 = exp(-bb * deltat)
- if( abs(bb) > 1.d-5 ) then
+ 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
@@ -92,15 +92,15 @@
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) &
+ 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) &
+ 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) &
+ 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) &
@@ -108,14 +108,14 @@
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)
+ + 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
@@ -127,32 +127,32 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+ 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) &
+ 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) &
+ 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)
+ + 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) &
@@ -165,20 +165,20 @@
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)
+ + 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
+ A14 = 0.d0
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
@@ -187,22 +187,22 @@
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) &
+ 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) &
+ 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) &
+ 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)
+ + 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)
+ + 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)
@@ -223,34 +223,34 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+ 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) &
+ 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)
+ + 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) &
+ 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) &
+ 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
@@ -273,7 +273,7 @@
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)
+ + 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
@@ -282,9 +282,9 @@
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)
+ + 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)
+ + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
!---------------------- A19 and A20 --------------------------
@@ -298,9 +298,9 @@
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)
+ + 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)
+ + 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
@@ -309,7 +309,7 @@
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)
+ + 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
@@ -333,40 +333,40 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+ 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) &
+ 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) &
+ 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)
+ + 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)
+ + 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)
+ + 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) &
+ 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
@@ -377,40 +377,40 @@
!---------------------- 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)
+ 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)
+ coef0_2 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+ 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) &
+ 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) &
+ 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)
+ + 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)
+ + 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
@@ -425,31 +425,31 @@
!---------------------- 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
+ A14 = 0.d0
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+
+ 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) &
+ 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) &
+ 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
@@ -458,11 +458,11 @@
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)
+ + 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) &
+ 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
@@ -482,9 +482,9 @@
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)
+ + 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)
+ + 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
@@ -493,7 +493,7 @@
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)
+ + 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)
@@ -503,41 +503,41 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+ 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) &
+ 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)
+ + 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) &
+ 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) &
+ 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)
+ + A18 * rmemory_dux_dxl_z(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_z(i,j,k,ispec_CPML,2)
!---------------------- A19 and A20--------------------------
@@ -551,9 +551,9 @@
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)
+ + 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)
+ + 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
@@ -564,7 +564,7 @@
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)
+ + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
endif
enddo
@@ -581,38 +581,38 @@
!------------------------------------------------------------------------------
!---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_z(i,j,k,ispec_CPML)
+ A6 = k_store_z(i,j,k,ispec_CPML)
A7 = d_store_z(i,j,k,ispec_CPML)
- A8 = 0.d0
+ A8 = 0.d0
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+
+ 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) &
+ 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) &
+ 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)
+ + 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) &
@@ -625,37 +625,37 @@
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)
+ + 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
+ A11 = 0.d0
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+
+ 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) &
+ 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) &
+ 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
@@ -679,36 +679,36 @@
!---------------------- 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)
+ 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)
+ coef0_2 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_2 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+ 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) &
+ 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) &
+ 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)
+ + 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) &
@@ -747,7 +747,7 @@
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)
+ + 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)
@@ -764,7 +764,7 @@
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)
+ + 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
@@ -775,7 +775,7 @@
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)
+ + 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)
@@ -783,21 +783,21 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+ 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) &
+ 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
@@ -806,11 +806,11 @@
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) &
+ 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) &
+ 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
@@ -834,12 +834,12 @@
!------------------------------------------------------------------------------
!---------------------- A6, A7 and A8 --------------------------
- A6 = k_store_y(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML)
+ 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)
+ 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)
@@ -852,23 +852,23 @@
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) &
+ 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) &
+ 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) &
+ 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)
+ + 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)
@@ -886,9 +886,9 @@
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
+ 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)
+ 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)
@@ -896,23 +896,23 @@
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
+ 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) &
+ 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) &
+ 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) &
+ 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) &
@@ -920,7 +920,7 @@
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)
+ + 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
@@ -943,18 +943,18 @@
+ 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)
+ 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)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ coef1_1 = deltat/2.0d0
+ coef2_1 = deltat/2.0d0
endif
coef0_2 = coef0_1
@@ -963,21 +963,21 @@
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) &
+ 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) &
+ 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) &
+ 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 &
+ 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) &
+ 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) &
+ 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
@@ -1007,34 +1007,34 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+ 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) &
+ 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)
+ + 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) &
+ 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) &
+ 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
@@ -1049,39 +1049,39 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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) &
+ 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) &
+ 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)
+ + 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)
+ + 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) &
+ 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) &
+ 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)
+ + 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)
@@ -1130,9 +1130,9 @@
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
+ 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)
+ 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)
@@ -1141,29 +1141,29 @@
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
+ 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) &
+ 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) &
+ 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) &
+ 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)
+ + 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)
+ + 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
@@ -1172,7 +1172,7 @@
+ 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)
+ + 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 --------------------------
@@ -1190,14 +1190,14 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ coef2_1 = deltat/2.0d0
endif
coef0_2 = coef0_1
@@ -1207,21 +1207,21 @@
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) &
+ 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) &
+ 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) &
+ 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 &
+ 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) &
+ 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) &
+ 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
@@ -1230,7 +1230,7 @@
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)
+ + 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
@@ -1244,11 +1244,11 @@
+ 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, 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
+ - 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)
@@ -1265,23 +1265,23 @@
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) &
+ 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) &
+ 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) &
+ 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)
+ + 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)
+ + 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
@@ -1300,41 +1300,41 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+ 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) &
+ 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)
+ + 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)
+ + 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) &
+ 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) &
+ 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)
+ + 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
@@ -1347,9 +1347,9 @@
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)
+ + 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)
+ + 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
@@ -1358,7 +1358,7 @@
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)
+ + 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)
@@ -1368,39 +1368,39 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+ 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) &
+ 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)
+ + 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) &
+ 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) &
+ 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)
+ + 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
@@ -1433,14 +1433,14 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ coef1_1 = deltat/2.0d0
+ coef2_1 = deltat/2.0d0
endif
coef0_2 = coef0_1
@@ -1448,22 +1448,22 @@
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) &
+
+ 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) &
+ 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) &
+ 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) &
+ 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) &
+ 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) &
+ 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
@@ -1490,7 +1490,7 @@
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
+ 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)
@@ -1505,25 +1505,25 @@
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) &
+ 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) &
+ 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) &
+ 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)
+ + 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)
+ + 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
@@ -1532,14 +1532,14 @@
+ 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
+ + 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, 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
+ 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)
@@ -1554,17 +1554,17 @@
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) &
+ 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) &
+ 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) &
+ 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) &
@@ -1596,9 +1596,9 @@
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)
+ + 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)
+ + 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
@@ -1607,9 +1607,9 @@
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)
+ + 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)
+ + 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)
@@ -1617,34 +1617,34 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+ 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) &
+ 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)
+ + 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) &
+ 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) &
+ 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
@@ -1659,21 +1659,21 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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) &
+ 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) &
+ 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
@@ -1682,18 +1682,18 @@
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) &
+ 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) &
+ 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)
+ + A20 * rmemory_dux_dxl_y(i,j,k,ispec_CPML,1) + rmemory_dux_dxl_y(i,j,k,ispec_CPML,2)
endif
enddo
@@ -1710,8 +1710,8 @@
!------------------------------------------------------------------------------
!---------------------- 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
+ A6 = k_store_y(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) / k_store_x(i,j,k,ispec_CPML)
+ if( abs(d_store_x(i,j,k,ispec_CPML)) > 1.d-5 ) then
A7 = d_store_y(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)/d_store_x(i,j,k,ispec_CPML)
A8 = ( d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) - &
d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) ) * &
@@ -1735,10 +1735,10 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
@@ -1749,7 +1749,7 @@
coef0_2 = exp(-bb * deltat)
- if( abs(bb) > 1.d-5 ) then
+ 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
@@ -1759,29 +1759,29 @@
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) &
+
+ 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) &
+ 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) &
+ 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) &
+ if( abs(d_store_x(i,j,k,ispec_CPML)) > 1.d-5 ) then
+ rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dxl_x(i,j,k,ispec_CPML,2) &
+ PML_dux_dxl_new(i,j,k,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) &
+ 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) &
+ 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) &
+ 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) &
+ 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) &
+ 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
@@ -1794,11 +1794,11 @@
+ 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
+ if(abs(d_store_x(i,j,k,ispec_CPML))> 1.d-5)then
rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dxl(i,j,k,ispec_CPML,2) &
+ PML_dpotential_dxl_new(i,j,k,ispec_CPML) * coef1_2 + PML_dpotential_dxl(i,j,k,ispec_CPML) * coef2_2
else
@@ -1813,8 +1813,8 @@
!---------------------- 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
+ A9 = k_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) / k_store_y(i,j,k,ispec_CPML)
+ if( abs(d_store_y(i,j,k,ispec_CPML)) > 1.d-5 ) then
A10 = d_store_x(i,j,k,ispec_CPML) * d_store_z(i,j,k,ispec_CPML)/d_store_y(i,j,k,ispec_CPML)
A11 = ( d_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) &
- d_store_y(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) * &
@@ -1838,52 +1838,52 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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)
+ coef0_2 = exp(-bb * deltat)
- if( abs(bb) > 1.d-5 ) then
+ 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
+ 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) &
+ 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) &
+ 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) &
+ 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) &
+ if( abs(d_store_y(i,j,k,ispec_CPML)) > 1.d-5 ) then
+ rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dyl_x(i,j,k,ispec_CPML,2) &
+ PML_dux_dyl_new(i,j,k,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) &
+ 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) &
+ 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) &
+ 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) &
+ 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) &
+ 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
@@ -1893,13 +1893,13 @@
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)
+ + 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
+ if(abs(d_store_y(i,j,k,ispec_CPML))> 1.d-5)then
rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dyl(i,j,k,ispec_CPML,2) &
+ PML_dpotential_dyl_new(i,j,k,ispec_CPML) * coef1_2 + PML_dpotential_dyl(i,j,k,ispec_CPML) * coef2_2
else
@@ -1912,9 +1912,9 @@
+ 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
+ !---------------------- A12, A13 and A14 --------------------------
+ A12 = k_store_x(i,j,k,ispec_CPML) * k_store_y(i,j,k,ispec_CPML) / k_store_z(i,j,k,ispec_CPML)
+ if( abs(d_store_z(i,j,k,ispec_CPML)) > 1.d-5 ) then
A13 = d_store_x(i,j,k,ispec_CPML) * d_store_y(i,j,k,ispec_CPML)/d_store_z(i,j,k,ispec_CPML)
A14 = ( d_store_x(i,j,k,ispec_CPML) * k_store_z(i,j,k,ispec_CPML) &
- d_store_z(i,j,k,ispec_CPML) * k_store_x(i,j,k,ispec_CPML) ) * &
@@ -1938,21 +1938,21 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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
+ 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)
+ coef0_2 = exp(-bb * deltat)
- if( abs(bb) > 1.d-5 ) then
+ 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
@@ -1962,28 +1962,28 @@
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) &
+ 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) &
+ 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) &
+ 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) &
+ if( abs(d_store_z(i,j,k,ispec_CPML)) > 1.d-5 ) then
+ rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dux_dzl_x(i,j,k,ispec_CPML,2) &
+ PML_dux_dzl_new(i,j,k,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) &
+ 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) &
+ 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) &
+ 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) &
+ 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) &
+ 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
@@ -2000,7 +2000,7 @@
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
+ if(abs(d_store_z(i,j,k,ispec_CPML))> 1.d-5)then
rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) = coef0_2 * rmemory_dpotential_dzl(i,j,k,ispec_CPML,2) &
+ PML_dpotential_dzl_new(i,j,k,ispec_CPML) * coef1_2 + PML_dpotential_dzl(i,j,k,ispec_CPML) * coef2_2
else
@@ -2020,21 +2020,21 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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) &
+ 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) &
+ 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
@@ -2043,11 +2043,11 @@
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) &
+ 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) &
+ 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
@@ -2062,34 +2062,34 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0)) / bb
+ 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) &
+ 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) &
+ 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)
+ + 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)
+ + 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) &
+ 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) &
+ 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
@@ -2104,39 +2104,39 @@
bb = alpha_store(i,j,k,ispec_CPML)
- coef0_1 = exp(-bb * deltat)
+ coef0_1 = exp(-bb * deltat)
if( abs(bb) > 1.d-5 ) then
- coef1_1 = (1.d0 - exp(-bb * deltat/2.d0))/ bb
+ 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) &
+ 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) &
+ 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)
+ + 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) &
+ 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) &
+ 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)
+ + 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
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_output_VTKs.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_output_VTKs.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_output_VTKs.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -28,12 +28,12 @@
subroutine pml_output_VTKs()
- ! outputs informations about C-PML elements in VTK-file format
+ ! outputs informations about C-PML elements in VTK-file format
use pml_par
use specfem_par, only: NGLOB_AB,NSPEC_AB,myrank,prname,xstore,ystore,zstore,ibool
use constants, only: NGLLX,NGLLY,NGLLZ,IMAIN
-
+
implicit none
! local parameters
@@ -52,7 +52,7 @@
do ispec_CPML=1,nspec_cpml
ispec = CPML_to_spec(ispec_CPML)
-
+
temp_CPML_regions(ispec) = CPML_regions(ispec_CPML)
enddo
@@ -77,7 +77,7 @@
do ispec_CPML=1,nspec_cpml
ispec = CPML_to_spec(ispec_CPML)
-
+
temp_d_store_x(:,:,:,ispec) = d_store_x(:,:,:,ispec_CPML)
temp_d_store_y(:,:,:,ispec) = d_store_y(:,:,:,ispec_CPML)
temp_d_store_z(:,:,:,ispec) = d_store_z(:,:,:,ispec_CPML)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_par.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_par.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_par.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -32,9 +32,9 @@
use constants, only: CUSTOM_REAL
- implicit none
+ implicit none
- ! number of C-PML spectral elements
+ ! number of C-PML spectral elements
integer :: NSPEC_CPML
! C-PML spectral elements global indexing
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -55,7 +55,7 @@
! Loading kinematic and dynamic fault solvers.
call BC_DYNFLT_init(prname,DT,myrank)
-
+
call BC_KINFLT_init(prname,DT,myrank)
! sets up time increments
@@ -462,7 +462,7 @@
double precision :: MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD
real(kind=CUSTOM_REAL):: scale_factorl
integer :: i,j,k,ispec,ier
- real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: scale_factor
+ real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: scale_factor,scale_factor_kappa !ZN
! if attenuation is on, shift shear moduli to center frequency of absorption period band, i.e.
! rescale mu to average (central) frequency for attenuation
@@ -476,6 +476,13 @@
if( ier /= 0 ) call exit_mpi(myrank,'error allocation scale_factor')
scale_factor(:,:,:,:) = 1._CUSTOM_REAL
+ one_minus_sum_beta_kappa(:,:,:,:) = 1._CUSTOM_REAL !ZN
+ factor_common_kappa(:,:,:,:,:) = 1._CUSTOM_REAL !ZN
+ allocate( scale_factor_kappa(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa),stat=ier) !ZN
+ if( ier /= 0 ) call exit_mpi(myrank,'error allocation scale_factor_kappa') !ZN
+ scale_factor_kappa(:,:,:,:) = 1._CUSTOM_REAL !ZN
+
+
! reads in attenuation arrays
open(unit=27, file=prname(1:len_trim(prname))//'attenuation.bin', &
status='old',action='read',form='unformatted',iostat=ier)
@@ -492,6 +499,13 @@
read(27) one_minus_sum_beta
read(27) factor_common
read(27) scale_factor
+
+ if(FULL_ATTENUATION_SOLID)then !ZN
+ read(27) one_minus_sum_beta_kappa !ZN
+ read(27) factor_common_kappa !ZN
+ read(27) scale_factor_kappa !ZN
+ endif !ZN
+
close(27)
@@ -524,12 +538,19 @@
scale_factorl = scale_factor(i,j,k,ispec)
mustore(i,j,k,ispec) = mustore(i,j,k,ispec) * scale_factorl
+ if(FULL_ATTENUATION_SOLID)then !ZN
+ ! scales kappa moduli
+ scale_factorl = scale_factor_kappa(i,j,k,ispec)
+ kappastore(i,j,k,ispec) = kappastore(i,j,k,ispec) * scale_factorl
+ endif !ZN
+
enddo
enddo
enddo
enddo
deallocate(scale_factor)
+ deallocate(scale_factor_kappa) !ZN
! statistics
! user output
@@ -546,12 +567,14 @@
! clear memory variables if attenuation
! initialize memory variables for attenuation
+ epsilondev_trace(:,:,:,:) = 0._CUSTOM_REAL !ZN
epsilondev_xx(:,:,:,:) = 0._CUSTOM_REAL
epsilondev_yy(:,:,:,:) = 0._CUSTOM_REAL
epsilondev_xy(:,:,:,:) = 0._CUSTOM_REAL
epsilondev_xz(:,:,:,:) = 0._CUSTOM_REAL
epsilondev_yz(:,:,:,:) = 0._CUSTOM_REAL
+ R_trace(:,:,:,:,:) = 0._CUSTOM_REAL !ZN
R_xx(:,:,:,:,:) = 0._CUSTOM_REAL
R_yy(:,:,:,:,:) = 0._CUSTOM_REAL
R_xy(:,:,:,:,:) = 0._CUSTOM_REAL
@@ -559,6 +582,7 @@
R_yz(:,:,:,:,:) = 0._CUSTOM_REAL
if(FIX_UNDERFLOW_PROBLEM) then
+ R_trace(:,:,:,:,:) = VERYSMALLVAL !ZN
R_xx(:,:,:,:,:) = VERYSMALLVAL
R_yy(:,:,:,:,:) = VERYSMALLVAL
R_xy(:,:,:,:,:) = VERYSMALLVAL
@@ -821,11 +845,13 @@
! memory variables if attenuation
if( ATTENUATION ) then
+ b_R_trace = 0._CUSTOM_REAL !ZN
b_R_xx = 0._CUSTOM_REAL
b_R_yy = 0._CUSTOM_REAL
b_R_xy = 0._CUSTOM_REAL
b_R_xz = 0._CUSTOM_REAL
b_R_yz = 0._CUSTOM_REAL
+ b_epsilondev_trace = 0._CUSTOM_REAL !ZN
b_epsilondev_xx = 0._CUSTOM_REAL
b_epsilondev_yy = 0._CUSTOM_REAL
b_epsilondev_xy = 0._CUSTOM_REAL
@@ -1256,11 +1282,14 @@
SAVE_FORWARD, &
COMPUTE_AND_STORE_STRAIN, &
epsilondev_xx,epsilondev_yy,epsilondev_xy, &
+!ZN epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy, &
epsilondev_xz,epsilondev_yz, &
ATTENUATION, &
size(R_xx), &
R_xx,R_yy,R_xy,R_xz,R_yz, &
+!ZN R_trace,R_xx,R_yy,R_xy,R_xz,R_yz, &
one_minus_sum_beta,factor_common, &
+!ZN one_minus_sum_beta_kappa,factor_commonkappa, &
alphaval,betaval,gammaval, &
OCEANS,rmass_ocean_load, &
NOISE_TOMOGRAPHY, &
@@ -1280,10 +1309,12 @@
COMPUTE_AND_STORE_STRAIN, &
epsilon_trace_over_3, &
b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy, &
+!ZN b_epsilondev_trace,b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy, &
b_epsilondev_xz,b_epsilondev_yz, &
b_epsilon_trace_over_3, &
ATTENUATION,size(R_xx), &
b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz, &
+!ZN b_R_trace,b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz, &
b_alphaval,b_betaval,b_gammaval, &
APPROXIMATE_HESS_KL)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -188,6 +188,10 @@
epsilondev_yz(NGLLX,NGLLY,NGLLZ,NSPEC_STRAIN_ONLY),stat=ier)
if( ier /= 0 ) stop 'error allocating array epsilondev_xx etc.'
+ allocate(R_trace(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa,N_SLS),& !ZN
+ epsilondev_trace(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa),stat=ier) !ZN
+ if( ier /= 0 ) stop 'error allocating array R_trace etc.' !ZN
+
! note: needed for argument of deville routine
allocate(epsilon_trace_over_3(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT),stat=ier)
if( ier /= 0 ) stop 'error allocating array epsilon_trace_over_3'
@@ -197,6 +201,10 @@
factor_common(N_SLS,NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array one_minus_sum_beta etc.'
+ allocate(one_minus_sum_beta_kappa(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa), & !ZN
+ factor_common_kappa(N_SLS,NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa),stat=ier) !ZN
+ if( ier /= 0 ) stop 'error allocating array one_minus_sum_beta_kappa etc.' !ZN
+
! reads mass matrices
read(27,iostat=ier) rmass
if( ier /= 0 ) stop 'error reading in array rmass'
@@ -325,7 +333,7 @@
! C-PML absorbing boundary conditions
read(27) NSPEC_CPML
read(27) CPML_width
- if( PML_CONDITIONS .and. NSPEC_CPML > 0 ) then
+ if( PML_CONDITIONS .and. NSPEC_CPML > 0 ) then
allocate(CPML_regions(NSPEC_CPML),stat=ier)
if(ier /= 0) stop 'error allocating array CPML_regions'
allocate(CPML_to_spec(NSPEC_CPML),stat=ier)
@@ -756,6 +764,11 @@
allocate(b_epsilon_trace_over_3(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT),stat=ier)
if( ier /= 0 ) stop 'error allocating array b_epsilon_trace_over_3'
+ ! allocates attenuation solids for considering kappa !ZN
+ allocate(b_R_trace(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa,N_SLS),& !ZN
+ b_epsilondev_trace(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa),stat=ier) !ZN
+ if( ier /= 0 ) stop 'error allocating array b_R_trace etc.'
+
else
! modification: Camille Mazoyer
! dummy allocation
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_sources_receivers.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_sources_receivers.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_sources_receivers.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -581,12 +581,12 @@
call lagrange_any(xi_source(isource),NGLLX,xigll,hxis,hpxis)
call lagrange_any(eta_source(isource),NGLLY,yigll,hetas,hpetas)
call lagrange_any(gamma_source(isource),NGLLZ,zigll,hgammas,hpgammas)
-
+
hxis_store(isource,:) = hxis(:)
hetas_store(isource,:) = hetas(:)
hgammas_store(isource,:) = hgammas(:)
- if (USE_FORCE_POINT_SOURCE) then ! use of FORCESOLUTION files
+ if (USE_FORCE_POINT_SOURCE) then ! use of FORCESOLUTION files
! note: for use_force_point_source xi/eta/gamma are in the range [1,NGLL*]
@@ -644,18 +644,18 @@
! note: M0 by Dahlen and Tromp, eq. 5.91
factor_source = 1.0/sqrt(2.0) * sqrt( Mxx(isource)**2 + Myy(isource)**2 + Mzz(isource)**2 &
+ 2*( Myz(isource)**2 + Mxz(isource)**2 + Mxy(isource)**2 ) )
-
+
! scales source such that it would be equivalent to explosion source moment tensor,
! where Mxx=Myy=Mzz, others Mxy,.. = zero, in equivalent elastic media
! (and getting rid of 1/sqrt(2) factor from scalar moment tensor definition above)
factor_source = factor_source * sqrt(2.0) / sqrt(3.0)
-
+
! source encoding
! determines factor +/-1 depending on sign of moment tensor
! (see e.g. Krebs et al., 2009. Fast full-wavefield seismic inversion using encoded sources,
! Geophysics, 74 (6), WCC177-WCC188.)
pm1_source_encoding(isource) = sign(1.0d0,Mxx(isource))
-
+
! source array interpolated on all element gll points (only used for non point sources)
call compute_arrays_source_acoustic(sourcearray,hxis,hetas,hgammas,factor_source)
endif
@@ -663,7 +663,7 @@
endif
! stores source excitations
sourcearrays(isource,:,:,:,:) = sourcearray(:,:,:,:)
-
+
endif
enddo
else
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D_par.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D_par.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D_par.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -84,7 +84,7 @@
integer :: num_free_surface_faces
! attenuation
- integer :: NSPEC_ATTENUATION_AB
+ integer :: NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa !ZN
character(len=256) prname_Q
! additional mass matrix for ocean load
@@ -284,17 +284,17 @@
implicit none
! memory variables and standard linear solids for attenuation
- real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: one_minus_sum_beta
- real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: factor_common
+ real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: one_minus_sum_beta,one_minus_sum_beta_kappa !ZN
+ real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: factor_common,factor_common_kappa !ZN
real(kind=CUSTOM_REAL), dimension(N_SLS) :: tau_sigma
real(kind=CUSTOM_REAL) :: min_resolved_period
real(kind=CUSTOM_REAL), dimension(N_SLS) :: &
alphaval,betaval,gammaval
real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: &
- R_xx,R_yy,R_xy,R_xz,R_yz
+ R_trace,R_xx,R_yy,R_xy,R_xz,R_yz !ZN
real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: &
- epsilondev_xx,epsilondev_yy,epsilondev_xy,epsilondev_xz,epsilondev_yz
+ epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy,epsilondev_xz,epsilondev_yz !ZN
real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: epsilon_trace_over_3
! displacement, velocity, acceleration
@@ -306,7 +306,7 @@
dummyx_loc,dummyy_loc,dummyz_loc,newtempx1,newtempx2,newtempx3,&
newtempy1,newtempy2,newtempy3,newtempz1,newtempz2,newtempz3,&
tempx1,tempx2,tempx3,tempy1,tempy2,tempy3,tempz1,tempz2,tempz3
-
+
real(kind=CUSTOM_REAL), dimension(:,:,:,:),allocatable :: &
dummyx_loc_att,dummyy_loc_att,dummyz_loc_att, &
tempx1_att,tempx2_att,tempx3_att, &
@@ -353,9 +353,9 @@
real(kind=CUSTOM_REAL), dimension(N_SLS) :: &
b_alphaval, b_betaval, b_gammaval
real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: &
- b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz
+ b_R_trace,b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz !ZN
real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: &
- b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy,b_epsilondev_xz,b_epsilondev_yz
+ b_epsilondev_trace,b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy,b_epsilondev_xz,b_epsilondev_yz !ZN
real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: b_epsilon_trace_over_3
! adjoint kernels
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_seismograms.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_seismograms.f90 2013-03-09 00:12:38 UTC (rev 21478)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_seismograms.f90 2013-03-09 01:15:50 UTC (rev 21479)
@@ -806,12 +806,12 @@
logical,parameter :: SUPPRESS_IRIS_CONVENTION = .false.
! see manual for ranges
- if (DT .ge. 1.0d0) bic = 'LX'
- if (DT .lt. 1.0d0 .and. DT .gt. 0.1d0) bic = 'MX'
- if (DT .le. 0.1d0 .and. DT .gt. 0.0125d0) bic = 'BX'
- if (DT .le. 0.0125d0 .and. DT .gt. 0.004d0) bic = 'HX'
- if (DT .le. 0.004d0 .and. DT .gt. 0.001d0) bic = 'CX'
- if (DT .le. 0.001d0) bic = 'FX'
+ if (DT >= 1.0d0) bic = 'LX'
+ if (DT < 1.0d0 .and. DT > 0.1d0) bic = 'MX'
+ if (DT <= 0.1d0 .and. DT > 0.0125d0) bic = 'BX'
+ if (DT <= 0.0125d0 .and. DT > 0.004d0) bic = 'HX'
+ if (DT <= 0.004d0 .and. DT > 0.001d0) bic = 'CX'
+ if (DT <= 0.001d0) bic = 'FX'
! ignores IRIS convention, uses previous, constant band and instrument code
if( SUPPRESS_IRIS_CONVENTION ) then
More information about the CIG-COMMITS
mailing list