[cig-commits] r20046 - in seismo/3D/SPECFEM3D/trunk: examples/BENCHMARK_CLAERBOUT_ADJOINT/ACOUSTIC examples/BENCHMARK_CLAERBOUT_ADJOINT/ACOUSTIC/in_data_files examples/BENCHMARK_CLAERBOUT_ADJOINT/ELASTIC examples/BENCHMARK_CLAERBOUT_ADJOINT/ELASTIC/in_data_files examples/Mount_StHelens/in_data_files examples/homogeneous_halfspace/in_data_files examples/homogeneous_poroelastic/in_data_files examples/layered_halfspace/in_data_files examples/meshfem3D_examples/many_interfaces examples/meshfem3D_examples/simple_model examples/meshfem3D_examples/socal1D examples/meshfem3D_examples/socal1D/example_utm examples/noise_tomography/in_data_files examples/tomographic_model/in_data_files examples/waterlayered_halfspace/in_data_files in_data_files src/decompose_mesh_SCOTCH src/generate_databases src/meshfem3D src/shared src/specfem3D
danielpeter at geodynamics.org
danielpeter at geodynamics.org
Mon May 7 04:03:04 PDT 2012
Author: danielpeter
Date: 2012-05-07 04:03:03 -0700 (Mon, 07 May 2012)
New Revision: 20046
Added:
seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_1d_cascadia.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_1d_prem.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_1d_socal.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_default.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_gll.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_salton_trough.f90
Modified:
seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ACOUSTIC/constants.h
seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ACOUSTIC/in_data_files/Par_file
seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ELASTIC/constants.h
seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ELASTIC/in_data_files/Par_file
seismo/3D/SPECFEM3D/trunk/examples/Mount_StHelens/in_data_files/Par_file
seismo/3D/SPECFEM3D/trunk/examples/homogeneous_halfspace/in_data_files/Par_file
seismo/3D/SPECFEM3D/trunk/examples/homogeneous_poroelastic/in_data_files/Par_file
seismo/3D/SPECFEM3D/trunk/examples/layered_halfspace/in_data_files/Par_file
seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/many_interfaces/Par_file
seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/simple_model/Par_file
seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/socal1D/Par_file
seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/socal1D/example_utm/Par_file_utm
seismo/3D/SPECFEM3D/trunk/examples/noise_tomography/in_data_files/Par_file_step1
seismo/3D/SPECFEM3D/trunk/examples/noise_tomography/in_data_files/Par_file_step2
seismo/3D/SPECFEM3D/trunk/examples/noise_tomography/in_data_files/Par_file_step3
seismo/3D/SPECFEM3D/trunk/examples/tomographic_model/in_data_files/Par_file
seismo/3D/SPECFEM3D/trunk/examples/waterlayered_halfspace/in_data_files/Par_file
seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file
seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90
seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/part_decompose_mesh_SCOTCH.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/Makefile.in
seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_mass_matrices.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_absorbing_boundary.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_coupling_surfaces.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_aniso.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_external_values.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_tomography.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/save_arrays_solver.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/check_mesh_quality.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/compute_parameters.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/create_regions_mesh.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/create_visual_files.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/meshfem3D.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/save_databases.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/store_boundaries.f90
seismo/3D/SPECFEM3D/trunk/src/shared/check_mesh_resolution.f90
seismo/3D/SPECFEM3D/trunk/src/shared/combine_vol_data.f90
seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in
seismo/3D/SPECFEM3D/trunk/src/shared/create_movie_shakemap_AVS_DX_GMT.f90
seismo/3D/SPECFEM3D/trunk/src/shared/parallel.f90
seismo/3D/SPECFEM3D/trunk/src/shared/read_parameter_file.f90
seismo/3D/SPECFEM3D/trunk/src/shared/read_topo_bathy_file.f90
seismo/3D/SPECFEM3D/trunk/src/shared/serial.f90
seismo/3D/SPECFEM3D/trunk/src/shared/smooth_vol_data.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_poroelastic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_elastic_po.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_poroelastic_el.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_fluid.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_poroelastic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_solid.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_receivers.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_source.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_topography_bathymetry.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/save_external_bin_m_up.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D_par.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_movie_output.f90
Log:
adds predefined 1D and 3D model options to generate_databases
Modified: seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ACOUSTIC/constants.h
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ACOUSTIC/constants.h 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ACOUSTIC/constants.h 2012-05-07 11:03:03 UTC (rev 20046)
@@ -302,14 +302,14 @@
integer, parameter :: NUM_ITER = 4
! size of topography and bathymetry file for Southern California
- integer, parameter :: NX_TOPO_SOCAL = 1401,NY_TOPO_SOCAL = 1001
- double precision, parameter :: ORIG_LAT_TOPO_SOCAL = 32.d0
- double precision, parameter :: ORIG_LONG_TOPO_SOCAL = -121.d0
- double precision, parameter :: DEGREES_PER_CELL_TOPO_SOCAL = 5.d0 / 1000.d0
- character(len=100), parameter :: TOPO_FILE_SOCAL = 'DATA/la_topography/topo_bathy_final.dat'
+ integer, parameter :: NX_TOPO_FILE = 1401,NY_TOPO_FILE = 1001
+ double precision, parameter :: ORIG_LAT_TOPO = 32.d0
+ double precision, parameter :: ORIG_LONG_TOPO = -121.d0
+ double precision, parameter :: DEGREES_PER_CELL_TOPO = 5.d0 / 1000.d0
+ character(len=100), parameter :: TOPO_FILE = 'DATA/la_topography/topo_bathy_final.dat'
! ! size of topography and bathymetry file for Piero Basini's model
-! integer, parameter :: NX_TOPO = 787, NY_TOPO = 793
+! integer, parameter :: NX_TOPO_FILE = 787, NY_TOPO_FILE = 793
! double precision, parameter :: ORIG_LAT_TOPO = -102352.d0
! double precision, parameter :: ORIG_LONG_TOPO = 729806.d0
! ! for Piero Basini's model this is the resolution in meters of the topo file
Modified: seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ACOUSTIC/in_data_files/Par_file
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ACOUSTIC/in_data_files/Par_file 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ACOUSTIC/in_data_files/Par_file 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,8 +1,11 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 3
-NOISE_TOMOGRAPHY = 0 # 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
-SAVE_FORWARD = .false.
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 3
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 0
+SAVE_FORWARD = .false.
# UTM projection parameters
UTM_PROJECTION_ZONE = 11
@@ -15,6 +18,15 @@
NSTEP = 10000
DT = 0.001
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ELASTIC/constants.h
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ELASTIC/constants.h 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ELASTIC/constants.h 2012-05-07 11:03:03 UTC (rev 20046)
@@ -302,14 +302,14 @@
integer, parameter :: NUM_ITER = 4
! size of topography and bathymetry file for Southern California
- integer, parameter :: NX_TOPO_SOCAL = 1401,NY_TOPO_SOCAL = 1001
- double precision, parameter :: ORIG_LAT_TOPO_SOCAL = 32.d0
- double precision, parameter :: ORIG_LONG_TOPO_SOCAL = -121.d0
- double precision, parameter :: DEGREES_PER_CELL_TOPO_SOCAL = 5.d0 / 1000.d0
- character(len=100), parameter :: TOPO_FILE_SOCAL = 'DATA/la_topography/topo_bathy_final.dat'
+ integer, parameter :: NX_TOPO_FILE = 1401,NY_TOPO_FILE = 1001
+ double precision, parameter :: ORIG_LAT_TOPO = 32.d0
+ double precision, parameter :: ORIG_LONG_TOPO = -121.d0
+ double precision, parameter :: DEGREES_PER_CELL_TOPO = 5.d0 / 1000.d0
+ character(len=256), parameter :: TOPO_FILE = 'DATA/la_topography/topo_bathy_final.dat'
! ! size of topography and bathymetry file for Piero Basini's model
-! integer, parameter :: NX_TOPO = 787, NY_TOPO = 793
+! integer, parameter :: NX_TOPO_FILE = 787, NY_TOPO_FILE = 793
! double precision, parameter :: ORIG_LAT_TOPO = -102352.d0
! double precision, parameter :: ORIG_LONG_TOPO = 729806.d0
! ! for Piero Basini's model this is the resolution in meters of the topo file
Modified: seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ELASTIC/in_data_files/Par_file
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ELASTIC/in_data_files/Par_file 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/BENCHMARK_CLAERBOUT_ADJOINT/ELASTIC/in_data_files/Par_file 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,8 +1,11 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 3
-NOISE_TOMOGRAPHY = 0 # 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
-SAVE_FORWARD = .false.
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 3
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 0
+SAVE_FORWARD = .false.
# UTM projection parameters
UTM_PROJECTION_ZONE = 11
@@ -15,6 +18,15 @@
NSTEP = 4000
DT = 0.0006
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/Mount_StHelens/in_data_files/Par_file
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/Mount_StHelens/in_data_files/Par_file 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/Mount_StHelens/in_data_files/Par_file 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,7 +1,10 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 1 # 1 = forward, 2 = adjoint, 3 = both simultaneously
-NOISE_TOMOGRAPHY = 0 # 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 1
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 0
SAVE_FORWARD = .false.
# UTM projection parameters
@@ -15,6 +18,15 @@
NSTEP = 2500
DT = 0.005d0
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/homogeneous_halfspace/in_data_files/Par_file
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/homogeneous_halfspace/in_data_files/Par_file 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/homogeneous_halfspace/in_data_files/Par_file 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,7 +1,10 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 1 # 1 = forward, 2 = adjoint, 3 = both simultaneously
-NOISE_TOMOGRAPHY = 0 # 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 1
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 0
SAVE_FORWARD = .false.
# UTM projection parameters
@@ -15,6 +18,15 @@
NSTEP = 1000
DT = 0.05
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/homogeneous_poroelastic/in_data_files/Par_file
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/homogeneous_poroelastic/in_data_files/Par_file 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/homogeneous_poroelastic/in_data_files/Par_file 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,6 +1,10 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 1 # 1 = forward, 2 = adjoint, 3 = both simultaneously
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 1
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 0
SAVE_FORWARD = .false.
# UTM projection parameters
@@ -14,6 +18,15 @@
NSTEP = 4000 #4000
DT = 3.d-5 #0.5d-3
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/layered_halfspace/in_data_files/Par_file
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/layered_halfspace/in_data_files/Par_file 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/layered_halfspace/in_data_files/Par_file 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,7 +1,10 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 1 # 1 = forward, 2 = adjoint, 3 = both simultaneously
-NOISE_TOMOGRAPHY = 0 # 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 1
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 0
SAVE_FORWARD = .false.
# UTM projection parameters
@@ -15,6 +18,15 @@
NSTEP = 3000
DT = 0.0075
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/many_interfaces/Par_file
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/many_interfaces/Par_file 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/many_interfaces/Par_file 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,7 +1,10 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 1 # 1 = forward, 2 = adjoint, 3 = both simultaneously
-NOISE_TOMOGRAPHY = 0 # 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 1
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 0
SAVE_FORWARD = .false.
# UTM projection parameters
@@ -15,6 +18,15 @@
NSTEP = 2000
DT = 0.03
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/simple_model/Par_file
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/simple_model/Par_file 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/simple_model/Par_file 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,7 +1,10 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 1 # 1 = forward, 2 = adjoint, 3 = both simultaneously
-NOISE_TOMOGRAPHY = 0 # 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 1
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 0
SAVE_FORWARD = .false.
# UTM projection parameters
@@ -15,6 +18,15 @@
NSTEP = 2000
DT = 0.03
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/socal1D/Par_file
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/socal1D/Par_file 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/socal1D/Par_file 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,7 +1,10 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 1 # 1 = forward, 2 = adjoint, 3 = both simultaneously
-NOISE_TOMOGRAPHY = 0 # 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 1
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 0
SAVE_FORWARD = .false.
# UTM projection parameters
@@ -15,6 +18,15 @@
NSTEP = 840
DT = 0.012
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/socal1D/example_utm/Par_file_utm
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/socal1D/example_utm/Par_file_utm 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/meshfem3D_examples/socal1D/example_utm/Par_file_utm 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,7 +1,10 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 1 # 1 = forward, 2 = adjoint, 3 = both simultaneously
-NOISE_TOMOGRAPHY = 0 # 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 1
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 0
SAVE_FORWARD = .false.
# UTM projection parameters
@@ -15,6 +18,15 @@
NSTEP = 840
DT = 0.012
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/noise_tomography/in_data_files/Par_file_step1
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/noise_tomography/in_data_files/Par_file_step1 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/noise_tomography/in_data_files/Par_file_step1 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,6 +1,9 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 1 # 1 = forward, 2 = adjoint, 3 = both simultaneously
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 1
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
NOISE_TOMOGRAPHY = 1
SAVE_FORWARD = .true.
@@ -16,6 +19,15 @@
DT = 0.05d0
NTSTEP_BETWEEN_READ_ADJSRC = 0
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/noise_tomography/in_data_files/Par_file_step2
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/noise_tomography/in_data_files/Par_file_step2 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/noise_tomography/in_data_files/Par_file_step2 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,6 +1,9 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 1 # 1 = forward, 2 = adjoint, 3 = both simultaneously
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 1
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
NOISE_TOMOGRAPHY = 2
SAVE_FORWARD = .true.
@@ -16,6 +19,15 @@
DT = 0.05d0
NTSTEP_BETWEEN_READ_ADJSRC = 0
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/noise_tomography/in_data_files/Par_file_step3
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/noise_tomography/in_data_files/Par_file_step3 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/noise_tomography/in_data_files/Par_file_step3 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,7 +1,10 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 3 # 1 = forward, 2 = adjoint, 3 = both simultaneously
-NOISE_TOMOGRAPHY = 3
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 3
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 3
SAVE_FORWARD = .false.
# UTM projection parameters
@@ -16,6 +19,15 @@
DT = 0.05d0
NTSTEP_BETWEEN_READ_ADJSRC = 0
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/tomographic_model/in_data_files/Par_file
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/tomographic_model/in_data_files/Par_file 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/tomographic_model/in_data_files/Par_file 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,7 +1,10 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 1 # 1 = forward, 2 = adjoint, 3 = both simultaneously
-NOISE_TOMOGRAPHY = 0 # 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 1
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 0
SAVE_FORWARD = .false.
# UTM projection parameters
@@ -15,6 +18,15 @@
NSTEP = 4000
DT = 0.01
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/examples/waterlayered_halfspace/in_data_files/Par_file
===================================================================
--- seismo/3D/SPECFEM3D/trunk/examples/waterlayered_halfspace/in_data_files/Par_file 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/examples/waterlayered_halfspace/in_data_files/Par_file 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,8 +1,10 @@
-
-# forward or adjoint simulation:
+# simulation input parameters
+#
+# forward or adjoint simulation
# 1 = forward, 2 = adjoint, 3 = both simultaneously
-SIMULATION_TYPE = 1
-NOISE_TOMOGRAPHY = 0 # 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+SIMULATION_TYPE = 1
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 0
SAVE_FORWARD = .false.
# UTM projection parameters
@@ -16,6 +18,15 @@
NSTEP = 4500
DT = 0.005
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
Modified: seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file
===================================================================
--- seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file 2012-05-07 11:03:03 UTC (rev 20046)
@@ -1,7 +1,10 @@
-
+# simulation input parameters
+#
# forward or adjoint simulation
-SIMULATION_TYPE = 1 # 1 = forward, 2 = adjoint, 3 = both simultaneously
-NOISE_TOMOGRAPHY = 0 # 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+# 1 = forward, 2 = adjoint, 3 = both simultaneously
+SIMULATION_TYPE = 1
+# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
+NOISE_TOMOGRAPHY = 0
SAVE_FORWARD = .false.
# UTM projection parameters
@@ -15,6 +18,15 @@
NSTEP = 1000
DT = 0.05d0
+# models:
+# available options are:
+# default (model parameters described by mesh properties)
+# 1D models available are:
+# 1d_prem,1d_socal,1d_cascadia
+# 3D models available are:
+# aniso,external,gll,salton_trough,tomo
+MODEL = default
+
# parameters describing the model
OCEANS = .false.
TOPOGRAPHY = .false.
@@ -47,7 +59,8 @@
NTSTEP_BETWEEN_OUTPUT_SEISMOS = 10000
# interval in time steps for reading adjoint traces
-NTSTEP_BETWEEN_READ_ADJSRC = 0 # 0 = read the whole adjoint sources at the same time
+# 0 = read the whole adjoint sources at the same time
+NTSTEP_BETWEEN_READ_ADJSRC = 0
# print source time function
PRINT_SOURCE_TIME_FUNCTION = .false.
Modified: seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -37,7 +37,7 @@
integer :: nparts ! e.g. 4 for partitioning for 4 CPUs or 4 processes
! mesh arrays
- integer(long) :: nspec
+ integer :: nspec
integer, dimension(:,:), allocatable :: elmnts
integer, dimension(:,:), allocatable :: mat
integer, dimension(:), allocatable :: part
@@ -62,15 +62,15 @@
integer :: ninterfaces
integer :: my_ninterface
- integer(long) :: nsize ! Max number of elements that contain the same node.
+ integer :: nsize ! Max number of elements that contain the same node.
integer :: nb_edges
integer :: ispec, inode
integer :: ngnod
integer :: max_neighbour ! Real maximum number of neighbours per element
- integer(long) :: sup_neighbour ! Majoration of the maximum number of neighbours per element
+ integer :: sup_neighbour ! Majoration of the maximum number of neighbours per element
- integer :: ipart, nnodes_loc, nspec_loc
+ integer :: ipart, nnodes_loc, nspec_local
integer :: num_elmnt, num_node, num_mat
! boundaries
@@ -120,7 +120,8 @@
implicit none
character(len=256) :: line
logical :: use_poroelastic_file
-
+ integer(long) :: nspec_long
+
! sets number of nodes per element
ngnod = esize
@@ -143,13 +144,24 @@
print*, 'total number of nodes: '
print*, ' nnodes = ', nnodes
- ! reads mesh elements indexing
- !(CUBIT calls this the connectivity, guess in the sense that it connects with the points index in
- ! the global coordinate file "nodes_coords_file"; it doesn't tell you which point is connected with others)
+ ! reads mesh elements indexing
+ !(CUBIT calls this the connectivity, guess in the sense that it connects with the points index in
+ ! the global coordinate file "nodes_coords_file"; it doesn't tell you which point is connected with others)
open(unit=98, file=localpath_name(1:len_trim(localpath_name))//'/mesh_file', &
status='old', form='formatted',iostat=ier)
if( ier /= 0 ) stop 'error opening mesh_file'
- read(98,*) nspec
+ read(98,*) nspec_long
+
+ ! debug check size limit
+ if( nspec_long > 2147483647 ) then
+ print *,'size exceeds integer 4-byte limit: ',nspec_long
+ print*,'bit size fortran: ',bit_size(nspec)
+ stop 'error number of elements too large'
+ endif
+
+ ! sets number of elements (integer 4-byte)
+ nspec = nspec_long
+
allocate(elmnts(esize,nspec),stat=ier)
if( ier /= 0 ) stop 'error allocating array elmnts'
do ispec = 1, nspec
@@ -647,7 +659,15 @@
endif
enddo
nsize = maxval(used_nodes_elmnts(:))
+
+ ! debug check size limit
+ if( ngnod * nsize - (ngnod + (ngnod/2 - 1)*nfaces) > 2147483647 ) then
+ print *,'size exceeds integer 4-byte limit: ',sup_neighbour,ngnod,nsize,nfaces
+ print*,'bit size fortran: ',bit_size(sup_neighbour)
+ endif
+
sup_neighbour = ngnod * nsize - (ngnod + (ngnod/2 - 1)*nfaces)
+
print*, ' nsize = ',nsize, 'sup_neighbour = ', sup_neighbour
end subroutine check_valence
@@ -862,7 +882,7 @@
glob2loc_nodes, nnodes, 1)
! gets number of spectral elements
- call write_partition_database(IIN_database, ipart, nspec_loc, nspec, elmnts, &
+ call write_partition_database(IIN_database, ipart, nspec_local, nspec, elmnts, &
glob2loc_elmnts, glob2loc_nodes_nparts, &
glob2loc_nodes_parts, glob2loc_nodes, part, mat, ngnod, 1)
@@ -878,9 +898,9 @@
mat_prop, undef_mat_prop)
! writes out spectral element indices
- !write(IIN_database,*) nspec_loc
- write(IIN_database) nspec_loc
- call write_partition_database(IIN_database, ipart, nspec_loc, nspec, elmnts, &
+ !write(IIN_database,*) nspec_local
+ write(IIN_database) nspec_local
+ call write_partition_database(IIN_database, ipart, nspec_local, nspec, elmnts, &
glob2loc_elmnts, glob2loc_nodes_nparts, &
glob2loc_nodes_parts, glob2loc_nodes, part, mat, ngnod, 2)
Modified: seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/part_decompose_mesh_SCOTCH.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/part_decompose_mesh_SCOTCH.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/part_decompose_mesh_SCOTCH.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -54,19 +54,19 @@
!-----------------------------------------------
! Creating dual graph (adjacency is defined by 'ncommonnodes' between two elements).
!-----------------------------------------------
- subroutine mesh2dual_ncommonnodes(nelmnts, nnodes, nsize, sup_neighbour, elmnts,&
+ subroutine mesh2dual_ncommonnodes(nspec, nnodes, nsize, sup_neighbour, elmnts,&
xadj, adjncy, &
nnodes_elmnts, nodes_elmnts, &
max_neighbour, ncommonnodes)
- integer(long), intent(in) :: nelmnts
+ integer, intent(in) :: nspec
integer, intent(in) :: nnodes
- integer(long), intent(in) :: nsize
- integer(long), intent(in) :: sup_neighbour
- integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
+ integer, intent(in) :: nsize
+ integer, intent(in) :: sup_neighbour
+ integer, dimension(0:esize*nspec-1), intent(in) :: elmnts
- integer, dimension(0:nelmnts) :: xadj
- integer, dimension(0:sup_neighbour*nelmnts-1) :: adjncy
+ integer, dimension(0:nspec) :: xadj
+ integer, dimension(0:sup_neighbour*nspec-1) :: adjncy
integer, dimension(0:nnodes-1) :: nnodes_elmnts
integer, dimension(0:nsize*nnodes-1) :: nodes_elmnts
integer, intent(out) :: max_neighbour
@@ -88,7 +88,7 @@
nb_edges = 0
! list of elements per node
- do i = 0, esize*nelmnts-1
+ do i = 0, esize*nspec-1
nodes_elmnts(elmnts(i)*nsize+nnodes_elmnts(elmnts(i))) = i/esize
nnodes_elmnts(elmnts(i)) = nnodes_elmnts(elmnts(i)) + 1
end do
@@ -144,7 +144,7 @@
max_neighbour = maxval(xadj)
! making adjacency arrays compact (to be used for partitioning)
- do i = 0, nelmnts-1
+ do i = 0, nspec-1
k = xadj(i)
xadj(i) = nb_edges
do j = 0, k-1
@@ -153,7 +153,7 @@
end do
end do
- xadj(nelmnts) = nb_edges
+ xadj(nspec) = nb_edges
end subroutine mesh2dual_ncommonnodes
@@ -163,10 +163,10 @@
!--------------------------------------------------
! construct local numbering for the elements in each partition
!--------------------------------------------------
- subroutine build_glob2loc_elmnts(nelmnts, part, glob2loc_elmnts,nparts)
+ subroutine build_glob2loc_elmnts(nspec, part, glob2loc_elmnts,nparts)
- integer(long), intent(in) :: nelmnts
- integer, dimension(0:nelmnts-1), intent(in) :: part
+ integer, intent(in) :: nspec
+ integer, dimension(0:nspec-1), intent(in) :: part
integer, dimension(:), pointer :: glob2loc_elmnts
integer :: num_glob, num_part, nparts
@@ -174,7 +174,7 @@
integer :: ier
! allocates local numbering array
- allocate(glob2loc_elmnts(0:nelmnts-1),stat=ier)
+ allocate(glob2loc_elmnts(0:nspec-1),stat=ier)
if( ier /= 0 ) stop 'error allocating array glob2loc_elmnts'
! initializes number of local elements per partition
@@ -183,7 +183,7 @@
end do
! local numbering
- do num_glob = 0, nelmnts-1
+ do num_glob = 0, nspec-1
! gets partition
num_part = part(num_glob)
! increments local numbering of elements (starting with 0,1,2,...)
@@ -199,14 +199,15 @@
!--------------------------------------------------
! construct local numbering for the nodes in each partition
!--------------------------------------------------
- subroutine build_glob2loc_nodes(nelmnts, nnodes, nsize, nnodes_elmnts, nodes_elmnts, part, &
+ subroutine build_glob2loc_nodes(nspec, nnodes, nsize, nnodes_elmnts, nodes_elmnts, part, &
glob2loc_nodes_nparts, glob2loc_nodes_parts, glob2loc_nodes,nparts)
! include './constants_decompose_mesh_SCOTCH.h'
- integer(long), intent(in) :: nelmnts, nsize
- integer, intent(in) :: nnodes
- integer, dimension(0:nelmnts-1), intent(in) :: part
+ integer, intent(in) :: nspec
+ integer, intent(in) :: nsize
+ integer, intent(in) :: nnodes
+ integer, dimension(0:nspec-1), intent(in) :: part
integer, dimension(0:nnodes-1), intent(in) :: nnodes_elmnts
integer, dimension(0:nsize*nnodes-1), intent(in) :: nodes_elmnts
integer, dimension(:), pointer :: glob2loc_nodes_nparts
@@ -288,15 +289,16 @@
! Elements with undefined material are considered as elastic elements.
!--------------------------------------------------
- subroutine build_interfaces(nelmnts, sup_neighbour, part, elmnts, xadj, adjncy, &
+ subroutine build_interfaces(nspec, sup_neighbour, part, elmnts, xadj, adjncy, &
tab_interfaces, tab_size_interfaces, ninterfaces, &
nparts)
- integer(long), intent(in) :: nelmnts, sup_neighbour
- integer, dimension(0:nelmnts-1), intent(in) :: part
- integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
- integer, dimension(0:nelmnts), intent(in) :: xadj
- integer, dimension(0:sup_neighbour*nelmnts-1), intent(in) :: adjncy
+ integer, intent(in) :: nspec
+ integer, intent(in) :: sup_neighbour
+ integer, dimension(0:nspec-1), intent(in) :: part
+ integer, dimension(0:esize*nspec-1), intent(in) :: elmnts
+ integer, dimension(0:nspec), intent(in) :: xadj
+ integer, dimension(0:sup_neighbour*nspec-1), intent(in) :: adjncy
integer, dimension(:),pointer :: tab_size_interfaces, tab_interfaces
integer, intent(out) :: ninterfaces
@@ -327,7 +329,7 @@
! and counts same elements for each interface
do num_part = 0, nparts-1
do num_part_bis = num_part+1, nparts-1
- do el = 0, nelmnts-1
+ do el = 0, nspec-1
if ( part(el) == num_part ) then
! looks at all neighbor elements
do el_adj = xadj(el), xadj(el+1)-1
@@ -358,7 +360,7 @@
do num_part = 0, nparts-1
do num_part_bis = num_part+1, nparts-1
- do el = 0, nelmnts-1
+ do el = 0, nspec-1
if ( part(el) == num_part ) then
do el_adj = xadj(el), xadj(el+1)-1
! adds element if in adjacent partition
@@ -405,20 +407,21 @@
! Elements with undefined material are considered as elastic elements.
!--------------------------------------------------
- subroutine build_interfaces_no_ac_el_sep(nelmnts, &
+ subroutine build_interfaces_no_ac_el_sep(nspec, &
sup_neighbour, part, elmnts, xadj, adjncy, &
tab_interfaces, tab_size_interfaces, ninterfaces, &
nb_materials, cs_material, num_material,nparts)
integer, intent(in) :: nb_materials,nparts
- integer(long), intent(in) :: nelmnts, sup_neighbour
- integer, dimension(0:nelmnts-1), intent(in) :: part
- integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
- integer, dimension(0:nelmnts), intent(in) :: xadj
- integer, dimension(0:sup_neighbour*nelmnts-1), intent(in) :: adjncy
+ integer, intent(in) :: nspec
+ integer, intent(in) :: sup_neighbour
+ integer, dimension(0:nspec-1), intent(in) :: part
+ integer, dimension(0:esize*nspec-1), intent(in) :: elmnts
+ integer, dimension(0:nspec), intent(in) :: xadj
+ integer, dimension(0:sup_neighbour*nspec-1), intent(in) :: adjncy
integer, dimension(:),pointer :: tab_size_interfaces, tab_interfaces
integer, intent(out) :: ninterfaces
- integer, dimension(1:nelmnts), intent(in) :: num_material
+ integer, dimension(1:nspec), intent(in) :: num_material
! vs velocities
double precision, dimension(1:nb_materials), intent(in) :: cs_material
@@ -448,7 +451,7 @@
! and counts same elements for each interface
do num_part = 0, nparts-1
do num_part_bis = num_part+1, nparts-1
- do el = 0, nelmnts-1
+ do el = 0, nspec-1
if ( part(el) == num_part ) then
! determines whether element is acoustic or not
if(num_material(el+1) > 0) then
@@ -500,7 +503,7 @@
do num_part = 0, nparts-1
do num_part_bis = num_part+1, nparts-1
- do el = 0, nelmnts-1
+ do el = 0, nspec-1
if ( part(el) == num_part ) then
if(num_material(el+1) > 0) then
if ( cs_material(num_material(el+1)) < TINYVAL) then
@@ -657,7 +660,7 @@
! Write elements on boundaries (and their four nodes on boundaries)
! pertaining to iproc partition in the corresponding Database
!--------------------------------------------------
- subroutine write_boundaries_database(IIN_database, iproc, nelmnts, nspec2D_xmin, nspec2D_xmax, &
+ subroutine write_boundaries_database(IIN_database, iproc, nspec, nspec2D_xmin, nspec2D_xmax, &
nspec2D_ymin, nspec2D_ymax, nspec2D_bottom, nspec2D_top, &
ibelm_xmin, ibelm_xmax, ibelm_ymin, &
ibelm_ymax, ibelm_bottom, ibelm_top, &
@@ -668,7 +671,7 @@
integer, intent(in) :: IIN_database
integer, intent(in) :: iproc
- integer(long), intent(in) :: nelmnts
+ integer, intent(in) :: nspec
integer, intent(in) :: nspec2D_xmin, nspec2D_xmax, nspec2D_ymin, &
nspec2D_ymax, nspec2D_bottom, nspec2D_top
integer, dimension(nspec2D_xmin), intent(in) :: ibelm_xmin
@@ -688,7 +691,7 @@
integer, dimension(:), pointer :: glob2loc_nodes_nparts
integer, dimension(:), pointer :: glob2loc_nodes_parts
integer, dimension(:), pointer :: glob2loc_nodes
- integer, dimension(1:nelmnts) :: part
+ integer, dimension(1:nspec) :: part
! local parameters
integer :: i,j
@@ -954,7 +957,7 @@
!--------------------------------------------------
! Write elements (their nodes) pertaining to iproc partition in the corresponding Database
!--------------------------------------------------
- subroutine write_partition_database(IIN_database, iproc, nspec, nelmnts, elmnts, &
+ subroutine write_partition_database(IIN_database, iproc, nspec_local, nspec, elmnts, &
glob2loc_elmnts, glob2loc_nodes_nparts, &
glob2loc_nodes_parts, glob2loc_nodes, &
part, num_modele, ngnod, num_phase)
@@ -963,12 +966,12 @@
integer, intent(in) :: IIN_database
integer, intent(in) :: num_phase, iproc
- integer(long), intent(in) :: nelmnts
- integer, intent(inout) :: nspec
- integer, dimension(0:nelmnts-1) :: part
- integer, dimension(0:esize*nelmnts-1) :: elmnts
+ integer, intent(in) :: nspec
+ integer, intent(inout) :: nspec_local
+ integer, dimension(0:nspec-1) :: part
+ integer, dimension(0:esize*nspec-1) :: elmnts
integer, dimension(:), pointer :: glob2loc_elmnts
- integer, dimension(2,nelmnts) :: num_modele
+ integer, dimension(2,nspec) :: num_modele
integer, dimension(:), pointer :: glob2loc_nodes_nparts
integer, dimension(:), pointer :: glob2loc_nodes_parts
integer, dimension(:), pointer :: glob2loc_nodes
@@ -979,16 +982,16 @@
if ( num_phase == 1 ) then
! counts number of spectral elements in this partition
- nspec = 0
- do i = 0, nelmnts-1
+ nspec_local = 0
+ do i = 0, nspec-1
if ( part(i) == iproc ) then
- nspec = nspec + 1
+ nspec_local = nspec_local + 1
end if
end do
else
! writes out element corner indices
- do i = 0, nelmnts-1
+ do i = 0, nspec-1
if ( part(i) == iproc ) then
do j = 0, ngnod-1
@@ -1207,20 +1210,20 @@
! Write elements on surface boundaries (and their four nodes on boundaries)
! pertaining to iproc partition in the corresponding Database
!--------------------------------------------------
- subroutine write_moho_surface_database(IIN_database, iproc, nelmnts, &
+ subroutine write_moho_surface_database(IIN_database, iproc, nspec, &
glob2loc_elmnts, glob2loc_nodes_nparts, &
glob2loc_nodes_parts, glob2loc_nodes, part, &
nspec2D_moho,ibelm_moho,nodes_ibelm_moho)
integer, intent(in) :: IIN_database
integer, intent(in) :: iproc
- integer(long), intent(in) :: nelmnts
+ integer, intent(in) :: nspec
integer, dimension(:), pointer :: glob2loc_elmnts
integer, dimension(:), pointer :: glob2loc_nodes_nparts
integer, dimension(:), pointer :: glob2loc_nodes_parts
integer, dimension(:), pointer :: glob2loc_nodes
- integer, dimension(1:nelmnts) :: part
+ integer, dimension(1:nspec) :: part
integer ,intent(in) :: nspec2D_moho
integer ,dimension(nspec2D_moho), intent(in) :: ibelm_moho
@@ -1291,7 +1294,7 @@
! expensive calculations in specfem simulations
!--------------------------------------------------
- subroutine acoustic_elastic_poro_load (elmnts_load,nelmnts,count_def_mat,count_undef_mat, &
+ subroutine acoustic_elastic_poro_load (elmnts_load,nspec,count_def_mat,count_undef_mat, &
num_material,mat_prop,undef_mat_prop)
!
! note:
@@ -1301,14 +1304,14 @@
!
implicit none
- integer(long),intent(in) :: nelmnts
+ integer,intent(in) :: nspec
integer, intent(in) :: count_def_mat,count_undef_mat
! load weights
- integer,dimension(1:nelmnts),intent(out) :: elmnts_load
+ integer,dimension(1:nspec),intent(out) :: elmnts_load
! materials
- integer, dimension(1:nelmnts), intent(in) :: num_material
+ integer, dimension(1:nspec), intent(in) :: num_material
double precision, dimension(16,count_def_mat),intent(in) :: mat_prop
character (len=30), dimension(6,count_undef_mat),intent(in) :: undef_mat_prop
@@ -1353,7 +1356,7 @@
! sets weights for elements
- do el = 0, nelmnts-1
+ do el = 0, nspec-1
! acoustic element (cheap)
if ( is_acoustic(num_material(el+1)) ) then
elmnts_load(el+1) = elmnts_load(el+1)*ACOUSTIC_LOAD
@@ -1375,7 +1378,7 @@
! Repartitioning : two coupled poroelastic/elastic elements are transfered to the same partition
!--------------------------------------------------
- subroutine poro_elastic_repartitioning (nelmnts, nnodes, elmnts, &
+ subroutine poro_elastic_repartitioning (nspec, nnodes, elmnts, &
nb_materials, num_material, mat_prop, &
sup_neighbour, nsize, &
nproc, part)
@@ -1383,16 +1386,17 @@
implicit none
- integer(long),intent(in) :: nelmnts
+ integer,intent(in) :: nspec
integer, intent(in) :: nnodes, nproc, nb_materials
- integer(long), intent(in) :: sup_neighbour,nsize
+ integer, intent(in) :: sup_neighbour
+ integer, intent(in) :: nsize
- integer, dimension(1:nelmnts), intent(in) :: num_material
+ integer, dimension(1:nspec), intent(in) :: num_material
double precision, dimension(16,nb_materials),intent(in) :: mat_prop
- integer, dimension(0:nelmnts-1) :: part
- integer, dimension(0:esize*nelmnts-1) :: elmnts
+ integer, dimension(0:nspec-1) :: part
+ integer, dimension(0:esize*nspec-1) :: elmnts
integer :: nfaces_coupled
!integer, intent(out) :: nfaces_coupled
@@ -1429,22 +1433,22 @@
!if( .not. any(is_elastic) ) return
! gets neighbors by 4 common nodes (face)
- allocate(xadj(0:nelmnts),stat=ier)
+ allocate(xadj(0:nspec),stat=ier)
if( ier /= 0 ) stop 'error allocating array xadj'
- allocate(adjncy(0:sup_neighbour*nelmnts-1),stat=ier)
+ allocate(adjncy(0:sup_neighbour*nspec-1),stat=ier)
if( ier /= 0 ) stop 'error allocating array adjncy'
allocate(nnodes_elmnts(0:nnodes-1),stat=ier)
if( ier /= 0 ) stop 'error allocating array nnodes_elmnts'
allocate(nodes_elmnts(0:nsize*nnodes-1),stat=ier)
if( ier /= 0 ) stop 'error allocating array nodes_elmnts'
- !call mesh2dual_ncommonnodes(nelmnts, nnodes, elmnts, xadj, adjncy, nnodes_elmnts, nodes_elmnts,4)
- call mesh2dual_ncommonnodes(nelmnts, nnodes, nsize, sup_neighbour, &
+ !call mesh2dual_ncommonnodes(nspec, nnodes, elmnts, xadj, adjncy, nnodes_elmnts, nodes_elmnts,4)
+ call mesh2dual_ncommonnodes(nspec, nnodes, nsize, sup_neighbour, &
elmnts, xadj, adjncy, nnodes_elmnts, &
nodes_elmnts, max_neighbour, 4)
! counts coupled elements
nfaces_coupled = 0
- do el = 0, nelmnts-1
+ do el = 0, nspec-1
if ( is_poroelastic(num_material(el+1)) ) then
do el_adj = xadj(el), xadj(el+1) - 1
if ( is_elastic(num_material(adjncy(el_adj)+1)) ) then
@@ -1460,7 +1464,7 @@
! stores elements indices
nfaces_coupled = 0
- do el = 0, nelmnts-1
+ do el = 0, nspec-1
if ( is_poroelastic(num_material(el+1)) ) then
do el_adj = xadj(el), xadj(el+1) - 1
if ( is_elastic(num_material(adjncy(el_adj)+1)) ) then
@@ -1496,27 +1500,28 @@
! Repartitioning : two coupled moho surface elements are transfered to the same partition
!--------------------------------------------------
- subroutine moho_surface_repartitioning (nelmnts, nnodes, elmnts, &
+ subroutine moho_surface_repartitioning (nspec, nnodes, elmnts, &
sup_neighbour, nsize, nproc, part, &
nspec2D_moho,ibelm_moho,nodes_ibelm_moho)
implicit none
! number of (spectral) elements ( <-> nspec )
- integer(long),intent(in) :: nelmnts
+ integer, intent(in) :: nspec
! number of (global) nodes, number or processes
integer, intent(in) :: nnodes, nproc
! maximum number of neighours and max number of elements-that-contain-the-same-node
- integer(long), intent(in) :: sup_neighbour,nsize
+ integer, intent(in) :: sup_neighbour
+ integer, intent(in) :: nsize
! partition index on each element
- integer, dimension(0:nelmnts-1) :: part
+ integer, dimension(0:nspec-1) :: part
! mesh element indexing
! ( elmnts(esize,nspec) )
- integer, dimension(0:esize*nelmnts-1) :: elmnts
+ integer, dimension(0:esize*nspec-1) :: elmnts
! moho surface
integer ,intent(in) :: nspec2D_moho
@@ -1543,7 +1548,7 @@
! temporary flag arrays
! element ids start from 0
- allocate( is_moho(0:nelmnts-1),stat=ier)
+ allocate( is_moho(0:nspec-1),stat=ier)
if( ier /= 0 ) stop 'error allocating array is_moho'
! node ids start from 0
allocate( node_is_moho(0:nnodes-1),stat=ier)
@@ -1567,7 +1572,7 @@
enddo
! checks if element has moho surface
- do el = 0, nelmnts-1
+ do el = 0, nspec-1
if( is_moho(el) ) cycle
! loops over all element corners
@@ -1584,30 +1589,30 @@
! statistics output
counter = 0
- do el=0, nelmnts-1
+ do el=0, nspec-1
if ( is_moho(el) ) counter = counter + 1
enddo
print*,' moho elements = ',counter
! gets neighbors by 4 common nodes (face)
! contains number of adjacent elements (neighbours)
- allocate(xadj(0:nelmnts),stat=ier)
+ allocate(xadj(0:nspec),stat=ier)
if( ier /= 0 ) stop 'error allocating array xadj'
! contains all element id indices of adjacent elements
- allocate(adjncy(0:sup_neighbour*nelmnts-1),stat=ier)
+ allocate(adjncy(0:sup_neighbour*nspec-1),stat=ier)
if( ier /= 0 ) stop 'error allocating array adjncy'
allocate(nnodes_elmnts(0:nnodes-1),stat=ier)
if( ier /= 0 ) stop 'error allocating array nnodes_elmnts'
allocate(nodes_elmnts(0:nsize*nnodes-1),stat=ier)
if( ier /= 0 ) stop 'error allocating array nodes_elmnts'
- call mesh2dual_ncommonnodes(nelmnts, nnodes, nsize, sup_neighbour, &
+ call mesh2dual_ncommonnodes(nspec, nnodes, nsize, sup_neighbour, &
elmnts, xadj, adjncy, nnodes_elmnts, &
nodes_elmnts, max_neighbour, 4)
! counts coupled elements
nfaces_coupled = 0
- do el = 0, nelmnts-1
+ do el = 0, nspec-1
if ( is_moho(el) ) then
do el_adj = xadj(el), xadj(el+1) - 1
! increments counter if it contains face
@@ -1622,7 +1627,7 @@
! stores elements indices
nfaces_coupled = 0
- do el = 0, nelmnts-1
+ do el = 0, nspec-1
if ( is_moho(el) ) then
do el_adj = xadj(el), xadj(el+1) - 1
if ( is_moho(adjncy(el_adj)) ) then
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/Makefile.in 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/Makefile.in 2012-05-07 11:03:03 UTC (rev 20046)
@@ -65,12 +65,13 @@
RANLIB = ranlib
libgendatabases_a_OBJECTS = \
+ $O/generate_databases.o \
+ $O/create_regions_mesh.o \
$O/assemble_MPI_scalar.o \
$O/calc_jacobian.o \
$O/check_mesh_resolution.o \
$O/multiply_arrays_source.o \
$O/create_name_database.o \
- $O/create_regions_mesh.o \
$O/create_mass_matrices.o \
$O/create_serial_name_database.o \
$O/define_derivation_matrices.o \
@@ -91,9 +92,14 @@
$O/gll_library.o \
$O/hex_nodes.o \
$O/lagrange_poly.o \
- $O/generate_databases.o \
+ $O/model_1d_cascadia.o \
+ $O/model_1d_prem.o \
+ $O/model_1d_socal.o \
+ $O/model_aniso.o \
+ $O/model_default.o \
$O/model_external_values.o \
- $O/model_aniso.o \
+ $O/model_gll.o \
+ $O/model_salton_trough.o \
$O/model_tomography.o \
$O/netlib_specfun_erf.o \
$O/param_reader.o \
@@ -197,23 +203,46 @@
###
###
+###
+### serial compilation without optimization
+###
+$O/serial.o: ${SHARED}/constants.h ${SHARED}/serial.f90
+ ${FCCOMPILE_CHECK} -c -o $O/serial.o ${SHARED}/serial.f90
+
+###
+### model files
+###
+$O/model_1d_prem.o: ${SHARED}/constants.h model_1d_prem.f90
+ ${FCCOMPILE_CHECK} -c -o $O/model_1d_prem.o model_1d_prem.f90
+
+$O/model_1d_cascadia.o: ${SHARED}/constants.h model_1d_cascadia.f90
+ ${FCCOMPILE_CHECK} -c -o $O/model_1d_cascadia.o model_1d_cascadia.f90
+
+$O/model_1d_socal.o: ${SHARED}/constants.h model_1d_socal.f90
+ ${FCCOMPILE_CHECK} -c -o $O/model_1d_socal.o model_1d_socal.f90
+
+$O/model_aniso.o: ${SHARED}/constants.h model_aniso.f90
+ ${FCCOMPILE_CHECK} -c -o $O/model_aniso.o model_aniso.f90
+
+$O/model_default.o: ${SHARED}/constants.h model_default.f90
+ ${FCCOMPILE_CHECK} -c -o $O/model_default.o model_default.f90
+
$O/model_external_values.o: ${SHARED}/constants.h model_external_values.f90
${FCCOMPILE_CHECK} -c -o $O/model_external_values.o model_external_values.f90
+$O/model_gll.o: ${SHARED}/constants.h model_gll.f90
+ ${FCCOMPILE_CHECK} -c -o $O/model_gll.o model_gll.f90
+
+$O/model_salton_trough.o: ${SHARED}/constants.h model_salton_trough.f90
+ ${FCCOMPILE_CHECK} -c -o $O/model_salton_trough.o model_salton_trough.f90
+
$O/model_tomography.o: ${SHARED}/constants.h model_tomography.f90
${FCCOMPILE_CHECK} -c -o $O/model_tomography.o model_tomography.f90
###
-### serial compilation without optimization
+### program files
###
-
-$O/model_aniso.o: ${SHARED}/constants.h model_aniso.f90
- ${FCCOMPILE_CHECK} -c -o $O/model_aniso.o model_aniso.f90
-
-$O/serial.o: ${SHARED}/constants.h ${SHARED}/serial.f90
- ${FCCOMPILE_CHECK} -c -o $O/serial.o ${SHARED}/serial.f90
-
$O/program_generate_databases.o: program_generate_databases.f90
${FCCOMPILE_CHECK} -c -o $O/program_generate_databases.o program_generate_databases.f90
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_mass_matrices.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_mass_matrices.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_mass_matrices.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -129,9 +129,8 @@
!
subroutine create_mass_matrices_ocean_load(nglob,nspec,ibool,OCEANS,TOPOGRAPHY, &
- UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION,NX_TOPO,NY_TOPO, &
- ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO, &
- itopo_bathy)
+ UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION, &
+ NX_TOPO,NY_TOPO,itopo_bathy)
! returns precomputed mass matrix in rmass array
@@ -149,18 +148,19 @@
! use integer array to store topography values
integer :: UTM_PROJECTION_ZONE
logical :: SUPPRESS_UTM_PROJECTION
+
integer :: NX_TOPO,NY_TOPO
- double precision :: ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO
integer, dimension(NX_TOPO,NY_TOPO) :: itopo_bathy
! local parameters
double precision :: weight
- double precision :: xval,yval,long,lat,elevation
+ double precision :: elevation
double precision :: height_oceans
- double precision :: long_corner,lat_corner,ratio_xi,ratio_eta
integer :: ix_oceans,iy_oceans,iz_oceans,ispec_oceans,ispec2D,igll,iglobnum
- integer :: icornerlong,icornerlat
integer :: ier
+
+ real(kind=CUSTOM_REAL) :: xloc,yloc,loc_elevation
+
! creates ocean load mass matrix
if(OCEANS) then
@@ -191,45 +191,17 @@
! compute local height of oceans
if( TOPOGRAPHY ) then
+
! takes elevation from topography file
- ! get coordinates of current point
- xval = xstore_dummy(iglobnum)
- yval = ystore_dummy(iglobnum)
-
- ! project x and y in UTM back to long/lat since topo file is in long/lat
- call utm_geo(long,lat,xval,yval,UTM_PROJECTION_ZONE,IUTM2LONGLAT,SUPPRESS_UTM_PROJECTION)
-
- ! get coordinate of corner in bathy/topo model
- icornerlong = int((long - ORIG_LONG_TOPO) / DEGREES_PER_CELL_TOPO) + 1
- icornerlat = int((lat - ORIG_LAT_TOPO) / DEGREES_PER_CELL_TOPO) + 1
-
- ! avoid edge effects and extend with identical point if outside model
- if(icornerlong < 1) icornerlong = 1
- if(icornerlong > NX_TOPO-1) icornerlong = NX_TOPO-1
- if(icornerlat < 1) icornerlat = 1
- if(icornerlat > NY_TOPO-1) icornerlat = NY_TOPO-1
-
- ! compute coordinates of corner
- long_corner = ORIG_LONG_TOPO + (icornerlong-1)*DEGREES_PER_CELL_TOPO
- lat_corner = ORIG_LAT_TOPO + (icornerlat-1)*DEGREES_PER_CELL_TOPO
-
- ! compute ratio for interpolation
- ratio_xi = (long - long_corner) / DEGREES_PER_CELL_TOPO
- ratio_eta = (lat - lat_corner) / DEGREES_PER_CELL_TOPO
-
- ! avoid edge effects
- if(ratio_xi < 0.) ratio_xi = 0.
- if(ratio_xi > 1.) ratio_xi = 1.
- if(ratio_eta < 0.) ratio_eta = 0.
- if(ratio_eta > 1.) ratio_eta = 1.
-
- ! interpolate elevation at current point
- elevation = &
- itopo_bathy(icornerlong,icornerlat)*(1.-ratio_xi)*(1.-ratio_eta) + &
- itopo_bathy(icornerlong+1,icornerlat)*ratio_xi*(1.-ratio_eta) + &
- itopo_bathy(icornerlong+1,icornerlat+1)*ratio_xi*ratio_eta + &
- itopo_bathy(icornerlong,icornerlat+1)*(1.-ratio_xi)*ratio_eta
-
+ xloc = xstore_dummy(iglobnum)
+ yloc = ystore_dummy(iglobnum)
+
+ call get_topo_bathy_elevation(xloc,yloc,loc_elevation, &
+ itopo_bathy,NX_TOPO,NY_TOPO, &
+ UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION)
+
+ elevation = dble(loc_elevation)
+
else
! takes elevation from z-coordinate of mesh point
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -24,7 +24,7 @@
!
!=====================================================================
-module create_regions_mesh_ext_par
+ module create_regions_mesh_ext_par
include 'constants.h'
@@ -32,7 +32,8 @@
real(kind=CUSTOM_REAL), dimension(:), allocatable :: xstore_dummy
real(kind=CUSTOM_REAL), dimension(:), allocatable :: ystore_dummy
real(kind=CUSTOM_REAL), dimension(:), allocatable :: zstore_dummy
-
+ integer :: nglob_dummy
+
! Gauss-Lobatto-Legendre points and weights of integration
double precision, dimension(:), allocatable :: xigll,yigll,zigll,wxgll,wygll,wzgll
@@ -148,7 +149,7 @@
logical :: ACOUSTIC_SIMULATION,ELASTIC_SIMULATION,POROELASTIC_SIMULATION
-end module create_regions_mesh_ext_par
+ end module create_regions_mesh_ext_par
!
!-------------------------------------------------------------------------------------------------
@@ -156,111 +157,36 @@
! main routine
-subroutine create_regions_mesh_ext(ibool, &
- xstore,ystore,zstore,nspec, &
- npointot,myrank,LOCAL_PATH, &
- nnodes_ext_mesh,nelmnts_ext_mesh, &
- nodes_coords_ext_mesh, elmnts_ext_mesh, &
- max_static_memory_size, mat_ext_mesh, materials_ext_mesh, &
- nmat_ext_mesh, undef_mat_prop, nundefMat_ext_mesh, &
- num_interfaces_ext_mesh, max_interface_size_ext_mesh, &
- my_neighbours_ext_mesh, my_nelmnts_neighbours_ext_mesh, &
- my_interfaces_ext_mesh, &
- ibool_interfaces_ext_mesh, nibool_interfaces_ext_mesh, &
- nspec2D_xmin, nspec2D_xmax, nspec2D_ymin, nspec2D_ymax, &
- NSPEC2D_BOTTOM, NSPEC2D_TOP,&
- ibelm_xmin, ibelm_xmax, ibelm_ymin, ibelm_ymax, ibelm_bottom, ibelm_top, &
- nodes_ibelm_xmin,nodes_ibelm_xmax,nodes_ibelm_ymin,nodes_ibelm_ymax,&
- nodes_ibelm_bottom,nodes_ibelm_top, &
- SAVE_MESH_FILES, &
- nglob, &
- ANISOTROPY,NPROC,OCEANS,TOPOGRAPHY, &
- ATTENUATION,USE_OLSEN_ATTENUATION, &
- UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION,NX_TOPO,NY_TOPO, &
- ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO, &
- itopo_bathy, &
- nspec2D_moho_ext,ibelm_moho,nodes_ibelm_moho)
+ subroutine create_regions_mesh()
! create the different regions of the mesh
+
+ use generate_databases_par,only: &
+ nspec => NSPEC_AB,nglob => NGLOB_AB, &
+ ibool,xstore,ystore,zstore, &
+ npointot,myrank,LOCAL_PATH, &
+ nnodes_ext_mesh,nelmnts_ext_mesh, &
+ nodes_coords_ext_mesh, elmnts_ext_mesh, &
+ max_static_memory_size, mat_ext_mesh, materials_ext_mesh, &
+ nmat_ext_mesh, undef_mat_prop, nundefMat_ext_mesh, &
+ num_interfaces_ext_mesh, max_interface_size_ext_mesh, &
+ my_neighbours_ext_mesh, my_nelmnts_neighbours_ext_mesh, &
+ my_interfaces_ext_mesh, &
+ ibool_interfaces_ext_mesh, nibool_interfaces_ext_mesh, &
+ nspec2D_xmin, nspec2D_xmax, nspec2D_ymin, nspec2D_ymax, &
+ NSPEC2D_BOTTOM, NSPEC2D_TOP,&
+ ibelm_xmin, ibelm_xmax, ibelm_ymin, ibelm_ymax, ibelm_bottom, ibelm_top, &
+ nodes_ibelm_xmin,nodes_ibelm_xmax,nodes_ibelm_ymin,nodes_ibelm_ymax,&
+ nodes_ibelm_bottom,nodes_ibelm_top, &
+ SAVE_MESH_FILES, &
+ ANISOTROPY,NPROC,OCEANS,TOPOGRAPHY, &
+ ATTENUATION,USE_OLSEN_ATTENUATION, &
+ UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION, &
+ NX_TOPO,NY_TOPO,itopo_bathy, &
+ nspec2D_moho_ext,ibelm_moho,nodes_ibelm_moho
use create_regions_mesh_ext_par
implicit none
- !include "constants.h"
-! number of spectral elements in each block
- integer :: nspec
-
-! arrays with the mesh
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
- double precision, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: xstore,ystore,zstore
-
- integer :: npointot
-
-! proc numbers for MPI
- integer :: myrank
- integer :: NPROC
-
- character(len=256) :: LOCAL_PATH
-
-! data from the external mesh
- integer :: nnodes_ext_mesh,nelmnts_ext_mesh
- double precision, dimension(NDIM,nnodes_ext_mesh) :: nodes_coords_ext_mesh
- integer, dimension(ESIZE,nelmnts_ext_mesh) :: elmnts_ext_mesh
-
-! static memory size needed by the solver
- double precision :: max_static_memory_size
-
- integer, dimension(2,nelmnts_ext_mesh) :: mat_ext_mesh
-
-! material properties
- integer :: nmat_ext_mesh,nundefMat_ext_mesh
- double precision, dimension(16,nmat_ext_mesh) :: materials_ext_mesh
- character (len=30), dimension(6,nundefMat_ext_mesh):: undef_mat_prop
-
-! double precision, external :: materials_ext_mesh
-
-! MPI communication
- integer :: num_interfaces_ext_mesh,max_interface_size_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: my_neighbours_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: my_nelmnts_neighbours_ext_mesh
- integer, dimension(6,max_interface_size_ext_mesh,num_interfaces_ext_mesh) :: my_interfaces_ext_mesh
- integer, dimension(NGLLX*NGLLX*max_interface_size_ext_mesh,num_interfaces_ext_mesh) :: ibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: nibool_interfaces_ext_mesh
-
-! absorbing boundaries
- integer :: nspec2D_xmin, nspec2D_xmax, nspec2D_ymin, nspec2D_ymax, NSPEC2D_BOTTOM, NSPEC2D_TOP
- integer, dimension(nspec2D_xmin) :: ibelm_xmin
- integer, dimension(nspec2D_xmax) :: ibelm_xmax
- integer, dimension(nspec2D_ymin) :: ibelm_ymin
- integer, dimension(nspec2D_ymax) :: ibelm_ymax
- integer, dimension(NSPEC2D_BOTTOM) :: ibelm_bottom
- integer, dimension(NSPEC2D_TOP) :: ibelm_top
- ! node indices of boundary faces
- integer, dimension(4,nspec2D_xmin) :: nodes_ibelm_xmin
- integer, dimension(4,nspec2D_xmax) :: nodes_ibelm_xmax
- integer, dimension(4,nspec2D_ymin) :: nodes_ibelm_ymin
- integer, dimension(4,nspec2D_ymax) :: nodes_ibelm_ymax
- integer, dimension(4,NSPEC2D_BOTTOM) :: nodes_ibelm_bottom
- integer, dimension(4,NSPEC2D_TOP) :: nodes_ibelm_top
-
- integer :: nglob
-
- logical :: SAVE_MESH_FILES
- logical :: ANISOTROPY
- logical :: OCEANS,TOPOGRAPHY
- logical :: ATTENUATION,USE_OLSEN_ATTENUATION
-
-! use integer array to store topography values
- integer :: UTM_PROJECTION_ZONE
- logical :: SUPPRESS_UTM_PROJECTION
- integer :: NX_TOPO,NY_TOPO
- double precision :: ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO
- integer, dimension(NX_TOPO,NY_TOPO) :: itopo_bathy
-
-! moho (optional)
- integer :: nspec2D_moho_ext
- integer, dimension(nspec2D_moho_ext) :: ibelm_moho
- integer, dimension(4,nspec2D_moho_ext) :: nodes_ibelm_moho
-
! local parameters
! static memory size needed by the solver
double precision :: static_memory_size
@@ -328,7 +254,7 @@
if( myrank == 0) then
write(IMAIN,*) ' ...preparing MPI interfaces '
endif
- call get_MPI(myrank,nglob,nspec,ibool, &
+ call get_MPI(myrank,nglob_dummy,nspec,ibool, &
nelmnts_ext_mesh,elmnts_ext_mesh, &
my_nelmnts_neighbours_ext_mesh, my_interfaces_ext_mesh, &
ibool_interfaces_ext_mesh, &
@@ -336,22 +262,12 @@
num_interfaces_ext_mesh,max_interface_size_ext_mesh,&
my_neighbours_ext_mesh,NPROC)
-! sets material velocities
- call sync_all()
- if( myrank == 0) then
- write(IMAIN,*) ' ...determining velocity model'
- endif
- call get_model(myrank,nspec,ibool,mat_ext_mesh,nelmnts_ext_mesh, &
- materials_ext_mesh,nmat_ext_mesh, &
- undef_mat_prop,nundefMat_ext_mesh, &
- ANISOTROPY,LOCAL_PATH)
-
! sets up absorbing/free surface boundaries
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...setting up absorbing boundaries '
endif
- call get_absorbing_boundary(myrank,nspec,nglob,ibool, &
+ call get_absorbing_boundary(myrank,nspec,ibool, &
nodes_coords_ext_mesh,nnodes_ext_mesh, &
ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
nodes_ibelm_xmin,nodes_ibelm_xmax,nodes_ibelm_ymin,nodes_ibelm_ymax, &
@@ -359,13 +275,24 @@
nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
nspec2D_bottom,nspec2D_top)
+! sets material velocities
+ call sync_all()
+ if( myrank == 0) then
+ write(IMAIN,*) ' ...determining velocity model'
+ endif
+ call get_model(myrank,nspec,ibool,mat_ext_mesh,nelmnts_ext_mesh, &
+ materials_ext_mesh,nmat_ext_mesh, &
+ undef_mat_prop,nundefMat_ext_mesh, &
+ ANISOTROPY,LOCAL_PATH)
+
+
! sets up acoustic-elastic-poroelastic coupling surfaces
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...detecting acoustic-elastic-poroelastic surfaces '
endif
call get_coupling_surfaces(myrank, &
- nspec,nglob,ibool,NPROC, &
+ nspec,ibool,NPROC, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
my_neighbours_ext_mesh)
@@ -377,7 +304,7 @@
if( myrank == 0) then
write(IMAIN,*) ' ...setting up Moho surface'
endif
- call crm_setup_moho(myrank,nglob,nspec, &
+ call crm_setup_moho(myrank,nspec, &
nspec2D_moho_ext,ibelm_moho,nodes_ibelm_moho, &
nodes_coords_ext_mesh,nnodes_ext_mesh,ibool )
endif
@@ -387,24 +314,23 @@
if( myrank == 0) then
write(IMAIN,*) ' ...creating mass matrix '
endif
- call create_mass_matrices(nglob,nspec,ibool)
+ call create_mass_matrices(nglob_dummy,nspec,ibool)
! creates ocean load mass matrix
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...creating ocean load mass matrix '
endif
- call create_mass_matrices_ocean_load(nglob,nspec,ibool,OCEANS,TOPOGRAPHY, &
- UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION,NX_TOPO,NY_TOPO, &
- ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO, &
- itopo_bathy)
+ call create_mass_matrices_ocean_load(nglob_dummy,nspec,ibool,OCEANS,TOPOGRAPHY, &
+ UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION, &
+ NX_TOPO,NY_TOPO,itopo_bathy)
! locates inner and outer elements
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...element inner/outer separation '
endif
- call crm_setup_inner_outer_elemnts(myrank,nspec,nglob, &
+ call crm_setup_inner_outer_elemnts(myrank,nspec, &
num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
ibool,SAVE_MESH_FILES)
@@ -415,7 +341,7 @@
write(IMAIN,*) ' ...saving databases'
endif
!call create_name_database(prname,myrank,LOCAL_PATH)
- call save_arrays_solver_ext_mesh(nspec,nglob, &
+ call save_arrays_solver_ext_mesh(nspec,nglob_dummy, &
xixstore,xiystore,xizstore,etaxstore,etaystore,etazstore,&
gammaxstore,gammaystore,gammazstore, &
jacobianstore, rho_vp,rho_vs,qmu_attenuation_store, &
@@ -462,17 +388,18 @@
! computes the approximate amount of static memory needed to run the solver
call sync_all()
- call memory_eval(nspec,nglob,maxval(nibool_interfaces_ext_mesh),num_interfaces_ext_mesh, &
+ call memory_eval(nspec,nglob_dummy,maxval(nibool_interfaces_ext_mesh),num_interfaces_ext_mesh, &
OCEANS,static_memory_size)
call max_all_dp(static_memory_size, max_static_memory_size)
! checks the mesh, stability and resolved period
call sync_all()
!chris: check for poro: At the moment cpI & cpII are for eta=0
- call check_mesh_resolution_poro(myrank,nspec,nglob,ibool,&
+ call check_mesh_resolution_poro(myrank,nspec,nglob_dummy,ibool,&
xstore_dummy,ystore_dummy,zstore_dummy, &
-1.0d0, model_speed_max,min_resolved_period, &
- phistore,tortstore,rhoarraystore,rho_vpI,rho_vpII,rho_vsI )
+ phistore,tortstore,rhoarraystore,rho_vpI,rho_vpII,rho_vsI, &
+ LOCAL_PATH,SAVE_MESH_FILES )
! saves binary mesh files for attenuation
if( ATTENUATION ) then
@@ -488,7 +415,7 @@
! prname_file = prname(1:len_trim(prname))//'material_flag'
! allocate(elem_flag(nspec))
! elem_flag(:) = mat_ext_mesh(1,:)
-! call write_VTK_data_elem_i(nspec,nglob, &
+! call write_VTK_data_elem_i(nspec,nglob_dummy, &
! xstore_dummy,ystore_dummy,zstore_dummy,ibool, &
! elem_flag,prname_file)
! deallocate(elem_flag)
@@ -500,7 +427,7 @@
! ! if( iboun(1,ispec) ) itest_flag(ispec) = 1
! ! enddo
! ! prname_file = prname(1:len_trim(prname))//'iboundary1_flag'
-! ! call write_VTK_data_elem_i(nspec,nglob, &
+! ! call write_VTK_data_elem_i(nspec,nglob_dummy, &
! ! xstore_dummy,ystore_dummy,zstore_dummy,ibool, &
! ! itest_flag,prname_file)
! ! deallocate(itest_flag)
@@ -516,7 +443,7 @@
deallocate(rho_vpI,rho_vpII,rho_vsI)
deallocate(rhoarraystore,kappaarraystore,etastore,phistore,tortstore,permstore)
-end subroutine create_regions_mesh_ext
+end subroutine create_regions_mesh
!
!-------------------------------------------------------------------------------------------------
@@ -862,9 +789,10 @@
deallocate(ifseg,stat=ier); if(ier /= 0) stop 'error in deallocate'
! unique global point locations
- allocate(xstore_dummy(nglob), &
- ystore_dummy(nglob), &
- zstore_dummy(nglob),stat=ier)
+ nglob_dummy = nglob
+ allocate(xstore_dummy(nglob_dummy), &
+ ystore_dummy(nglob_dummy), &
+ zstore_dummy(nglob_dummy),stat=ier)
if(ier /= 0) stop 'error in allocate'
do ispec = 1, nspec
do k = 1, NGLLZ
@@ -886,7 +814,7 @@
!
- subroutine crm_setup_moho( myrank,nglob,nspec, &
+ subroutine crm_setup_moho( myrank,nspec, &
nspec2D_moho_ext,ibelm_moho,nodes_ibelm_moho, &
nodes_coords_ext_mesh,nnodes_ext_mesh,ibool )
@@ -897,7 +825,7 @@
integer, dimension(nspec2D_moho_ext) :: ibelm_moho
integer, dimension(4,nspec2D_moho_ext) :: nodes_ibelm_moho
- integer :: myrank,nglob,nspec
+ integer :: myrank,nspec
! data from the external mesh
integer :: nnodes_ext_mesh
@@ -942,8 +870,8 @@
reshape( (/ 1,2,2, NGLLX,2,2, 2,1,2, 2,NGLLY,2, 2,2,1, 2,2,NGLLZ /),(/3,6/)) ! top
! temporary arrays for passing information
- allocate(iglob_is_surface(nglob), &
- iglob_normals(NDIM,nglob),stat=ier)
+ allocate(iglob_is_surface(nglob_dummy), &
+ iglob_normals(NDIM,nglob_dummy),stat=ier)
if( ier /= 0 ) stop 'error allocating array iglob_is_surface'
iglob_is_surface = 0
@@ -967,7 +895,7 @@
! sets face id of reference element associated with this face
call get_element_face_id(ispec,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
iface)
@@ -976,7 +904,7 @@
! weighted jacobian and normal
call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob,&
+ xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy,&
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLZ)
@@ -986,7 +914,7 @@
do j=1,NGLLY
do i=1,NGLLX
call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
normal_face(:,i,j) )
enddo
@@ -1061,7 +989,7 @@
! re-computes face infos
! weighted jacobian and normal
call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob,&
+ xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy,&
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLZ)
@@ -1071,7 +999,7 @@
do j=1,NGLLZ
do i=1,NGLLX
call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
normal_face(:,i,j) )
enddo
@@ -1086,7 +1014,7 @@
! determines whether normal points into element or not (top/bottom distinction)
call get_element_face_normal_idirect(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
normal,idirect )
@@ -1215,7 +1143,7 @@
!-------------------------------------------------------------------------------------------------
!
- subroutine crm_setup_inner_outer_elemnts(myrank,nspec,nglob, &
+ subroutine crm_setup_inner_outer_elemnts(myrank,nspec, &
num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
ibool,SAVE_MESH_FILES)
@@ -1225,7 +1153,7 @@
use create_regions_mesh_ext_par
implicit none
- integer :: myrank,nspec,nglob
+ integer :: myrank,nspec
integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
! MPI interfaces
@@ -1249,7 +1177,7 @@
if( ier /= 0 ) stop 'error allocating array ispec_is_inner'
! temporary array
- allocate(iglob_is_inner(nglob),stat=ier)
+ allocate(iglob_is_inner(nglob_dummy),stat=ier)
if( ier /= 0 ) stop 'error allocating temporary array iglob_is_inner'
! initialize flags
@@ -1279,7 +1207,7 @@
if( SAVE_MESH_FILES ) then
filename = prname(1:len_trim(prname))//'ispec_is_inner'
- call write_VTK_data_elem_l(nspec,nglob, &
+ call write_VTK_data_elem_l(nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy,ibool, &
ispec_is_inner,filename)
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -192,7 +192,7 @@
include "constants.h"
! number of spectral elements in each block
- integer nspec,npointot
+ integer npointot
! local to global indexing array
integer, dimension(:,:,:,:), allocatable :: ibool
@@ -206,9 +206,8 @@
! use integer array to store topography values
integer :: UTM_PROJECTION_ZONE
logical :: SUPPRESS_UTM_PROJECTION
+
integer :: NX_TOPO,NY_TOPO
- double precision :: ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO
- character(len=100) :: topo_file
integer, dimension(:,:), allocatable :: itopo_bathy
! timer MPI
@@ -288,14 +287,15 @@
integer, dimension(:), allocatable :: ibelm_moho
integer, dimension(:,:), allocatable :: nodes_ibelm_moho
- integer :: nglob,nglob_total,nspec_total
+ integer :: nglob_total,nspec_total
logical,dimension(:),allocatable :: ispec_is_surface_external_mesh,iglob_is_surface_external_mesh
integer :: nfaces_surface_ext_mesh,nfaces_surface_glob_ext_mesh
! flag for noise simulation
integer :: NOISE_TOMOGRAPHY
-
+ integer :: IMODEL
+
end module generate_databases_par
!
@@ -380,15 +380,17 @@
NTSTEP_BETWEEN_FRAMES,USE_HIGHRES_FOR_MOVIES,HDUR_MOVIE, &
SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION, &
NTSTEP_BETWEEN_OUTPUT_INFO,SIMULATION_TYPE,SAVE_FORWARD, &
- NTSTEP_BETWEEN_READ_ADJSRC,NOISE_TOMOGRAPHY)
+ NTSTEP_BETWEEN_READ_ADJSRC,NOISE_TOMOGRAPHY,IMODEL)
! check that the code is running with the requested nb of processes
if(sizeprocs /= NPROC) then
if( myrank == 0 ) then
write(IMAIN,*) 'error: number of processors supposed to run on: ',NPROC
write(IMAIN,*) 'error: number of MPI processors actually run on: ',sizeprocs
- print*, 'error: number of processors supposed to run on: ',NPROC
- print*, 'error: number of MPI processors actually run on: ',sizeprocs
+ print*
+ print*, 'error generate_databases: number of processors supposed to run on: ',NPROC
+ print*, 'error generate_databases: number of MPI processors actually run on: ',sizeprocs
+ print*
endif
call exit_MPI(myrank,'wrong number of MPI processes')
endif
@@ -416,6 +418,28 @@
write(IMAIN,*) 'Shape functions defined by NGNOD = ',NGNOD,' control nodes'
write(IMAIN,*) 'Surface shape functions defined by NGNOD2D = ',NGNOD2D,' control nodes'
write(IMAIN,*)
+
+ write(IMAIN,'(a)',advance='no') ' velocity model: '
+ select case(IMODEL)
+ case( IMODEL_DEFAULT )
+ write(IMAIN,'(a)',advance='yes') ' default '
+ case( IMODEL_GLL )
+ write(IMAIN,'(a)',advance='yes') ' gll'
+ case( IMODEL_1D_PREM )
+ write(IMAIN,'(a)',advance='yes') ' 1d_prem'
+ case( IMODEL_1D_CASCADIA )
+ write(IMAIN,'(a)',advance='yes') ' 1d_cascadia'
+ case( IMODEL_1D_SOCAL )
+ write(IMAIN,'(a)',advance='yes') ' 1d_socal'
+ case( IMODEL_SALTON_TROUGH )
+ write(IMAIN,'(a)',advance='yes') ' salton_trough'
+ case( IMODEL_TOMO )
+ write(IMAIN,'(a)',advance='yes') ' tomo'
+ case( IMODEL_USER_EXTERNAL )
+ write(IMAIN,'(a)',advance='yes') ' external'
+ end select
+
+ write(IMAIN,*)
endif
! check that reals are either 4 or 8 bytes
@@ -503,18 +527,13 @@
if( OCEANS .and. TOPOGRAPHY ) then
- ! for Southern California
- NX_TOPO = NX_TOPO_SOCAL
- NY_TOPO = NY_TOPO_SOCAL
- ORIG_LAT_TOPO = ORIG_LAT_TOPO_SOCAL
- ORIG_LONG_TOPO = ORIG_LONG_TOPO_SOCAL
- DEGREES_PER_CELL_TOPO = DEGREES_PER_CELL_TOPO_SOCAL
- topo_file = TOPO_FILE_SOCAL
-
+ ! values given in constants.h
+ NX_TOPO = NX_TOPO_FILE
+ NY_TOPO = NY_TOPO_FILE
allocate(itopo_bathy(NX_TOPO,NY_TOPO),stat=ier)
if( ier /= 0 ) stop 'error allocating array itopo_bathy'
- call read_topo_bathy_file(itopo_bathy,NX_TOPO,NY_TOPO,topo_file)
+ call read_topo_bathy_file(itopo_bathy,NX_TOPO,NY_TOPO)
if(myrank == 0) then
write(IMAIN,*)
@@ -881,24 +900,21 @@
use generate_databases_par
implicit none
-! assign theoretical number of elements
- nspec = NSPEC_AB
+ ! compute maximum number of points
+ npointot = NSPEC_AB * NGLLCUBE
-! compute maximum number of points
- npointot = nspec * NGLLCUBE
-
! use dynamic allocation to allocate memory for arrays
-! allocate(idoubling(nspec))
- allocate(ibool(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
+! allocate(idoubling(NSPEC_AB))
+ allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array ibool'
- allocate(xstore(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
+ allocate(xstore(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array xstore'
- allocate(ystore(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
+ allocate(ystore(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array ystore'
- allocate(zstore(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
+ allocate(zstore(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
- call memory_eval_mesher(myrank,nspec,npointot,nnodes_ext_mesh, &
+ call memory_eval_mesher(myrank,NSPEC_AB,npointot,nnodes_ext_mesh, &
nelmnts_ext_mesh,nmat_ext_mesh,num_interfaces_ext_mesh, &
max_interface_size_ext_mesh,nspec2D_xmin,nspec2D_xmax, &
nspec2D_ymin,nspec2D_ymax,nspec2D_bottom,nspec2D_top, &
@@ -913,42 +929,16 @@
if(myrank == 0) then
write(IMAIN,*) 'create regions: '
endif
- call create_regions_mesh_ext(ibool, &
- xstore, ystore, zstore, nspec, &
- npointot, myrank, LOCAL_PATH, &
- nnodes_ext_mesh, nelmnts_ext_mesh, &
- nodes_coords_ext_mesh, elmnts_ext_mesh, &
- max_static_memory_size, mat_ext_mesh, materials_ext_mesh, &
- nmat_ext_mesh, undef_mat_prop, nundefMat_ext_mesh, &
- num_interfaces_ext_mesh, max_interface_size_ext_mesh, &
- my_neighbours_ext_mesh, my_nelmnts_neighbours_ext_mesh, &
- my_interfaces_ext_mesh, &
- ibool_interfaces_ext_mesh, nibool_interfaces_ext_mesh, &
- nspec2D_xmin, nspec2D_xmax, nspec2D_ymin, nspec2D_ymax, &
- NSPEC2D_BOTTOM, NSPEC2D_TOP,&
- ibelm_xmin, ibelm_xmax, ibelm_ymin, ibelm_ymax, ibelm_bottom, ibelm_top, &
- nodes_ibelm_xmin,nodes_ibelm_xmax,nodes_ibelm_ymin,nodes_ibelm_ymax, &
- nodes_ibelm_bottom,nodes_ibelm_top, &
- SAVE_MESH_FILES, &
- nglob, &
- ANISOTROPY,NPROC,OCEANS,TOPOGRAPHY, &
- ATTENUATION,USE_OLSEN_ATTENUATION, &
- UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION,NX_TOPO,NY_TOPO, &
- ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO, &
- itopo_bathy, &
- nspec2D_moho_ext,ibelm_moho,nodes_ibelm_moho)
-
+ call create_regions_mesh()
+
! now done inside create_regions_mesh_ext routine...
! Moho boundary parameters, 2-D jacobians and normals
! if( SAVE_MOHO_MESH ) then
-! call create_regions_mesh_save_moho(myrank,nglob,nspec, &
+! call create_regions_mesh_save_moho(myrank,nglob,NSPEC_AB, &
! nspec2D_moho_ext,ibelm_moho,nodes_ibelm_moho, &
! nodes_coords_ext_mesh,nnodes_ext_mesh,ibool )
! endif
-! defines global number of nodes in model
- NGLOB_AB = nglob
-
! print min and max of topography included
min_elevation = HUGEVAL
max_elevation = -HUGEVAL
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_absorbing_boundary.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_absorbing_boundary.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_absorbing_boundary.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -24,7 +24,7 @@
!
!=====================================================================
- subroutine get_absorbing_boundary(myrank,nspec,nglob,ibool, &
+ subroutine get_absorbing_boundary(myrank,nspec,ibool, &
nodes_coords_ext_mesh,nnodes_ext_mesh, &
ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
nodes_ibelm_xmin,nodes_ibelm_xmax,nodes_ibelm_ymin,nodes_ibelm_ymax, &
@@ -38,7 +38,7 @@
implicit none
! number of spectral elements in each block
- integer :: myrank,nspec,nglob
+ integer :: myrank,nspec
! arrays with the mesh
integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
@@ -111,7 +111,7 @@
! sets face id of reference element associated with this face
call get_element_face_id(ispec,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
iface)
@@ -122,7 +122,7 @@
! weighted jacobian and normal
call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob,&
+ xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy,&
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLZ)
@@ -132,7 +132,7 @@
do j=1,NGLLZ
do i=1,NGLLX
call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
normal_face(:,i,j) )
enddo
@@ -170,7 +170,7 @@
! sets face id of reference element associated with this face
call get_element_face_id(ispec,xcoord,ycoord,zcoord,&
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
iface )
iboun(iface,ispec) = .true.
@@ -180,7 +180,7 @@
! weighted jacobian and normal
call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob,&
+ xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy,&
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLZ)
@@ -190,7 +190,7 @@
do j=1,NGLLZ
do i=1,NGLLX
call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
normal_face(:,i,j) )
enddo
@@ -228,7 +228,7 @@
! sets face id of reference element associated with this face
call get_element_face_id(ispec,xcoord,ycoord,zcoord,&
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
iface )
iboun(iface,ispec) = .true.
@@ -238,7 +238,7 @@
! weighted jacobian and normal
call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob,&
+ xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy,&
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
ispec,iface,jacobian2Dw_face,normal_face,NGLLY,NGLLZ)
@@ -248,7 +248,7 @@
do j=1,NGLLZ
do i=1,NGLLY
call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
normal_face(:,i,j) )
enddo
@@ -286,7 +286,7 @@
! sets face id of reference element associated with this face
call get_element_face_id(ispec,xcoord,ycoord,zcoord,&
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
iface )
iboun(iface,ispec) = .true.
@@ -296,7 +296,7 @@
! weighted jacobian and normal
call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob, &
+ xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy, &
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
ispec,iface,jacobian2Dw_face,normal_face,NGLLY,NGLLZ)
@@ -306,7 +306,7 @@
do j=1,NGLLZ
do i=1,NGLLY
call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
normal_face(:,i,j) )
enddo
@@ -344,7 +344,7 @@
! sets face id of reference element associated with this face
call get_element_face_id(ispec,xcoord,ycoord,zcoord,&
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
iface )
iboun(iface,ispec) = .true.
@@ -354,7 +354,7 @@
! weighted jacobian and normal
call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob, &
+ xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy, &
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLY)
@@ -364,7 +364,7 @@
do j=1,NGLLY
do i=1,NGLLX
call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
normal_face(:,i,j) )
enddo
@@ -404,7 +404,7 @@
! sets face id of reference element associated with this face
call get_element_face_id(ispec,xcoord,ycoord,zcoord,&
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
iface )
iboun(iface,ispec) = .true.
@@ -414,7 +414,7 @@
! weighted jacobian and normal
call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob, &
+ xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy, &
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLY)
@@ -424,7 +424,7 @@
do j=1,NGLLY
do i=1,NGLLX
call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
normal_face(:,i,j) )
enddo
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_coupling_surfaces.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_coupling_surfaces.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_coupling_surfaces.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -26,7 +26,7 @@
subroutine get_coupling_surfaces(myrank, &
- nspec,nglob,ibool,NPROC, &
+ nspec,ibool,NPROC, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
my_neighbours_ext_mesh)
@@ -37,7 +37,7 @@
implicit none
! number of spectral elements in each block
- integer :: myrank,nspec,nglob,NPROC
+ integer :: myrank,nspec,NPROC
! arrays with the mesh
integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
@@ -56,21 +56,21 @@
! acoustic - elastic domain coupling
call get_coupling_surfaces_ac_el(myrank, &
- nspec,nglob,ibool,NPROC, &
+ nspec,ibool,NPROC, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
my_neighbours_ext_mesh)
! acoustic - poroelastic domain coupling
call get_coupling_surfaces_ac_poro(myrank, &
- nspec,nglob,ibool,NPROC, &
+ nspec,ibool,NPROC, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
my_neighbours_ext_mesh)
! elastic - poroelastic domain coupling
call get_coupling_surfaces_el_poro(myrank, &
- nspec,nglob,ibool,NPROC, &
+ nspec,ibool,NPROC, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
my_neighbours_ext_mesh)
@@ -82,7 +82,7 @@
!
subroutine get_coupling_surfaces_ac_el(myrank, &
- nspec,nglob,ibool,NPROC, &
+ nspec,ibool,NPROC, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
my_neighbours_ext_mesh)
@@ -93,7 +93,7 @@
implicit none
! number of spectral elements in each block
- integer :: myrank,nspec,nglob,NPROC
+ integer :: myrank,nspec,NPROC
! arrays with the mesh
integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
@@ -168,13 +168,13 @@
tmp_jacobian2Dw(:,:) = 0.0
! sets flags for acoustic / elastic on global points
- allocate(elastic_flag(nglob),stat=ier)
+ allocate(elastic_flag(nglob_dummy),stat=ier)
if( ier /= 0 ) stop 'error allocating array elastic_flag'
- allocate(acoustic_flag(nglob),stat=ier)
+ allocate(acoustic_flag(nglob_dummy),stat=ier)
if( ier /= 0 ) stop 'error allocating array acoustic_flag'
- allocate(test_flag(nglob),stat=ier)
+ allocate(test_flag(nglob_dummy),stat=ier)
if( ier /= 0 ) stop 'error allocating array test_flag'
- allocate(mask_ibool(nglob),stat=ier)
+ allocate(mask_ibool(nglob_dummy),stat=ier)
if( ier /= 0 ) stop 'error allocating array mask_ibool'
elastic_flag(:) = 0
acoustic_flag(:) = 0
@@ -220,18 +220,18 @@
ibool_interfaces_ext_mesh_dummy(:,i) = ibool_interfaces_ext_mesh(1:max_nibool_interfaces_ext_mesh,i)
enddo
! sums elastic flags
- call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,elastic_flag, &
+ call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob_dummy,elastic_flag, &
num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
my_neighbours_ext_mesh)
! sums acoustic flags
- call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,acoustic_flag, &
+ call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob_dummy,acoustic_flag, &
num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
my_neighbours_ext_mesh)
! sums test flags
- call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,test_flag, &
+ call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob_dummy,test_flag, &
num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
my_neighbours_ext_mesh)
@@ -291,7 +291,7 @@
! gets face GLL 2Djacobian, weighted from element face
call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob, &
+ xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy, &
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
ispec,iface_ref,jacobian2Dw_face,normal_face,NGLLX,NGLLY)
@@ -302,7 +302,7 @@
do i=1,NGLLX
! directs normals such that they point outwards of element
call get_element_face_normal(ispec,iface_ref,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
normal_face(:,i,j) )
! makes sure that it always points away from acoustic element,
@@ -382,7 +382,7 @@
!
subroutine get_coupling_surfaces_ac_poro(myrank, &
- nspec,nglob,ibool,NPROC, &
+ nspec,ibool,NPROC, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
my_neighbours_ext_mesh)
@@ -393,7 +393,7 @@
implicit none
! number of spectral elements in each block
- integer :: myrank,nspec,nglob,NPROC
+ integer :: myrank,nspec,NPROC
! arrays with the mesh
integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
@@ -467,11 +467,11 @@
tmp_jacobian2Dw(:,:) = 0.0
! sets flags for acoustic / poroelastic on global points
- allocate(poroelastic_flag(nglob),stat=ier)
+ allocate(poroelastic_flag(nglob_dummy),stat=ier)
if( ier /= 0 ) stop 'error allocating array poroelastic_flag'
- allocate(acoustic_flag(nglob),stat=ier)
+ allocate(acoustic_flag(nglob_dummy),stat=ier)
if( ier /= 0 ) stop 'error allocating array acoustic_flag'
- allocate(test_flag(nglob),stat=ier)
+ allocate(test_flag(nglob_dummy),stat=ier)
if( ier /= 0 ) stop 'error allocating array test_flag'
poroelastic_flag(:) = 0
acoustic_flag(:) = 0
@@ -517,18 +517,18 @@
ibool_interfaces_ext_mesh_dummy(:,i) = ibool_interfaces_ext_mesh(1:max_nibool_interfaces_ext_mesh,i)
enddo
! sums poroelastic flags
- call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,poroelastic_flag, &
+ call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob_dummy,poroelastic_flag, &
num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
my_neighbours_ext_mesh)
! sums acoustic flags
- call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,acoustic_flag, &
+ call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob_dummy,acoustic_flag, &
num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
my_neighbours_ext_mesh)
! sums test flags
- call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,test_flag, &
+ call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob_dummy,test_flag, &
num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
my_neighbours_ext_mesh)
@@ -568,7 +568,7 @@
! gets face GLL 2Djacobian, weighted from element face
call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob, &
+ xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy, &
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
ispec,iface_ref,jacobian2Dw_face,normal_face,NGLLX,NGLLY)
@@ -579,7 +579,7 @@
do i=1,NGLLX
! directs normals such that they point outwards of element
call get_element_face_normal(ispec,iface_ref,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
normal_face(:,i,j) )
! reverse the sign, we know we are in a poroelastic element
@@ -644,7 +644,7 @@
!
subroutine get_coupling_surfaces_el_poro(myrank, &
- nspec,nglob,ibool,NPROC, &
+ nspec,ibool,NPROC, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
my_neighbours_ext_mesh)
@@ -655,7 +655,7 @@
implicit none
! number of spectral elements in each block
- integer :: myrank,nspec,nglob,NPROC
+ integer :: myrank,nspec,NPROC
! arrays with the mesh
integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
@@ -735,11 +735,11 @@
tmp_jacobian2Dw(:,:) = 0.0
! sets flags for elastic / poroelastic on global points
- allocate(poroelastic_flag(nglob),stat=ier)
+ allocate(poroelastic_flag(nglob_dummy),stat=ier)
if( ier /= 0 ) stop 'error allocating array poroelastic_flag'
- allocate(elastic_flag(nglob),stat=ier)
+ allocate(elastic_flag(nglob_dummy),stat=ier)
if( ier /= 0 ) stop 'error allocating array elastic_flag'
- allocate(test_flag(nglob),stat=ier)
+ allocate(test_flag(nglob_dummy),stat=ier)
if( ier /= 0 ) stop 'error allocating array test_flag'
poroelastic_flag(:) = 0
elastic_flag(:) = 0
@@ -785,18 +785,18 @@
ibool_interfaces_ext_mesh_dummy(:,i) = ibool_interfaces_ext_mesh(1:max_nibool_interfaces_ext_mesh,i)
enddo
! sums poroelastic flags
- call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,poroelastic_flag, &
+ call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob_dummy,poroelastic_flag, &
num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
my_neighbours_ext_mesh)
! sums elastic flags
- call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,elastic_flag, &
+ call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob_dummy,elastic_flag, &
num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
my_neighbours_ext_mesh)
! sums test flags
- call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,test_flag, &
+ call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob_dummy,test_flag, &
num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
my_neighbours_ext_mesh)
@@ -860,7 +860,7 @@
! gets face GLL 2Djacobian, weighted from element face
call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob, &
+ xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy, &
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
ispec,iface_ref,jacobian2Dw_face,normal_face,NGLLX,NGLLY)
@@ -870,7 +870,7 @@
do i=1,NGLLX
! directs normals such that they point outwards of poroelastic element
call get_element_face_normal(ispec,iface_ref,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
+ ibool,nspec,nglob_dummy, &
xstore_dummy,ystore_dummy,zstore_dummy, &
normal_face(:,i,j) )
enddo
@@ -948,7 +948,7 @@
! not working properly yet...
! subroutine get_coupling_surfaces_comb(myrank, &
-! nspec,nglob,ibool,NPROC, &
+! nspec,ibool,NPROC, &
! nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
! num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
! my_neighbours_ext_mesh)
@@ -959,7 +959,7 @@
! implicit none
!
!! number of spectral elements in each block
-! integer :: myrank,nspec,nglob,NPROC
+! integer :: myrank,nspec,NPROC
!
!! arrays with the mesh
! integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
@@ -1040,17 +1040,17 @@
! tmp_jacobian2Dw(:,:) = 0.0
!
! ! sets flags for acoustic / elastic /poroelastic on global points
-! allocate(elastic_flag(nglob),stat=ier)
+! allocate(elastic_flag(nglob_dummy),stat=ier)
! if( ier /= 0 ) stop 'error allocating array elastic_flag'
-! allocate(acoustic_flag(nglob),stat=ier)
+! allocate(acoustic_flag(nglob_dummy),stat=ier)
! if( ier /= 0 ) stop 'error allocating array acoustic_flag'
-! allocate(poroelastic_flag(nglob),stat=ier)
+! allocate(poroelastic_flag(nglob_dummy),stat=ier)
! if( ier /= 0 ) stop 'error allocating array poroelastic_flag'
-! allocate(test_flag(nglob),stat=ier)
+! allocate(test_flag(nglob_dummy),stat=ier)
! if( ier /= 0 ) stop 'error allocating array test_flag'
-! allocate(mask_ibool_ac_el(nglob),stat=ier)
-! allocate(mask_ibool_ac_po(nglob),stat=ier)
-! allocate(mask_ibool_el_po(nglob),stat=ier)
+! allocate(mask_ibool_ac_el(nglob_dummy),stat=ier)
+! allocate(mask_ibool_ac_po(nglob_dummy),stat=ier)
+! allocate(mask_ibool_el_po(nglob_dummy),stat=ier)
! if( ier /= 0 ) stop 'error allocating array mask_ibool'
! elastic_flag(:) = 0
! acoustic_flag(:) = 0
@@ -1105,22 +1105,22 @@
! ibool_interfaces_ext_mesh_dummy(:,i) = ibool_interfaces_ext_mesh(1:max_nibool_interfaces_ext_mesh,i)
! enddo
! ! sums elastic flags
-! call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,elastic_flag, &
+! call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob_dummy,elastic_flag, &
! num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
! nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
! my_neighbours_ext_mesh)
! ! sums acoustic flags
-! call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,acoustic_flag, &
+! call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob_dummy,acoustic_flag, &
! num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
! nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
! my_neighbours_ext_mesh)
! ! sums poroelastic flags
-! call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,poroelastic_flag, &
+! call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob_dummy,poroelastic_flag, &
! num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
! nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
! my_neighbours_ext_mesh)
! ! sums test flags
-! call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,test_flag, &
+! call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob_dummy,test_flag, &
! num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
! nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
! my_neighbours_ext_mesh)
@@ -1183,7 +1183,7 @@
!
! ! gets face GLL 2Djacobian, weighted from element face
! call get_jacobian_boundary_face(myrank,nspec, &
-! xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob, &
+! xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy, &
! dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
! wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
! ispec,iface_ref,jacobian2Dw_face,normal_face,NGLLX,NGLLY)
@@ -1194,7 +1194,7 @@
! do i=1,NGLLX
! ! directs normals such that they point outwards of element
! call get_element_face_normal(ispec,iface_ref,xcoord,ycoord,zcoord, &
-! ibool,nspec,nglob, &
+! ibool,nspec,nglob_dummy, &
! xstore_dummy,ystore_dummy,zstore_dummy, &
! normal_face(:,i,j) )
! ! makes sure that it always points away from acoustic element,
@@ -1314,7 +1314,7 @@
!
! ! gets face GLL 2Djacobian, weighted from element face
! call get_jacobian_boundary_face(myrank,nspec, &
-! xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob, &
+! xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy, &
! dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
! wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
! ispec,iface_ref,jacobian2Dw_face,normal_face,NGLLX,NGLLY)
@@ -1325,7 +1325,7 @@
! do i=1,NGLLX
! ! directs normals such that they point outwards of element
! call get_element_face_normal(ispec,iface_ref,xcoord,ycoord,zcoord, &
-! ibool,nspec,nglob, &
+! ibool,nspec,nglob_dummy, &
! xstore_dummy,ystore_dummy,zstore_dummy, &
! normal_face(:,i,j) )
! ! makes sure that it always points away from acoustic element,
@@ -1433,7 +1433,7 @@
!
! ! gets face GLL 2Djacobian, weighted from element face
! call get_jacobian_boundary_face(myrank,nspec, &
-! xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob, &
+! xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob_dummy, &
! dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
! wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
! ispec,iface_ref,jacobian2Dw_face,normal_face,NGLLX,NGLLY)
@@ -1443,7 +1443,7 @@
! do i=1,NGLLX
! ! directs normals such that they point outwards of poroelastic element
! call get_element_face_normal(ispec,iface_ref,xcoord,ycoord,zcoord, &
-! ibool,nspec,nglob, &
+! ibool,nspec,nglob_dummy, &
! xstore_dummy,ystore_dummy,zstore_dummy, &
! normal_face(:,i,j) )
! enddo
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_model.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_model.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_model.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -29,6 +29,7 @@
undef_mat_prop,nundefMat_ext_mesh, &
ANISOTROPY,LOCAL_PATH)
+ use generate_databases_par,only: IMODEL
use create_regions_mesh_ext_par
implicit none
@@ -56,39 +57,36 @@
kxx,kxy,kxz,kyy,kyz,kzz,rho_bar
real(kind=CUSTOM_REAL) :: cpIsquare,cpIIsquare,cssquare,H_biot,M_biot,C_biot,D_biot, &
afactor,bfactor,cfactor
- integer :: ispec,i,j,k,iundef,ier
- integer :: iflag,flag_below,flag_above
- integer :: iflag_aniso,idomain_id,imaterial_id
+ integer :: ispec,i,j,k
+
+ ! material domain
+ integer :: idomain_id
+
+ integer :: imaterial_id,imaterial_def
+
! gll point location
- double precision :: xloc,yloc,zloc
+ double precision :: xmesh,ymesh,zmesh
integer :: iglob
- character(len=256) LOCAL_PATH,prname_lp
- real, dimension(:,:,:,:),allocatable :: vp_read,vs_read,rho_read
+ character(len=256) LOCAL_PATH
- ! variables for importing models from files in SPECFEM format, e.g., proc000000_vp.bin etc.
- ! can be used for importing updated model in iterative inversions
- logical,parameter :: USE_EXTERNAL_FILES = .false.
-
- ! use acoustic domains for simulation
- logical,parameter :: USE_PURE_ACOUSTIC_MOD = .false.
-
-
-
! initializes element domain flags
ispec_is_acoustic(:) = .false.
ispec_is_elastic(:) = .false.
ispec_is_poroelastic(:) = .false.
! prepares tomography model if needed for elements with undefined material definitions
- if( nundefMat_ext_mesh > 0 ) then
- call model_tomography_broadcast(myrank)
+ if( nundefMat_ext_mesh > 0 .or. IMODEL == IMODEL_TOMO ) then
+ call model_tomography_broadcast(myrank)
endif
! prepares external model values if needed
- if( USE_MODEL_EXTERNAL_VALUES ) then
+ select case( IMODEL )
+ case( IMODEL_USER_EXTERNAL )
call model_external_broadcast(myrank)
- endif
+ case( IMODEL_SALTON_TROUGH )
+ call model_salton_trough_broadcast(myrank)
+ end select
! ! Piero, read bedrock file
! in case, see file model_interface_bedrock.f90:
@@ -98,252 +96,200 @@
! material properties on all GLL points: taken from material values defined for
! each spectral element in input mesh
do ispec = 1, nspec
+
+ ! loops over all gll points in element
do k = 1, NGLLZ
do j = 1, NGLLY
do i = 1, NGLLX
- ! material index 1: associated material number
- imaterial_id = mat_ext_mesh(1,ispec)
+ ! initializes material
+ vp = 0._CUSTOM_REAL
+ vs = 0._CUSTOM_REAL
+ rho = 0._CUSTOM_REAL
+
+ rho_s = 0._CUSTOM_REAL
+ kappa_s = 0._CUSTOM_REAL
+ rho_f = 0._CUSTOM_REAL
+ kappa_f = 0._CUSTOM_REAL
+ eta_f = 0._CUSTOM_REAL
+ kappa_fr = 0._CUSTOM_REAL
+ mu_fr = 0._CUSTOM_REAL
+ phi = 0._CUSTOM_REAL
+ tort = 0._CUSTOM_REAL
+ kxx = 0._CUSTOM_REAL
+ kxy = 0._CUSTOM_REAL
+ kxz = 0._CUSTOM_REAL
+ kyy = 0._CUSTOM_REAL
+ kyz = 0._CUSTOM_REAL
+ kzz = 0._CUSTOM_REAL
+
+ qmu_atten = 0._CUSTOM_REAL
- ! check if the material is known or unknown
- if( imaterial_id > 0) then
- ! gets velocity model as specified by (cubit) mesh files for elastic & acoustic
- ! or from nummaterial_poroelastic_file for poroelastic (too many arguments for cubit)
+ c11 = 0._CUSTOM_REAL
+ c12 = 0._CUSTOM_REAL
+ c13 = 0._CUSTOM_REAL
+ c14 = 0._CUSTOM_REAL
+ c15 = 0._CUSTOM_REAL
+ c16 = 0._CUSTOM_REAL
+ c22 = 0._CUSTOM_REAL
+ c23 = 0._CUSTOM_REAL
+ c24 = 0._CUSTOM_REAL
+ c25 = 0._CUSTOM_REAL
+ c26 = 0._CUSTOM_REAL
+ c33 = 0._CUSTOM_REAL
+ c34 = 0._CUSTOM_REAL
+ c35 = 0._CUSTOM_REAL
+ c36 = 0._CUSTOM_REAL
+ c44 = 0._CUSTOM_REAL
+ c45 = 0._CUSTOM_REAL
+ c46 = 0._CUSTOM_REAL
+ c55 = 0._CUSTOM_REAL
+ c56 = 0._CUSTOM_REAL
+ c66 = 0._CUSTOM_REAL
- ! material domain_id
- idomain_id = materials_ext_mesh(6,imaterial_id)
+ ! gets xyz coordinates of GLL point
+ iglob = ibool(i,j,k,ispec)
+ xmesh = xstore_dummy(iglob)
+ ymesh= ystore_dummy(iglob)
+ zmesh = zstore_dummy(iglob)
- if(idomain_id == IDOMAIN_ACOUSTIC .or. idomain_id == IDOMAIN_ELASTIC) then ! elastic or acoustic
+ ! material index 1: associated material number
+ ! 1 = acoustic, 2 = elastic, 3 = poroelastic, -1 = undefined tomographic
+ imaterial_id = mat_ext_mesh(1,ispec)
- ! density
- ! materials_ext_mesh format:
- ! #index1 = rho #index2 = vp #index3 = vs #index4 = Q_flag #index5 = 0
- rho = materials_ext_mesh(1,imaterial_id)
+ ! material index 2: associated material definition
+ ! 1 = interface, 2 = tomography material
+ imaterial_def = mat_ext_mesh(2,ispec)
- ! isotropic values: vp, vs
- vp = materials_ext_mesh(2,imaterial_id)
- vs = materials_ext_mesh(3,imaterial_id)
+ ! assigns material properties
+ call get_model_values(materials_ext_mesh,nmat_ext_mesh, &
+ undef_mat_prop,nundefMat_ext_mesh, &
+ imaterial_id,imaterial_def, &
+ xmesh,ymesh,zmesh, &
+ rho,vp,vs,qmu_atten,idomain_id, &
+ rho_s,kappa_s,rho_f,kappa_f,eta_f,kappa_fr,mu_fr, &
+ phi,tort,kxx,kxy,kxz,kyy,kyz,kzz, &
+ c11,c12,c13,c14,c15,c16, &
+ c22,c23,c24,c25,c26,c33, &
+ c34,c35,c36,c44,c45,c46,c55,c56,c66, &
+ ANISOTROPY)
+
- ! attenuation
- qmu_atten = materials_ext_mesh(4,imaterial_id)
+ ! stores velocity model
- ! anisotropy
- iflag_aniso = materials_ext_mesh(5,imaterial_id)
+ if(idomain_id == IDOMAIN_ACOUSTIC .or. idomain_id == IDOMAIN_ELASTIC) then
+
+ ! elastic or acoustic material
- else ! poroelastic
- ! materials_ext_mesh format:
- ! rhos,rhof,phi,tort,eta,domain_id,kxx,kxy,kxz,kyy,kyz,kzz,kappas,kappaf,kappafr,mufr
+ ! density
+ rhostore(i,j,k,ispec) = rho
- ! solid properties
- rho_s = materials_ext_mesh(1,imaterial_id)
- kappa_s = materials_ext_mesh(13,imaterial_id)
- ! fluid properties
- rho_f = materials_ext_mesh(2,imaterial_id)
- kappa_f = materials_ext_mesh(14,imaterial_id)
- eta_f = materials_ext_mesh(5,imaterial_id)
- ! frame properties
- kappa_fr = materials_ext_mesh(15,imaterial_id)
- mu_fr = materials_ext_mesh(16,imaterial_id)
- phi = materials_ext_mesh(3,imaterial_id)
- tort = materials_ext_mesh(4,imaterial_id)
- kxx = materials_ext_mesh(7,imaterial_id)
- kxy = materials_ext_mesh(8,imaterial_id)
- kxz = materials_ext_mesh(9,imaterial_id)
- kyy = materials_ext_mesh(10,imaterial_id)
- kyz = materials_ext_mesh(11,imaterial_id)
- kzz = materials_ext_mesh(12,imaterial_id)
- endif !if(idomain_id == IDOMAIN_ACOUSTIC .or. idomain_id == IDOMAIN_ELASTIC)
+ ! kappa, mu
+ kappastore(i,j,k,ispec) = rho*( vp*vp - FOUR_THIRDS*vs*vs )
+ mustore(i,j,k,ispec) = rho*vs*vs
- else if (mat_ext_mesh(2,ispec) == 1) then
+ ! attenuation
+ qmu_attenuation_store(i,j,k,ispec) = qmu_atten
- stop 'material: interface not implemented yet'
+ ! Stacey, a completer par la suite
+ rho_vp(i,j,k,ispec) = rho*vp
+ rho_vs(i,j,k,ispec) = rho*vs
+ !
+ rho_vpI(i,j,k,ispec) = rho*vp
+ rho_vpII(i,j,k,ispec) = 0.d0
+ rho_vsI(i,j,k,ispec) = rho*vs
+ rhoarraystore(1,i,j,k,ispec) = rho
+ rhoarraystore(2,i,j,k,ispec) = rho
+ phistore(i,j,k,ispec) = 0.d0
+ tortstore(i,j,k,ispec) = 1.d0
+ !end pll
- do iundef = 1,nundefMat_ext_mesh
- if(trim(undef_mat_prop(2,iundef)) == 'interface') then
- read(undef_mat_prop(3,iundef),'(1i3)') flag_below
- read(undef_mat_prop(4,iundef),'(1i3)') flag_above
- endif
- enddo
+ else
+
+ ! poroelastic material
- ! see file model_interface_bedrock.f90: routine interface()
- !call interface(iflag,flag_below,flag_above,ispec,nspec,i,j,k,xstore,ystore,zstore,ibedrock)
+ ! solid properties
+ rhoarraystore(1,i,j,k,ispec) = rho_s
+ kappaarraystore(1,i,j,k,ispec) = kappa_s
+ ! fluid properties
+ rhoarraystore(2,i,j,k,ispec) = rho_f
+ kappaarraystore(2,i,j,k,ispec) = kappa_f
+ etastore(i,j,k,ispec) = eta_f
+ ! frame properties
+ kappaarraystore(3,i,j,k,ispec) = kappa_fr
+ mustore(i,j,k,ispec) = mu_fr
+ phistore(i,j,k,ispec) = phi
+ tortstore(i,j,k,ispec) = tort
+ permstore(1,i,j,k,ispec) = kxx
+ permstore(2,i,j,k,ispec) = kxy
+ permstore(3,i,j,k,ispec) = kxz
+ permstore(4,i,j,k,ispec) = kyy
+ permstore(5,i,j,k,ispec) = kyz
+ permstore(6,i,j,k,ispec) = kzz
- ! dummy: takes 1. defined material
- iflag = 1
- rho = materials_ext_mesh(1,iflag)
- vp = materials_ext_mesh(2,iflag)
- vs = materials_ext_mesh(3,iflag)
- qmu_atten = materials_ext_mesh(4,iflag)
- iflag_aniso = materials_ext_mesh(5,iflag)
- idomain_id = materials_ext_mesh(6,iflag)
+ !Biot coefficients for the input phi
+ D_biot = kappa_s*(1._CUSTOM_REAL + phi*(kappa_s/kappa_f - 1._CUSTOM_REAL))
+ H_biot = (kappa_s - kappa_fr)*(kappa_s - kappa_fr)/(D_biot - kappa_fr) &
+ + kappa_fr + 4._CUSTOM_REAL*mu_fr/3._CUSTOM_REAL
+ C_biot = kappa_s*(kappa_s - kappa_fr)/(D_biot - kappa_fr)
+ M_biot = kappa_s*kappa_s/(D_biot - kappa_fr)
+ ! Approximated velocities (no viscous dissipation)
+ rho_bar = (1._CUSTOM_REAL - phi)*rho_s + phi*rho_f
+ afactor = rho_bar - phi/tort*rho_f
+ bfactor = H_biot + phi*rho_bar/(tort*rho_f)*M_biot - TWO*phi/tort*C_biot
+ cfactor = phi/(tort*rho_f)*(H_biot*M_biot - C_biot*C_biot)
+ cpIsquare = (bfactor + sqrt(bfactor*bfactor - 4._CUSTOM_REAL*afactor*cfactor))/(2._CUSTOM_REAL*afactor)
+ cpIIsquare = (bfactor - sqrt(bfactor*bfactor - 4._CUSTOM_REAL*afactor*cfactor))/(2._CUSTOM_REAL*afactor)
+ cssquare = mu_fr/afactor
- else if ( mat_ext_mesh(2,ispec) == 2 ) then
+ ! AC based on cpI,cpII & cs
+ rho_vpI(i,j,k,ispec) = (rho_bar - phi/tort*rho_f)*sqrt(cpIsquare)
+ rho_vpII(i,j,k,ispec) = (rho_bar - phi/tort*rho_f)*sqrt(cpIIsquare)
+ rho_vsI(i,j,k,ispec) = (rho_bar - phi/tort*rho_f)*sqrt(cssquare)
- ! material definition undefined, uses definition from tomography model
- ! GLL point location
- iglob = ibool(i,j,k,ispec)
- xloc = xstore_dummy(iglob)
- yloc = ystore_dummy(iglob)
- zloc = zstore_dummy(iglob)
+ endif !if(idomain_id == IDOMAIN_ACOUSTIC .or. idomain_id == IDOMAIN_ELASTIC)
- ! gets model values from tomography file
- call model_tomography(xloc,yloc,zloc, &
- rho,vp,vs)
+ ! stores anisotropic parameters
+ if( ANISOTROPY ) then
+ c11store(i,j,k,ispec) = c11
+ c12store(i,j,k,ispec) = c12
+ c13store(i,j,k,ispec) = c13
+ c14store(i,j,k,ispec) = c14
+ c15store(i,j,k,ispec) = c15
+ c16store(i,j,k,ispec) = c16
+ c22store(i,j,k,ispec) = c22
+ c23store(i,j,k,ispec) = c23
+ c24store(i,j,k,ispec) = c24
+ c25store(i,j,k,ispec) = c25
+ c26store(i,j,k,ispec) = c26
+ c33store(i,j,k,ispec) = c33
+ c34store(i,j,k,ispec) = c34
+ c35store(i,j,k,ispec) = c35
+ c36store(i,j,k,ispec) = c36
+ c44store(i,j,k,ispec) = c44
+ c45store(i,j,k,ispec) = c45
+ c46store(i,j,k,ispec) = c46
+ c55store(i,j,k,ispec) = c55
+ c56store(i,j,k,ispec) = c56
+ c66store(i,j,k,ispec) = c66
+ endif
- qmu_atten = ATTENUATION_COMP_MAXIMUM ! attenuation: arbitrary value, see maximum in constants.h
- iflag_aniso = 0 ! no anisotropy
- ! sets acoustic/elastic domain as given in materials properties
- iundef = - imaterial_id ! iundef must be positive
- read(undef_mat_prop(6,iundef),*) idomain_id
- ! or
- !idomain_id = IDOMAIN_ELASTIC ! forces to be elastic domain
+ ! stores material domain
+ select case( idomain_id )
+ case( IDOMAIN_ACOUSTIC )
+ ispec_is_acoustic(ispec) = .true.
+ case( IDOMAIN_ELASTIC )
+ ispec_is_elastic(ispec) = .true.
+ case( IDOMAIN_POROELASTIC )
+ ispec_is_poroelastic(ispec) = .true.
+ case default
+ stop 'error material domain index'
+ end select
- else
-
- stop 'material: not implemented yet'
-
- end if
-
- ! adds/gets velocity model as specified in model_external_values.f90
- if( USE_MODEL_EXTERNAL_VALUES ) then
- call model_external_values(i,j,k,ispec,idomain_id,imaterial_id, &
- nspec,ibool, &
- iflag_aniso,qmu_atten, &
- rho,vp,vs, &
- c11,c12,c13,c14,c15,c16, &
- c22,c23,c24,c25,c26,c33, &
- c34,c35,c36,c44,c45,c46, &
- c55,c56,c66,ANISOTROPY)
- endif
-
- ! adds anisotropic default model
- if( ANISOTROPY .and. .not. USE_MODEL_EXTERNAL_VALUES ) then
- call model_aniso(iflag_aniso,rho,vp,vs,c11,c12,c13,c14,c15,c16, &
- c22,c23,c24,c25,c26,c33,c34,c35,c36,c44,c45, &
- c46,c55,c56,c66)
-
- endif
-
- ! stores velocity model
-
- if(idomain_id == IDOMAIN_ACOUSTIC .or. idomain_id == IDOMAIN_ELASTIC) then ! elastic or acoustic
-
- ! density
- rhostore(i,j,k,ispec) = rho
-
- ! kappa, mu
- kappastore(i,j,k,ispec) = rho*( vp*vp - FOUR_THIRDS*vs*vs )
- mustore(i,j,k,ispec) = rho*vs*vs
-
- ! attenuation
- qmu_attenuation_store(i,j,k,ispec) = qmu_atten
-
- ! Stacey, a completer par la suite
- rho_vp(i,j,k,ispec) = rho*vp
- rho_vs(i,j,k,ispec) = rho*vs
- !
- rho_vpI(i,j,k,ispec) = rho*vp
- rho_vpII(i,j,k,ispec) = 0.d0
- rho_vsI(i,j,k,ispec) = rho*vs
- rhoarraystore(1,i,j,k,ispec) = rho
- rhoarraystore(2,i,j,k,ispec) = rho
- phistore(i,j,k,ispec) = 0.d0
- tortstore(i,j,k,ispec) = 1.d0
- !end pll
-
- else ! poroelastic
-
- ! solid properties
- rhoarraystore(1,i,j,k,ispec) = rho_s
- kappaarraystore(1,i,j,k,ispec) = kappa_s
- ! fluid properties
- rhoarraystore(2,i,j,k,ispec) = rho_f
- kappaarraystore(2,i,j,k,ispec) = kappa_f
- etastore(i,j,k,ispec) = eta_f
- ! frame properties
- kappaarraystore(3,i,j,k,ispec) = kappa_fr
- mustore(i,j,k,ispec) = mu_fr
- phistore(i,j,k,ispec) = phi
- tortstore(i,j,k,ispec) = tort
- permstore(1,i,j,k,ispec) = kxx
- permstore(2,i,j,k,ispec) = kxy
- permstore(3,i,j,k,ispec) = kxz
- permstore(4,i,j,k,ispec) = kyy
- permstore(5,i,j,k,ispec) = kyz
- permstore(6,i,j,k,ispec) = kzz
-
- !Biot coefficients for the input phi
- D_biot = kappa_s*(1._CUSTOM_REAL + phi*(kappa_s/kappa_f - 1._CUSTOM_REAL))
- H_biot = (kappa_s - kappa_fr)*(kappa_s - kappa_fr)/(D_biot - kappa_fr) + kappa_fr + 4._CUSTOM_REAL*mu_fr/3._CUSTOM_REAL
- C_biot = kappa_s*(kappa_s - kappa_fr)/(D_biot - kappa_fr)
- M_biot = kappa_s*kappa_s/(D_biot - kappa_fr)
- ! Approximated velocities (no viscous dissipation)
- rho_bar = (1._CUSTOM_REAL - phi)*rho_s + phi*rho_f
- afactor = rho_bar - phi/tort*rho_f
- bfactor = H_biot + phi*rho_bar/(tort*rho_f)*M_biot - TWO*phi/tort*C_biot
- cfactor = phi/(tort*rho_f)*(H_biot*M_biot - C_biot*C_biot)
- cpIsquare = (bfactor + sqrt(bfactor*bfactor - 4._CUSTOM_REAL*afactor*cfactor))/(2._CUSTOM_REAL*afactor)
- cpIIsquare = (bfactor - sqrt(bfactor*bfactor - 4._CUSTOM_REAL*afactor*cfactor))/(2._CUSTOM_REAL*afactor)
- cssquare = mu_fr/afactor
-
- ! AC based on cpI,cpII & cs
- rho_vpI(i,j,k,ispec) = (rho_bar - phi/tort*rho_f)*sqrt(cpIsquare)
- rho_vpII(i,j,k,ispec) = (rho_bar - phi/tort*rho_f)*sqrt(cpIIsquare)
- rho_vsI(i,j,k,ispec) = (rho_bar - phi/tort*rho_f)*sqrt(cssquare)
-
- endif !if(idomain_id == IDOMAIN_ACOUSTIC .or. idomain_id == IDOMAIN_ELASTIC)
-
- ! adds anisotropic perturbation to vp, vs
- if( ANISOTROPY ) then
- !call model_aniso(iflag_aniso,rho,vp,vs,c11,c12,c13,c14,c15,c16, &
- ! c22,c23,c24,c25,c26,c33,c34,c35,c36,c44,c45,c46,c55,c56,c66)
- c11store(i,j,k,ispec) = c11
- c12store(i,j,k,ispec) = c12
- c13store(i,j,k,ispec) = c13
- c14store(i,j,k,ispec) = c14
- c15store(i,j,k,ispec) = c15
- c16store(i,j,k,ispec) = c16
- c22store(i,j,k,ispec) = c22
- c23store(i,j,k,ispec) = c23
- c24store(i,j,k,ispec) = c24
- c25store(i,j,k,ispec) = c25
- c26store(i,j,k,ispec) = c26
- c33store(i,j,k,ispec) = c33
- c34store(i,j,k,ispec) = c34
- c35store(i,j,k,ispec) = c35
- c36store(i,j,k,ispec) = c36
- c44store(i,j,k,ispec) = c44
- c45store(i,j,k,ispec) = c45
- c46store(i,j,k,ispec) = c46
- c55store(i,j,k,ispec) = c55
- c56store(i,j,k,ispec) = c56
- c66store(i,j,k,ispec) = c66
- endif
-
- ! for pure acoustic simulations (a way of avoiding re-mesh, re-partition etc.)
- ! can be used to compare elastic & acoustic reflections in exploration seismology
- ! do NOT use it unless you are confident
- if( USE_PURE_ACOUSTIC_MOD ) then
- idomain_id = IDOMAIN_ACOUSTIC
- endif
-
- ! material domain
- !print*,'velocity model:',ispec,idomain_id
- if( idomain_id == IDOMAIN_ACOUSTIC ) then
- ispec_is_acoustic(ispec) = .true.
- else if( idomain_id == IDOMAIN_ELASTIC ) then
- ispec_is_elastic(ispec) = .true.
- else if( idomain_id == IDOMAIN_POROELASTIC ) then
- ispec_is_poroelastic(ispec) = .true.
- else
- stop 'error material domain index'
- endif
-
enddo
enddo
enddo
- !print*,myrank,'ispec:',ispec,'rho:',rhostore(1,1,1,ispec),'vp:',vpstore(1,1,1,ispec),'vs:',vsstore(1,1,1,ispec)
enddo
! checks material domains
@@ -372,81 +318,126 @@
endif
enddo
-! !! DK DK store the position of the six stations to be able to
-! !! DK DK exclude circles around each station to make sure they are on the bedrock
-! !! DK DK and not in the ice
-! in case, see file model_interface_bedrock.f90: routine model_bedrock_store()
+ ! GLL model
+ ! variables for importing models from files in SPECFEM format, e.g., proc000000_vp.bin etc.
+ ! can be used for importing updated model in iterative inversions
+ if( IMODEL == IMODEL_GLL ) then
+ ! note:
+ ! import the model from files in SPECFEM format
+ ! note that those those files should be saved in LOCAL_PATH
+ call model_gll(myrank,nspec,LOCAL_PATH)
+ endif
+ end subroutine get_model
-! import the model from files in SPECFEM format
-! note that those those files should be saved in LOCAL_PATH
+!
+!-------------------------------------------------------------------------------------------------
+!
- if( USE_EXTERNAL_FILES ) then
+ subroutine get_model_values(materials_ext_mesh,nmat_ext_mesh, &
+ undef_mat_prop,nundefMat_ext_mesh, &
+ imaterial_id,imaterial_def, &
+ xmesh,ymesh,zmesh, &
+ rho,vp,vs,qmu_atten,idomain_id, &
+ rho_s,kappa_s,rho_f,kappa_f,eta_f,kappa_fr,mu_fr, &
+ phi,tort,kxx,kxy,kxz,kyy,kyz,kzz, &
+ c11,c12,c13,c14,c15,c16, &
+ c22,c23,c24,c25,c26,c33, &
+ c34,c35,c36,c44,c45,c46,c55,c56,c66, &
+ ANISOTROPY)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!! if only vp structure is available (as is often the case in exploration seismology),
-!!! use lines for vp only
+ use generate_databases_par,only: IMODEL
+ use create_regions_mesh_ext_par
+ implicit none
- ! processors name
- write(prname_lp,'(a,i6.6,a)') trim(LOCAL_PATH)//'proc',myrank,'_'
+ integer, intent(in) :: nmat_ext_mesh
+ double precision, dimension(16,nmat_ext_mesh),intent(in) :: materials_ext_mesh
- allocate( rho_read(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
- if( ier /= 0 ) stop 'error allocating array rho_read'
- write(prname_lp,'(a,i6.6,a)') trim(LOCAL_PATH)//'proc',myrank,'_'
- open(unit=28,file=prname_lp(1:len_trim(prname_lp))//'rho.bin',&
- status='unknown',action='read',form='unformatted')
- read(28) rho_read
- close(28)
+ integer, intent(in) :: nundefMat_ext_mesh
+ character (len=30), dimension(6,nundefMat_ext_mesh):: undef_mat_prop
- allocate( vp_read(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
- if( ier /= 0 ) stop 'error allocating array vp_read'
- write(prname_lp,'(a,i6.6,a)') trim(LOCAL_PATH)//'proc',myrank,'_'
- open(unit=28,file=prname_lp(1:len_trim(prname_lp))//'vp.bin',&
- status='unknown',action='read',form='unformatted')
- read(28) vp_read
- close(28)
+ integer, intent(in) :: imaterial_id,imaterial_def
- allocate( vs_read(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
- if( ier /= 0 ) stop 'error allocating array vs_read'
- write(prname_lp,'(a,i6.6,a)') trim(LOCAL_PATH)//'proc',myrank,'_'
- open(unit=28,file=prname_lp(1:len_trim(prname_lp))//'vs.bin',&
- status='unknown',action='read',form='unformatted')
- read(28) vs_read
- close(28)
+ double precision, intent(in) :: xmesh,ymesh,zmesh
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!! in cases where density structure is not given
-!!! modify according to your desire
+ real(kind=CUSTOM_REAL) :: vp,vs,rho,qmu_atten
-! rho_read = 1000.0
-! where ( mustore > 100.0 ) &
-! rho_read = (1.6612 * (vp_read / 1000.0) &
-! -0.4720 * (vp_read / 1000.0)**2 &
-! +0.0671 * (vp_read / 1000.0)**3 &
-! -0.0043 * (vp_read / 1000.0)**4 &
-! +0.000106*(vp_read / 1000.0)**5 )*1000.0
+ integer :: idomain_id
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!! in cases where shear wavespeed structure is not given
-!!! modify according to your desire
+ real(kind=CUSTOM_REAL) :: kappa_s,kappa_f,kappa_fr,mu_fr,rho_s,rho_f,phi,tort,eta_f, &
+ kxx,kxy,kxz,kyy,kyz,kzz
-! vs_read = 0.0
-! where ( mustore > 100.0 ) vs_read = vp_read / sqrt(3.0)
+ real(kind=CUSTOM_REAL) :: c11,c12,c13,c14,c15,c16,c22,c23,c24,c25, &
+ c26,c33,c34,c35,c36,c44,c45,c46,c55,c56,c66
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!! update arrays that will be saved and used in the solver xspecfem3D
-!!! the following part is neccessary if you uncommented something above
+ logical :: ANISOTROPY
- rhostore = rho_read
- kappastore = rhostore * ( vp_read * vp_read - FOUR_THIRDS * vs_read * vs_read )
- mustore = rhostore * vs_read * vs_read
- rho_vp = rhostore * vp_read
- rho_vs = rhostore * vs_read
+ ! local parameters
+ integer :: iflag_aniso
+
+ ! use acoustic domains for simulation
+ logical,parameter :: USE_PURE_ACOUSTIC_MOD = .false.
- ! free memory
- deallocate( rho_read,vp_read,vs_read)
+ ! initializes with default values
+ iflag_aniso = 0
+ idomain_id = IDOMAIN_ELASTIC
+
+ ! selects chosen velocity model
+ select case( IMODEL )
- endif ! USE_EXTERNAL_FILES
+ case( IMODEL_DEFAULT, IMODEL_GLL )
+ ! material values determined by mesh properties
+ call model_default(materials_ext_mesh,nmat_ext_mesh, &
+ undef_mat_prop,nundefMat_ext_mesh, &
+ imaterial_id,imaterial_def, &
+ xmesh,ymesh,zmesh, &
+ rho,vp,vs, &
+ iflag_aniso,qmu_atten,idomain_id, &
+ rho_s,kappa_s,rho_f,kappa_f,eta_f,kappa_fr,mu_fr, &
+ phi,tort,kxx,kxy,kxz,kyy,kyz,kzz)
+
+ case( IMODEL_1D_PREM )
+ ! 1D model profile from PREM
+ call model_1D_prem_iso(xmesh,ymesh,zmesh,rho,vp,vs,qmu_atten)
+
+ case( IMODEL_1D_CASCADIA )
+ ! 1D model profile for Cascadia region
+ call model_1D_cascadia(xmesh,ymesh,zmesh,rho,vp,vs,qmu_atten)
- end subroutine get_model
+ case( IMODEL_1D_SOCAL )
+ ! 1D model profile for Southern California
+ call model_1D_socal(xmesh,ymesh,zmesh,rho,vp,vs,qmu_atten)
+ case( IMODEL_SALTON_TROUGH )
+ ! gets model values from tomography file
+ call model_salton_trough(xmesh,ymesh,zmesh,rho,vp,vs,qmu_atten)
+
+ case( IMODEL_TOMO )
+ ! gets model values from tomography file
+ call model_tomography(xmesh,ymesh,zmesh,rho,vp,vs,qmu_atten)
+
+ case( IMODEL_USER_EXTERNAL )
+ ! user model from external routine
+ ! adds/gets velocity model as specified in model_external_values.f90
+ call model_external_values(xmesh,ymesh,zmesh,rho,vp,vs,qmu_atten,iflag_aniso,idomain_id)
+
+ case default
+ stop 'error: model not implemented yet'
+ end select
+
+ ! adds anisotropic default model
+ if( ANISOTROPY ) then
+ call model_aniso(iflag_aniso,rho,vp,vs, &
+ c11,c12,c13,c14,c15,c16, &
+ c22,c23,c24,c25,c26,c33, &
+ c34,c35,c36,c44,c45,c46,c55,c56,c66)
+ endif
+
+ ! for pure acoustic simulations (a way of avoiding re-mesh, re-partition etc.)
+ ! can be used to compare elastic & acoustic reflections in exploration seismology
+ ! do NOT use it unless you are confident
+ if( USE_PURE_ACOUSTIC_MOD ) then
+ idomain_id = IDOMAIN_ACOUSTIC
+ endif
+
+ end subroutine get_model_values
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/memory_eval.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/memory_eval.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/memory_eval.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -161,16 +161,17 @@
include "constants.h"
- integer :: myrank,nspec,npointot,nnodes_ext_mesh,nelmnts_ext_mesh, &
+ integer,intent(in) :: myrank,nspec,npointot,nnodes_ext_mesh,nelmnts_ext_mesh, &
nmat_ext_mesh,num_interfaces_ext_mesh, &
max_interface_size_ext_mesh,nspec2D_xmin,nspec2D_xmax, &
nspec2D_ymin,nspec2D_ymax,nspec2D_bottom,nspec2D_top
- integer :: static_memory_size_request
+ integer,intent(inout) :: static_memory_size_request
+ ! local parameters
integer :: static_memory_size
-! memory usage, in generate_database() routine so far
+ ! memory usage, in generate_database() routine so far
static_memory_size = NGLLX*NGLLY*NGLLZ*nspec*4 + 3*NGLLX*NGLLY*NGLLZ*nspec*8 &
+ NDIM*nnodes_ext_mesh*8 + ESIZE*nelmnts_ext_mesh*4 + 2*nelmnts_ext_mesh*4 &
+ 5*nmat_ext_mesh*8 + 3*num_interfaces_ext_mesh &
@@ -179,7 +180,7 @@
+ nspec2D_xmin*20 + nspec2D_xmax*20 + nspec2D_ymin*20 &
+ nspec2D_ymax*20 + nspec2D_bottom*20 + nspec2D_top*20
-! memory usage, in create_regions_mesh_ext() routine requested approximately
+ ! memory usage, in create_regions_mesh_ext() routine requested approximately
static_memory_size_request = &
+ 3*NGNOD*8 + NGLLX*NGLLY*NGLLZ*nspec*4 + 6*nspec*1 + 6*NGLLX*8 &
+ NGNOD*NGLLX*NGLLY*NGLLZ*8 + NDIM*NGNOD*NGLLX*NGLLY*NGLLZ*8 &
Added: seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_1d_cascadia.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_1d_cascadia.f90 (rev 0)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_1d_cascadia.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -0,0 +1,110 @@
+!=====================================================================
+!
+! S p e c f e m 3 D V e r s i o n 2 . 0
+! ---------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA and University of Pau / CNRS / INRIA
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+!--------------------------------------------------------------------------------------------------
+!
+! 1D model profile for Cascadia region
+!
+! by Gian Matharu
+!--------------------------------------------------------------------------------------------------
+
+ subroutine model_1D_cascadia(xmesh,ymesh,zmesh,rho,vp,vs,qmu_atten)
+
+! given a GLL point, returns super-imposed velocity model values
+
+ use generate_databases_par,only: nspec => NSPEC_AB,ibool
+ use create_regions_mesh_ext_par
+ implicit none
+
+ ! GLL point location
+ double precision, intent(in) :: xmesh,ymesh,zmesh
+
+ ! density, Vp and Vs
+ real(kind=CUSTOM_REAL),intent(inout) :: vp,vs,rho,qmu_atten
+
+ ! local parameters
+ real(kind=CUSTOM_REAL) :: x,y,z
+ real(kind=CUSTOM_REAL) :: depth
+ real(kind=CUSTOM_REAL) :: elevation,distmin
+
+ ! converts GLL point location to real
+ x = xmesh
+ y = ymesh
+ z = zmesh
+
+ ! get approximate topography elevation at target coordinates
+ distmin = HUGEVAL
+ elevation = 0.0
+ call get_topo_elevation_free_closest(x,y,elevation,distmin, &
+ nspec,nglob_dummy,ibool,xstore_dummy,ystore_dummy,zstore_dummy, &
+ num_free_surface_faces,free_surface_ispec,free_surface_ijk)
+
+ ! depth in Z-direction
+ if( distmin < HUGEVAL ) then
+ depth = elevation - z
+ else
+ depth = - z
+ endif
+
+ ! depth in km
+ depth = depth / 1000.0
+
+ ! 1D profile Cascadia
+
+ ! super-imposes values
+ if( depth < 1.0 ) then
+ ! vp in m/s
+ vp = 5000.0
+ ! vs in m/s
+ vs = 2890.0
+ ! density in kg/m**3
+ rho = 2800.0
+ elseif( depth < 6.0 ) then
+ vp = 6000.0
+ vs = 3460.0
+ rho = 2800.0
+ elseif( depth < 30.0 ) then
+ vp = 6700.0
+ vs = 3870.0
+ rho = 3200.0
+ elseif( depth < 45.0 ) then
+ vp = 7100.0
+ vs = 4100.0
+ rho = 3200.0
+ elseif( depth < 65.0 ) then
+ vp = 7750.0
+ vs = 4470.0
+ rho = 3200.0
+ else
+ vp = 8100.0
+ vs = 4670.0
+ rho = 3200.0
+ endif
+
+ ! attenuation: PREM crust value
+ qmu_atten=600.0d0
+
+ end subroutine model_1D_cascadia
Added: seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_1d_prem.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_1d_prem.f90 (rev 0)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_1d_prem.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -0,0 +1,275 @@
+!=====================================================================
+!
+! S p e c f e m 3 D V e r s i o n 2 . 0
+! ---------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA and University of Pau / CNRS / INRIA
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+!--------------------------------------------------------------------------------------------------
+!
+! PREM [Dziewonski and Anderson, 1981].
+!
+! A. M. Dziewonski and D. L. Anderson.
+! Preliminary reference Earth model.
+! Phys. Earth Planet. Inter., 25:297–356, 1981.
+!
+! Isotropic (iso) and transversely isotropic (aniso) version of the
+! spherically symmetric Preliminary Reference Earth Model
+!
+!--------------------------------------------------------------------------------------------------
+
+
+ subroutine model_1D_prem_iso(xmesh,ymesh,zmesh,rho_prem,vp_prem,vs_prem,qmu_atten)
+
+!
+! isotropic prem model
+!
+
+! given a GLL point, returns super-imposed velocity model values
+
+ use generate_databases_par,only: nspec => NSPEC_AB,ibool
+ use create_regions_mesh_ext_par
+ implicit none
+
+ ! GLL point location
+ double precision, intent(in) :: xmesh,ymesh,zmesh
+
+ ! material properties
+ real(kind=CUSTOM_REAL), intent(inout) :: rho_prem,vp_prem,vs_prem,qmu_atten
+
+ ! local parameters
+ real(kind=CUSTOM_REAL) :: xloc,yloc,zloc
+ real(kind=CUSTOM_REAL) :: depth
+ real(kind=CUSTOM_REAL) :: elevation,distmin
+ double precision :: x,rho,drhodr,vp,vs,Qkappa,Qmu
+ double precision :: &
+ R_EARTH,RICB,RCMB,RTOPDDOUBLEPRIME, &
+ R771,R600,R670,R400,R220,R80,RMOHO,RMIDDLE_CRUST,ROCEAN
+ double precision :: r
+
+ ! uses crustal values from other models (like crust2.0) than prem
+ ! set to .false. to use PREM crustal values, otherwise will take mantle values up to surface
+ logical,parameter :: CRUSTAL = .false.
+ ! avoids crustal values, uses Moho values up to the surface
+ logical,parameter :: SUPPRESS_CRUSTAL_MESH = .false.
+ ! same properties everywhere in PREM crust if we decide to define only one layer in the crust
+ logical,parameter :: ONE_CRUST = .false.
+
+ ! GLL point location converted to real
+ xloc = xmesh
+ yloc = ymesh
+ zloc = zmesh
+
+ ! get approximate topography elevation at target coordinates
+ distmin = HUGEVAL
+ elevation = 0.0
+ call get_topo_elevation_free_closest(xloc,yloc,elevation,distmin, &
+ nspec,nglob_dummy,ibool,xstore_dummy,ystore_dummy,zstore_dummy, &
+ num_free_surface_faces,free_surface_ispec,free_surface_ijk)
+
+ ! depth in Z-direction
+ if( distmin < HUGEVAL ) then
+ depth = elevation - zloc
+ else
+ depth = - zloc
+ endif
+
+ ! PREM layers (in m)
+ R_EARTH = 6371000.d0
+ ROCEAN = 6368000.d0
+ RMIDDLE_CRUST = 6356000.d0
+ RMOHO = 6346600.d0
+ R80 = 6291000.d0
+ R220 = 6151000.d0
+ R400 = 5971000.d0
+ R600 = 5771000.d0
+ R670 = 5701000.d0
+ R771 = 5600000.d0
+ RTOPDDOUBLEPRIME = 3630000.d0
+ RCMB = 3480000.d0
+ RICB = 1221000.d0
+
+ ! compute real physical radius in meters
+ r = R_EARTH - dble(depth)
+
+ ! normalized radius
+ x = r / R_EARTH
+
+ ! given a normalized radius x, gives the non-dimensionalized density rho,
+ ! speeds vp and vs, and the quality factors Qkappa and Qmu
+
+ !
+ !--- inner core
+ !
+ if(r >= 0.d0 .and. r <= RICB) then
+ drhodr=-2.0d0*8.8381d0*x
+ rho=13.0885d0-8.8381d0*x*x
+ vp=11.2622d0-6.3640d0*x*x
+ vs=3.6678d0-4.4475d0*x*x
+ Qmu=84.6d0
+ Qkappa=1327.7d0
+ !
+ !--- outer core
+ !
+ else if(r > RICB .and. r <= RCMB) then
+ drhodr=-1.2638d0-2.0d0*3.6426d0*x-3.0d0*5.5281d0*x*x
+ rho=12.5815d0-1.2638d0*x-3.6426d0*x*x-5.5281d0*x*x*x
+ vp=11.0487d0-4.0362d0*x+4.8023d0*x*x-13.5732d0*x*x*x
+ vs=0.0d0
+ Qmu=0.0d0
+ Qkappa=57827.0d0
+ !
+ !--- D" at the base of the mantle
+ !
+ else if(r > RCMB .and. r <= RTOPDDOUBLEPRIME) then
+ drhodr=-6.4761d0+2.0d0*5.5283d0*x-3.0d0*3.0807d0*x*x
+ rho=7.9565d0-6.4761d0*x+5.5283d0*x*x-3.0807d0*x*x*x
+ vp=15.3891d0-5.3181d0*x+5.5242d0*x*x-2.5514d0*x*x*x
+ vs=6.9254d0+1.4672d0*x-2.0834d0*x*x+0.9783d0*x*x*x
+ Qmu=312.0d0
+ Qkappa=57827.0d0
+ !
+ !--- mantle: from top of D" to d670
+ !
+ else if(r > RTOPDDOUBLEPRIME .and. r <= R771) then
+ drhodr=-6.4761d0+2.0d0*5.5283d0*x-3.0d0*3.0807d0*x*x
+ rho=7.9565d0-6.4761d0*x+5.5283d0*x*x-3.0807d0*x*x*x
+ vp=24.9520d0-40.4673d0*x+51.4832d0*x*x-26.6419d0*x*x*x
+ vs=11.1671d0-13.7818d0*x+17.4575d0*x*x-9.2777d0*x*x*x
+ Qmu=312.0d0
+ Qkappa=57827.0d0
+ else if(r > R771 .and. r <= R670) then
+ drhodr=-6.4761d0+2.0d0*5.5283d0*x-3.0d0*3.0807d0*x*x
+ rho=7.9565d0-6.4761d0*x+5.5283d0*x*x-3.0807d0*x*x*x
+ vp=29.2766d0-23.6027d0*x+5.5242d0*x*x-2.5514d0*x*x*x
+ vs=22.3459d0-17.2473d0*x-2.0834d0*x*x+0.9783d0*x*x*x
+ Qmu=312.0d0
+ Qkappa=57827.0d0
+ !
+ !--- mantle: above d670
+ !
+ else if(r > R670 .and. r <= R600) then
+ drhodr=-1.4836d0
+ rho=5.3197d0-1.4836d0*x
+ vp=19.0957d0-9.8672d0*x
+ vs=9.9839d0-4.9324d0*x
+ Qmu=143.0d0
+ Qkappa=57827.0d0
+ else if(r > R600 .and. r <= R400) then
+ drhodr=-8.0298d0
+ rho=11.2494d0-8.0298d0*x
+ vp=39.7027d0-32.6166d0*x
+ vs=22.3512d0-18.5856d0*x
+ Qmu=143.0d0
+ Qkappa=57827.0d0
+ else if(r > R400 .and. r <= R220) then
+ drhodr=-3.8045d0
+ rho=7.1089d0-3.8045d0*x
+ vp=20.3926d0-12.2569d0*x
+ vs=8.9496d0-4.4597d0*x
+ Qmu=143.0d0
+ Qkappa=57827.0d0
+ else if(r > R220 .and. r <= R80) then
+ drhodr=0.6924d0
+ rho=2.6910d0+0.6924d0*x
+ vp=4.1875d0+3.9382d0*x
+ vs=2.1519d0+2.3481d0*x
+ Qmu=80.0d0
+ Qkappa=57827.0d0
+ else
+ if(CRUSTAL .and. .not. SUPPRESS_CRUSTAL_MESH) then
+! fill with PREM mantle and later add CRUST2.0
+ if(r > R80) then
+ ! density/velocity from mantle just below moho
+ drhodr=0.6924d0
+ rho=2.6910d0+0.6924d0*x
+ vp=4.1875d0+3.9382d0*x
+ vs=2.1519d0+2.3481d0*x
+ ! shear attenuation for R80 to surface
+ Qmu=600.0d0
+ Qkappa=57827.0d0
+ endif
+ else
+! use PREM crust
+ if(r > R80 .and. r <= RMOHO) then
+ drhodr=0.6924d0
+ rho=2.6910d0+0.6924d0*x
+ vp=4.1875d0+3.9382d0*x
+ vs=2.1519d0+2.3481d0*x
+ Qmu=600.0d0
+ Qkappa=57827.0d0
+
+ else if (SUPPRESS_CRUSTAL_MESH) then
+ !! DK DK extend the Moho up to the surface instead of the crust
+ drhodr=0.6924d0
+ rho = 2.6910d0+0.6924d0*(RMOHO / R_EARTH)
+ vp = 4.1875d0+3.9382d0*(RMOHO / R_EARTH)
+ vs = 2.1519d0+2.3481d0*(RMOHO / R_EARTH)
+ Qmu=600.0d0
+ Qkappa=57827.0d0
+
+ else if(r > RMOHO .and. r <= RMIDDLE_CRUST) then
+ drhodr=0.0d0
+ rho=2.9d0
+ vp=6.8d0
+ vs=3.9d0
+ Qmu=600.0d0
+ Qkappa=57827.0d0
+
+ ! same properties everywhere in PREM crust if we decide to define only one layer in the crust
+ if(ONE_CRUST) then
+ drhodr=0.0d0
+ rho=2.6d0
+ vp=5.8d0
+ vs=3.2d0
+ Qmu=600.0d0
+ Qkappa=57827.0d0
+ endif
+
+ else if(r > RMIDDLE_CRUST .and. r <= ROCEAN) then
+ drhodr=0.0d0
+ rho=2.6d0
+ vp=5.8d0
+ vs=3.2d0
+ Qmu=600.0d0
+ Qkappa=57827.0d0
+ ! for density profile for gravity, we do not check that r <= R_EARTH
+ else if(r > ROCEAN) then
+ drhodr=0.0d0
+ rho=2.6d0
+ vp=5.8d0
+ vs=3.2d0
+ Qmu=600.0d0
+ Qkappa=57827.0d0
+
+ endif
+ endif
+ endif
+
+ ! scales values to SI units ( m/s, kg/m**3)
+ rho_prem=rho*1000.0d0
+ vp_prem=vp*1000.0d0
+ vs_prem=vs*1000.0d0
+
+ qmu_atten = Qmu
+
+ end subroutine model_1D_prem_iso
Added: seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_1d_socal.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_1d_socal.f90 (rev 0)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_1d_socal.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -0,0 +1,92 @@
+!=====================================================================
+!
+! S p e c f e m 3 D V e r s i o n 2 . 0
+! ---------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA and University of Pau / CNRS / INRIA
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+!--------------------------------------------------------------------------------------------------
+!
+! 1D Southern California model
+!
+! model is the standard model used in southern California:
+! Kanamori and Hadley (1975), Dreger and Helmberger (1990), Wald-Hutton,Given (1995)
+!
+!--------------------------------------------------------------------------------------------------
+
+ subroutine model_1D_socal(xmesh,ymesh,zmesh,rho,vp,vs,qmu_atten)
+
+! given a GLL point, returns super-imposed velocity model values
+
+ use generate_databases_par,only: nspec => NSPEC_AB,ibool
+ use create_regions_mesh_ext_par
+ implicit none
+
+ ! GLL point location
+ double precision, intent(in) :: xmesh,ymesh,zmesh
+
+ ! density, Vp and Vs
+ real(kind=CUSTOM_REAL),intent(inout) :: vp,vs,rho,qmu_atten
+
+ ! local parameters
+ real(kind=CUSTOM_REAL) :: depth,x,y,z
+
+ ! mesh point location
+ x = xmesh
+ y = ymesh
+ z = zmesh
+
+ ! depth in m
+ depth = -zmesh
+
+ ! assigns model parameters
+ if( depth >= 32000.0 ) then
+ ! moho
+ vp=7.8d0
+ vs=4.5d0
+ rho=3.0d0
+ else if( depth > 16000.0 ) then
+ ! moho - 16km
+ vp=6.7d0
+ vs=3.87d0
+ rho=2.8d0
+ else if( depth > 5500.0 ) then
+ ! basement
+ vp=6.3d0
+ vs=3.64d0
+ rho=2.67d0
+ else
+ ! up to topo surface
+ vp=5.5d0
+ vs=3.18d0
+ rho=2.4d0
+ endif
+
+ ! scale to standard units
+ vp = vp * 1000.d0
+ vs = vs * 1000.d0
+ rho = rho * 1000.d0
+
+ ! no attenuation information
+ qmu_atten = 0.d0
+
+ end subroutine model_1D_socal
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_aniso.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_aniso.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_aniso.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -24,15 +24,22 @@
!
!=====================================================================
-!=====================================================================
+!--------------------------------------------------------------------------------------------------
+!
+! generic anisotropic model
+!
! 07/09/04 Last changed by Min Chen
! Users need to modify this subroutine to implement their own
! anisotropic models.
-!=====================================================================
+!
+!--------------------------------------------------------------------------------------------------
- subroutine model_aniso(iflag_aniso,rho,vp,vs,c11,c12,c13,c14,c15,c16, &
- c22,c23,c24,c25,c26,c33,c34,c35,c36,c44,c45,c46,c55,c56,c66)
+ subroutine model_aniso(iflag_aniso,rho,vp,vs, &
+ c11,c12,c13,c14,c15,c16, &
+ c22,c23,c24,c25,c26,c33, &
+ c34,c35,c36,c44,c45,c46,c55,c56,c66)
+
implicit none
include "constants.h"
Added: seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_default.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_default.f90 (rev 0)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_default.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -0,0 +1,171 @@
+!=====================================================================
+!
+! S p e c f e m 3 D V e r s i o n 2 . 0
+! ---------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA and University of Pau / CNRS / INRIA
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+!--------------------------------------------------------------------------------------------------
+!
+! model given by (CUBIT) mesh parameters
+!
+!--------------------------------------------------------------------------------------------------
+
+ subroutine model_default(materials_ext_mesh,nmat_ext_mesh, &
+ undef_mat_prop,nundefMat_ext_mesh, &
+ imaterial_id,imaterial_def, &
+ xmesh,ymesh,zmesh, &
+ rho,vp,vs,iflag_aniso,qmu_atten,idomain_id, &
+ rho_s,kappa_s,rho_f,kappa_f,eta_f,kappa_fr,mu_fr, &
+ phi,tort,kxx,kxy,kxz,kyy,kyz,kzz)
+
+! takes model values specified by mesh properties
+
+ use create_regions_mesh_ext_par
+ implicit none
+
+ integer, intent(in) :: nmat_ext_mesh
+ double precision, dimension(16,nmat_ext_mesh),intent(in) :: materials_ext_mesh
+
+ integer, intent(in) :: nundefMat_ext_mesh
+ character (len=30), dimension(6,nundefMat_ext_mesh):: undef_mat_prop
+
+ integer, intent(in) :: imaterial_id,imaterial_def
+
+ double precision, intent(in) :: xmesh,ymesh,zmesh
+
+ real(kind=CUSTOM_REAL) :: vp,vs,rho,qmu_atten
+
+ integer :: iflag_aniso
+ integer :: idomain_id
+
+ real(kind=CUSTOM_REAL) :: kappa_s,kappa_f,kappa_fr,mu_fr,rho_s,rho_f,phi,tort,eta_f, &
+ kxx,kxy,kxz,kyy,kyz,kzz
+
+ ! local parameters
+ integer :: iflag,flag_below,flag_above
+ integer :: iundef
+
+ ! check if the material is known or unknown
+ if( imaterial_id > 0 ) then
+ ! gets velocity model as specified by (cubit) mesh files for elastic & acoustic
+ ! or from nummaterial_poroelastic_file for poroelastic (too many arguments for cubit)
+
+ ! material domain_id
+ idomain_id = materials_ext_mesh(6,imaterial_id)
+
+ select case( idomain_id )
+
+ case( IDOMAIN_ACOUSTIC,IDOMAIN_ELASTIC)
+ ! elastic or acoustic
+
+ ! density
+ ! materials_ext_mesh format:
+ ! #index1 = rho #index2 = vp #index3 = vs #index4 = Q_flag #index5 = 0
+ rho = materials_ext_mesh(1,imaterial_id)
+
+ ! isotropic values: vp, vs
+ vp = materials_ext_mesh(2,imaterial_id)
+ vs = materials_ext_mesh(3,imaterial_id)
+
+ ! attenuation
+ qmu_atten = materials_ext_mesh(4,imaterial_id)
+
+ ! anisotropy
+ iflag_aniso = materials_ext_mesh(5,imaterial_id)
+
+ case( IDOMAIN_POROELASTIC )
+ ! poroelastic
+ ! materials_ext_mesh format:
+ ! rho_s,kappa_s,rho_f,kappa_f,eta_f,kappa_fr,mu_fr,phi,tort,kxx,kxy,kxz,kyy,kyz,kzz
+
+ ! solid properties
+ rho_s = materials_ext_mesh(1,imaterial_id)
+ kappa_s = materials_ext_mesh(13,imaterial_id)
+ ! fluid properties
+ rho_f = materials_ext_mesh(2,imaterial_id)
+ kappa_f = materials_ext_mesh(14,imaterial_id)
+ eta_f = materials_ext_mesh(5,imaterial_id)
+ ! frame properties
+ kappa_fr = materials_ext_mesh(15,imaterial_id)
+ mu_fr = materials_ext_mesh(16,imaterial_id)
+ phi = materials_ext_mesh(3,imaterial_id)
+ tort = materials_ext_mesh(4,imaterial_id)
+ kxx = materials_ext_mesh(7,imaterial_id)
+ kxy = materials_ext_mesh(8,imaterial_id)
+ kxz = materials_ext_mesh(9,imaterial_id)
+ kyy = materials_ext_mesh(10,imaterial_id)
+ kyz = materials_ext_mesh(11,imaterial_id)
+ kzz = materials_ext_mesh(12,imaterial_id)
+
+ case default
+ print*,'error: domain id = ',idomain_id,'not recognized'
+ stop 'error: domain not recognized'
+
+ end select
+
+ else if ( imaterial_def == 1 ) then
+
+ stop 'material: interface not implemented yet'
+
+ do iundef = 1,nundefMat_ext_mesh
+ if(trim(undef_mat_prop(2,iundef)) == 'interface') then
+ read(undef_mat_prop(3,iundef),'(1i3)') flag_below
+ read(undef_mat_prop(4,iundef),'(1i3)') flag_above
+ endif
+ enddo
+
+ ! see file model_interface_bedrock.f90: routine interface()
+ !call interface(iflag,flag_below,flag_above,ispec,nspec,i,j,k,xstore,ystore,zstore,ibedrock)
+
+ ! dummy: takes 1. defined material
+ iflag = 1
+ rho = materials_ext_mesh(1,iflag)
+ vp = materials_ext_mesh(2,iflag)
+ vs = materials_ext_mesh(3,iflag)
+ qmu_atten = materials_ext_mesh(4,iflag)
+ iflag_aniso = materials_ext_mesh(5,iflag)
+ idomain_id = materials_ext_mesh(6,iflag)
+
+ else if ( imaterial_def == 2 ) then
+
+ ! material definition undefined, uses definition from tomography model
+
+ ! gets model values from tomography file
+ call model_tomography(xmesh,ymesh,zmesh,rho,vp,vs,qmu_atten)
+
+ ! no anisotropy
+ iflag_aniso = 0
+
+ ! sets acoustic/elastic domain as given in materials properties
+ iundef = - imaterial_id ! iundef must be positive
+ read(undef_mat_prop(6,iundef),*) idomain_id
+ ! or
+ !idomain_id = IDOMAIN_ELASTIC ! forces to be elastic domain
+
+ else
+
+ stop 'material: not implemented yet'
+
+ end if
+
+ end subroutine model_default
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_external_values.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_external_values.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_external_values.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -24,6 +24,8 @@
!
!=====================================================================
+!--------------------------------------------------------------------------------------------------
+!
! generic model file
!
! note: the idea is to super-impose velocity model values on the GLL points,
@@ -31,7 +33,9 @@
!
! most of the routines here are place-holders, please add/implement your own routines
!
+!--------------------------------------------------------------------------------------------------
+
module external_model
!---
@@ -111,54 +115,35 @@
!
- subroutine model_external_values(i,j,k,ispec,idomain_id,imaterial_id,&
- nspec,ibool, &
- iflag_aniso,qmu_atten, &
- rho,vp,vs, &
- c11,c12,c13,c14,c15,c16, &
- c22,c23,c24,c25,c26,c33, &
- c34,c35,c36,c44,c45,c46, &
- c55,c56,c66,ANISOTROPY)
+ subroutine model_external_values(xmesh,ymesh,zmesh,rho,vp,vs,qmu_atten,iflag_aniso,idomain_id )
! given a GLL point, returns super-imposed velocity model values
+ use generate_databases_par,only: nspec => NSPEC_AB,ibool
use external_model
use create_regions_mesh_ext_par
-
implicit none
- ! GLL point indices
- integer :: i,j,k,ispec
+ ! GLL point
+ double precision, intent(in) :: xmesh,ymesh,zmesh
- ! acoustic/elastic/.. domain flag ( 1 = acoustic / 2 = elastic / ... )
- integer :: idomain_id
+ ! density, Vp and Vs
+ real(kind=CUSTOM_REAL) :: vp,vs,rho
- ! associated material flag (in cubit, this would be the volume id number)
- integer :: imaterial_id
+ ! attenuation flag
+ real(kind=CUSTOM_REAL) :: qmu_atten
- ! local-to-global index array
- integer :: nspec
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
-
! anisotropy flag
integer :: iflag_aniso
- ! attenuation flag
- real(kind=CUSTOM_REAL) :: qmu_atten
+ ! acoustic/elastic/.. domain flag ( 1 = acoustic / 2 = elastic / ... )
+ integer :: idomain_id
- ! density, Vp and Vs
- real(kind=CUSTOM_REAL) :: vp,vs,rho
-
- ! all anisotropy coefficients
- real(kind=CUSTOM_REAL) :: c11,c12,c13,c14,c15,c16,c22,c23,c24,c25, &
- c26,c33,c34,c35,c36,c44,c45,c46,c55,c56,c66
- logical :: ANISOTROPY
-
! local parameters
real(kind=CUSTOM_REAL) :: x,y,z
real(kind=CUSTOM_REAL) :: xmin,xmax,ymin,ymax,zmin,zmax
real(kind=CUSTOM_REAL) :: depth
- integer :: iglob,idummy
+ real(kind=CUSTOM_REAL) :: elevation,distmin
!---
!
@@ -166,11 +151,10 @@
!
!---
- ! GLL point location
- iglob = ibool(i,j,k,ispec)
- x = xstore_dummy(iglob)
- y = ystore_dummy(iglob)
- z = zstore_dummy(iglob)
+ ! GLL point location converted to real
+ x = xmesh
+ y = ymesh
+ z = zmesh
! model dimensions
xmin = 0. ! minval(xstore_dummy)
@@ -178,15 +162,23 @@
ymin = 0. !minval(ystore_dummy)
ymax = 134000. ! maxval(ystore_dummy)
zmin = 0. ! minval(zstore_dummy)
- zmax = -60000. ! maxval(zstore_dummy)
+ zmax = 60000. ! maxval(zstore_dummy)
+ ! get approximate topography elevation at target coordinates from free surface
+ call get_topo_elevation_free_closest(x,y,elevation,distmin, &
+ nspec,nglob_dummy,ibool,xstore_dummy,ystore_dummy,zstore_dummy, &
+ num_free_surface_faces,free_surface_ispec,free_surface_ijk)
+
! depth in Z-direction
- depth = zmax - z
-
+ if( distmin < HUGEVAL ) then
+ depth = elevation - z
+ else
+ depth = zmax - z
+ endif
+
! normalizes depth between 0 and 1
if( abs( zmax - zmin ) > TINYVAL ) depth = depth / (zmax - zmin)
-
! super-imposes values
!rho = 2.6910d0+0.6924d0*depth
!vp = 4.1875d0+3.9382d0*depth
@@ -201,17 +193,13 @@
vp = vp + 4562.d0 * depth
vs = vs + 2720.d0 * depth
- ! adds anisotropic velocity values
- if( ANISOTROPY ) &
- call model_aniso(iflag_aniso,rho,vp,vs,c11,c12,c13,c14,c15,c16, &
- c22,c23,c24,c25,c26,c33,c34,c35,c36,c44,c45, &
- c46,c55,c56,c66)
+ ! attenuation: PREM crust value
+ qmu_atten=600.0d0
- ! to avoid compiler warnings
- idummy = imaterial_id
- idummy = idomain_id
- idummy = qmu_atten
+ ! no anisotropy
+ iflag_aniso = 0
+ ! elastic material
+ idomain_id = IDOMAIN_ELASTIC
+
end subroutine model_external_values
-
-
Added: seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_gll.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_gll.f90 (rev 0)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_gll.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -0,0 +1,120 @@
+!=====================================================================
+!
+! S p e c f e m 3 D V e r s i o n 2 . 0
+! ---------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA and University of Pau / CNRS / INRIA
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+
+!--------------------------------------------------------------------------------------------------
+!
+! GLL
+!
+! based on modified GLL mesh output from mesher
+!
+! used for iterative inversion procedures
+!
+!--------------------------------------------------------------------------------------------------
+
+ subroutine model_gll(myrank,nspec,LOCAL_PATH)
+
+ use create_regions_mesh_ext_par
+ implicit none
+
+ integer, intent(in) :: myrank,nspec
+ character(len=256) :: LOCAL_PATH
+
+ ! local parameters
+ real, dimension(:,:,:,:),allocatable :: vp_read,vs_read,rho_read
+ integer :: ier
+ character(len=256) :: prname_lp,filename
+
+ ! processors name
+ write(prname_lp,'(a,i6.6,a)') trim(LOCAL_PATH)//'proc',myrank,'_'
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !!! if only vp structure is available (as is often the case in exploration seismology),
+ !!! use lines for vp only
+
+ ! density
+ allocate( rho_read(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
+ if( ier /= 0 ) stop 'error allocating array rho_read'
+
+ filename = prname_lp(1:len_trim(prname_lp))//'rho.bin'
+ open(unit=28,file=trim(filename),status='unknown',action='read',form='unformatted')
+
+ read(28) rho_read
+ close(28)
+
+ ! vp
+ allocate( vp_read(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
+ if( ier /= 0 ) stop 'error allocating array vp_read'
+
+ filename = prname_lp(1:len_trim(prname_lp))//'vp.bin'
+ open(unit=28,file=trim(filename),status='unknown',action='read',form='unformatted')
+
+ read(28) vp_read
+ close(28)
+
+ ! vs
+ allocate( vs_read(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
+ if( ier /= 0 ) stop 'error allocating array vs_read'
+
+ filename = prname_lp(1:len_trim(prname_lp))//'vs.bin'
+ open(unit=28,file=trim(filename),status='unknown',action='read',form='unformatted')
+
+ read(28) vs_read
+ close(28)
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !!! in cases where density structure is not given
+ !!! modify according to your desire
+
+ ! rho_read = 1000.0
+ ! where ( mustore > 100.0 ) &
+ ! rho_read = (1.6612 * (vp_read / 1000.0) &
+ ! -0.4720 * (vp_read / 1000.0)**2 &
+ ! +0.0671 * (vp_read / 1000.0)**3 &
+ ! -0.0043 * (vp_read / 1000.0)**4 &
+ ! +0.000106*(vp_read / 1000.0)**5 )*1000.0
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !!! in cases where shear wavespeed structure is not given
+ !!! modify according to your desire
+
+ ! vs_read = 0.0
+ ! where ( mustore > 100.0 ) vs_read = vp_read / sqrt(3.0)
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !!! update arrays that will be saved and used in the solver xspecfem3D
+ !!! the following part is neccessary if you uncommented something above
+
+ rhostore = rho_read
+ kappastore = rhostore * ( vp_read * vp_read - FOUR_THIRDS * vs_read * vs_read )
+ mustore = rhostore * vs_read * vs_read
+ rho_vp = rhostore * vp_read
+ rho_vs = rhostore * vs_read
+
+ ! free memory
+ deallocate( rho_read,vp_read,vs_read)
+
+ end subroutine model_gll
Added: seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_salton_trough.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_salton_trough.f90 (rev 0)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_salton_trough.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -0,0 +1,287 @@
+!=====================================================================
+!
+! S p e c f e m 3 D V e r s i o n 2 . 0
+! ---------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA and University of Pau / CNRS / INRIA
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+!--------------------------------------------------------------------------------------------------
+!
+! Salton Trough model
+!
+!--------------------------------------------------------------------------------------------------
+
+
+ module salton_trough_par
+
+ ! Salton Sea Gocad voxet
+ integer, parameter :: GOCAD_ST_NU = 638, GOCAD_ST_NV = 219, GOCAD_ST_NW = 76
+ double precision, parameter :: &
+ GOCAD_ST_O_X = 720844.0, &
+ GOCAD_ST_O_Y = 3401799.250, &
+ GOCAD_ST_O_Z = -6354.334
+ double precision, parameter :: GOCAD_ST_U_X = -209197.89, GOCAD_ST_U_Y = 320741.71
+ double precision, parameter :: GOCAD_ST_V_X = 109670.74, GOCAD_ST_V_Y = 71530.72
+ double precision, parameter :: GOCAD_ST_W_Z = 7666.334
+ double precision, parameter :: GOCAD_ST_NO_DATA_VALUE = -99999
+
+ real,dimension(:,:,:),allocatable :: vp_array
+
+ end module salton_trough_par
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine model_salton_trough_broadcast(myrank)
+
+ use salton_trough_par
+ implicit none
+
+ include "constants.h"
+
+ integer :: myrank
+
+ ! local parameters
+ integer :: ier
+
+
+ allocate(vp_array(GOCAD_ST_NU,GOCAD_ST_NV,GOCAD_ST_NW),stat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error allocating vp_array for salton')
+
+ ! the variables read are declared and stored in structure
+ if(myrank == 0) call read_salton_sea_model()
+
+ ! broadcast the information read on the master to the nodes
+ call bcast_all_r(vp_array, size(vp_array))
+
+ end subroutine model_salton_trough_broadcast
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+
+ subroutine read_salton_sea_model()
+
+ use salton_trough_par
+ implicit none
+
+ ! local parameter
+ integer :: ios, reclen
+ character(len=256) SALTON_SEA_MODEL_FILE
+
+ ! array length
+ reclen=(GOCAD_ST_NU * GOCAD_ST_NV * GOCAD_ST_NW) * 4
+
+ ! file name
+ call get_value_string(SALTON_SEA_MODEL_FILE,'model.SALTON_SEA_MODEL_FILE', &
+ 'DATA/st_3D_block_harvard/regrid3_vel_p.bin')
+
+ ! reads in file values
+ open(11,file=trim(SALTON_SEA_MODEL_FILE), &
+ status='old',action='read',form='unformatted',access='direct',recl=reclen,iostat=ios)
+ if (ios /= 0) then
+ print *,'error opening file: ',trim(SALTON_SEA_MODEL_FILE),' iostat = ', ios
+ call exit_mpi(0,'Error opening file salton trough')
+ endif
+
+ read(11,rec=1,iostat=ios) vp_array
+ if (ios /= 0) stop 'Error reading vp_array'
+
+ close(11)
+
+ end subroutine read_salton_sea_model
+
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+
+ subroutine model_salton_trough(xmesh,ymesh,zmesh,rho,vp,vs,qmu_atten)
+
+! given a GLL point, returns super-imposed velocity model values
+
+ use salton_trough_par
+ use create_regions_mesh_ext_par
+ implicit none
+
+ ! GLL point
+ double precision, intent(in) :: xmesh,ymesh,zmesh
+
+ ! density, Vp and Vs
+ real(kind=CUSTOM_REAL) :: vp,vs,rho
+
+ ! attenuation flag
+ real(kind=CUSTOM_REAL) :: qmu_atten
+
+ ! local parameters
+ double precision :: uc,vc,wc
+ double precision :: vp_st,vs_st,rho_st
+
+ ! GLL point location converted to u,v,w
+ call vx_xyz2uvw(xmesh,ymesh,zmesh,uc,vc,wc)
+
+ ! model values
+ call vx_xyz_interp(uc,vc,wc,vp_st,vs_st,rho_st)
+
+ ! converts to custom real
+ vp = vp_st
+ vs = vs_st
+ rho = rho_st
+
+ ! no attenuation info
+ qmu_atten = 0.0
+
+ end subroutine model_salton_trough
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine vx_xyz2uvw(xmesh, ymesh, zmesh, uc, vc, wc)
+
+ use salton_trough_par
+ implicit none
+
+ double precision :: xmesh, ymesh, zmesh
+ double precision :: uc, vc, wc
+
+ uc = (GOCAD_ST_NU-1) * ( (xmesh - GOCAD_ST_O_X) * GOCAD_ST_V_Y &
+ - (ymesh - GOCAD_ST_O_Y) * GOCAD_ST_V_X) &
+ / (GOCAD_ST_U_X * GOCAD_ST_V_Y - GOCAD_ST_U_Y * GOCAD_ST_V_X)
+ vc = (GOCAD_ST_NV-1) * ((ymesh - GOCAD_ST_O_Y) - uc * GOCAD_ST_U_Y/(GOCAD_ST_NU-1) ) / GOCAD_ST_V_Y
+ wc = (GOCAD_ST_NW-1) * (zmesh - GOCAD_ST_O_Z) / GOCAD_ST_W_Z
+
+ end subroutine vx_xyz2uvw
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine vx_xyz_interp(uc,vc,wc, vp, vs, rho)
+
+ use salton_trough_par
+ implicit none
+
+ double precision, intent(in) :: uc,vc,wc
+ double precision, intent(inout) :: vp, vs, rho
+
+ ! local parameter
+ integer :: i,j,k,ixi,ieta,iga
+ real :: v1, v2, v3, v4, v5, v6, v7, v8, xi, eta, ga, vi
+ double precision :: zmesh
+ real,parameter :: eps = 1.0e-3
+
+
+ i = uc + 1
+ j = vc + 1
+ k = wc + 1
+
+ xi = uc + 1 - i
+ eta = vc + 1- j
+ ga = wc + 1 -k
+
+ ixi = nint(xi)
+ ieta = nint(eta)
+ iga = nint(ga)
+
+ ! print *, 'gc = ', i, j, k
+ ! print *, 'xi, eta, ga = ', xi, eta, ga
+ ! print *, 'ixi, ieta, iga = ', ixi, ieta, iga
+
+ if (i > 0 .or. i < GOCAD_ST_NU .or. j > 0 .or. j < GOCAD_ST_NV .or. k > 0 .or. k < GOCAD_ST_NW) then
+ v1 = vp_array(i,j,k)
+ v2 = vp_array(i+1,j,k)
+ v3 = vp_array(i+1,j+1,k)
+ v4 = vp_array(i,j+1,k)
+ v5 = vp_array(i,j,k+1)
+ v6 = vp_array(i+1,j,k+1)
+ v7 = vp_array(i+1,j+1,k+1)
+ v8 = vp_array(i,j+1,k+1)
+ vi = vp_array(i+ixi,j+ieta,k+iga)
+ ! print *, v1, v2, v3, v4, v5, v6, v7, v8
+
+ if ((v1 - GOCAD_ST_NO_DATA_VALUE) > eps .and. &
+ (v2 - GOCAD_ST_NO_DATA_VALUE) > eps .and. &
+ (v3 - GOCAD_ST_NO_DATA_VALUE) > eps .and. &
+ (v4 - GOCAD_ST_NO_DATA_VALUE) > eps .and. &
+ (v5 - GOCAD_ST_NO_DATA_VALUE) > eps .and. &
+ (v6 - GOCAD_ST_NO_DATA_VALUE) > eps .and. &
+ (v7 - GOCAD_ST_NO_DATA_VALUE) > eps .and. &
+ (v8 - GOCAD_ST_NO_DATA_VALUE) > eps ) then
+ vp = dble(v1 * (1-xi) * (1-eta) * (1-ga) +&
+ v2 * xi * (1-eta) * (1-ga) +&
+ v3 * xi * eta * (1-ga) +&
+ v4 * (1-xi) * eta * (1-ga) +&
+ v5 * (1-xi) * (1-eta) * ga +&
+ v6 * xi * (1-eta) * ga +&
+ v7 * xi * eta * ga +&
+ v8 * (1-xi) * eta * ga)
+ else if ((vi - GOCAD_ST_NO_DATA_VALUE) > eps) then
+ vp = dble(vi)
+
+ ! else if ((v1 - GOCAD_ST_NO_DATA_VALUE) > eps) then
+ ! vp = dble(v1)
+ ! else if ((v2 - GOCAD_ST_NO_DATA_VALUE) > eps) then
+ ! vp = dble(v2)
+ ! else if ((v3 - GOCAD_ST_NO_DATA_VALUE) > eps) then
+ ! vp = dble(v3)
+ ! else if ((v4 - GOCAD_ST_NO_DATA_VALUE) > eps) then
+ ! vp = dble(v4)
+ ! else if ((v5 - GOCAD_ST_NO_DATA_VALUE) > eps) then
+ ! vp = dble(v5)
+ ! else if ((v6 - GOCAD_ST_NO_DATA_VALUE) > eps) then
+ ! vp = dble(v6)
+ ! else if ((v7 - GOCAD_ST_NO_DATA_VALUE) > eps) then
+ ! vp = dble(v7)
+ ! else if ((v7 - GOCAD_ST_NO_DATA_VALUE) > eps) then
+ ! vp = dble(v8)
+
+ else
+ vp = GOCAD_ST_NO_DATA_VALUE
+ endif
+
+ ! depth
+ zmesh = wc / (GOCAD_ST_NW - 1) * GOCAD_ST_W_Z + GOCAD_ST_O_Z
+
+ ! vs
+ if (zmesh > -8500.) then
+ vs = vp / (2 - (0.27*zmesh/(-8500)))
+ else
+ vs = vp/1.73
+ endif
+
+ ! density
+ if (vp > 2160.) then
+ rho = vp/3 + 1280.
+ else
+ rho = 2000.
+ endif
+ else
+ rho = GOCAD_ST_NO_DATA_VALUE
+ vp = GOCAD_ST_NO_DATA_VALUE
+ vs = GOCAD_ST_NO_DATA_VALUE
+ endif
+
+ end subroutine vx_xyz_interp
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_tomography.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_tomography.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_tomography.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -24,12 +24,15 @@
!
!=====================================================================
+!--------------------------------------------------------------------------------------------------
+!
! generic tomography file
!
! note: the idea is to use an external, tomography velocity model
!
! most of the routines here are place-holders, please add/implement your own routines
!
+!--------------------------------------------------------------------------------------------------
module tomography
@@ -38,7 +41,7 @@
! for external tomography:
! file must be in ../in_data/files/ directory
! (regular spaced, xyz-block file in ascii)
- !character (len=80) :: TOMO_FILENAME = 'veryfast_tomography_abruzzo_complete.xyz'
+
character (len=80) :: TOMO_FILENAME = 'tomography_model.xyz'
! model dimensions
@@ -164,8 +167,7 @@
!
- subroutine model_tomography(x_eval,y_eval,z_eval, &
- rho_final,vp_final,vs_final)
+ subroutine model_tomography(xmesh,ymesh,zmesh,rho_final,vp_final,vs_final,qmu_atten)
use tomography
@@ -176,8 +178,9 @@
!double precision, intent(in) :: ORIG_X,ORIG_Y,ORIG_Z,SPACING_X,SPACING_Y,SPACING_Z
!double precision, intent(in) :: VP_MIN,VS_MIN,RHO_MIN,VP_MAX,VS_MAX,RHO_MAX
- double precision, intent(in) :: x_eval,y_eval,z_eval
- real(kind=CUSTOM_REAL), intent(out) :: vp_final,vs_final,rho_final
+ double precision, intent(in) :: xmesh,ymesh,zmesh
+
+ real(kind=CUSTOM_REAL), intent(out) :: vp_final,vs_final,rho_final,qmu_atten
! local parameters
integer :: ix,iy,iz
@@ -191,9 +194,9 @@
vs1,vs2,vs3,vs4,vs5,vs6,vs7,vs8,rho1,rho2,rho3,rho4,rho5,rho6,rho7,rho8
! determine spacing and cell for linear interpolation
- spac_x = (x_eval - ORIG_X) / SPACING_X
- spac_y = (y_eval - ORIG_Y) / SPACING_Y
- spac_z = (z_eval - ORIG_Z) / SPACING_Z
+ spac_x = (xmesh - ORIG_X) / SPACING_X
+ spac_y = (ymesh - ORIG_Y) / SPACING_Y
+ spac_z = (zmesh - ORIG_Z) / SPACING_Z
ix = int(spac_x)
iy = int(spac_y)
@@ -244,7 +247,7 @@
if(z_tomography(p4+1) == z_tomography(p0+1)) then
gamma_interp_z1 = 1.d0
else
- gamma_interp_z1 = (z_eval-z_tomography(p0+1))/(z_tomography(p4+1)-z_tomography(p0+1))
+ gamma_interp_z1 = (zmesh-z_tomography(p0+1))/(z_tomography(p4+1)-z_tomography(p0+1))
endif
if(gamma_interp_z1 > 1.d0) then
gamma_interp_z1 = 1.d0
@@ -257,7 +260,7 @@
if(z_tomography(p5+1) == z_tomography(p1+1)) then
gamma_interp_z2 = 1.d0
else
- gamma_interp_z2 = (z_eval-z_tomography(p1+1))/(z_tomography(p5+1)-z_tomography(p1+1))
+ gamma_interp_z2 = (zmesh-z_tomography(p1+1))/(z_tomography(p5+1)-z_tomography(p1+1))
endif
if(gamma_interp_z2 > 1.d0) then
gamma_interp_z2 = 1.d0
@@ -270,7 +273,7 @@
if(z_tomography(p6+1) == z_tomography(p2+1)) then
gamma_interp_z3 = 1.d0
else
- gamma_interp_z3 = (z_eval-z_tomography(p2+1))/(z_tomography(p6+1)-z_tomography(p2+1))
+ gamma_interp_z3 = (zmesh-z_tomography(p2+1))/(z_tomography(p6+1)-z_tomography(p2+1))
endif
if(gamma_interp_z3 > 1.d0) then
gamma_interp_z3 = 1.d0
@@ -283,7 +286,7 @@
if(z_tomography(p7+1) == z_tomography(p3+1)) then
gamma_interp_z4 = 1.d0
else
- gamma_interp_z4 = (z_eval-z_tomography(p3+1))/(z_tomography(p7+1)-z_tomography(p3+1))
+ gamma_interp_z4 = (zmesh-z_tomography(p3+1))/(z_tomography(p7+1)-z_tomography(p3+1))
endif
if(gamma_interp_z4 > 1.d0) then
gamma_interp_z4 = 1.d0
@@ -363,4 +366,7 @@
if(vs_final > VS_MAX) vs_final = VS_MAX
if(rho_final > RHO_MAX) rho_final = RHO_MAX
+ ! attenuation: arbitrary value, see maximum in constants.h
+ qmu_atten = ATTENUATION_COMP_MAXIMUM
+
end subroutine model_tomography
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/save_arrays_solver.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/save_arrays_solver.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/save_arrays_solver.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -529,17 +529,16 @@
deallocate(iglob_tmp)
endif
+ ! debug: saves 1. MPI interface
+ !if( num_interfaces_ext_mesh >= 1 ) then
+ ! filename = prname(1:len_trim(prname))//'MPI_1_points'
+ ! call write_VTK_data_points(nglob, &
+ ! xstore_dummy,ystore_dummy,zstore_dummy, &
+ ! ibool_interfaces_ext_mesh_dummy(1:nibool_interfaces_ext_mesh(1),1), &
+ ! nibool_interfaces_ext_mesh(1), &
+ ! filename)
+ !endif
- !! saves 1. MPI interface
- if( num_interfaces_ext_mesh >= 1 ) then
- filename = prname(1:len_trim(prname))//'MPI_1_points'
- call write_VTK_data_points(nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- ibool_interfaces_ext_mesh_dummy(1:nibool_interfaces_ext_mesh(1),1), &
- nibool_interfaces_ext_mesh(1), &
- filename)
- endif
-
! acoustic-poroelastic domains
if( ACOUSTIC_SIMULATION .and. POROELASTIC_SIMULATION ) then
! saves points on acoustic-poroelastic coupling interface
@@ -624,7 +623,7 @@
deallocate(v_tmp_i,iglob_tmp)
endif !if( ACOUSTIC_SIMULATION .and. POROELASTIC_SIMULATION
- !! saves 1. MPI interface
+ !debug: saves 1. MPI interface
! if( num_interfaces_ext_mesh >= 1 ) then
! filename = prname(1:len_trim(prname))//'MPI_1_points'
! call write_VTK_data_points(nglob, &
Modified: seismo/3D/SPECFEM3D/trunk/src/meshfem3D/check_mesh_quality.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/meshfem3D/check_mesh_quality.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/meshfem3D/check_mesh_quality.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -35,26 +35,27 @@
!! DK DK this routine could be improved by computing the mean in addition to min and max of ratios
!! DK DK
+ subroutine check_mesh_quality(myrank,VP_MAX,NGLOB,NSPEC,x,y,z,ibool, &
+ CREATE_VTK_FILES,prname)
-
-subroutine check_mesh_quality(myrank,VP_MAX,NPOIN,NSPEC,x,y,z,ibool)
-
implicit none
include "constants.h"
- integer :: NPOIN ! number of nodes
- integer :: NSPEC
+ integer :: myrank
+
double precision :: VP_MAX ! maximum vp in volume block id 3
- !------------------------------------------------------------------------------------------------
+ integer :: NGLOB ! number of nodes
+ integer :: NSPEC
- integer :: myrank
-
- double precision, dimension(NPOIN) :: x,y,z
-
+ double precision, dimension(NGLOB) :: x,y,z
integer, dimension(NGNOD,NSPEC) :: ibool
+ logical :: CREATE_VTK_FILES
+ character(len=256) prname
+
+ ! local parameters
integer :: ispec,ispec_min_edge_length,ispec_max_edge_length,ispec_max_skewness, &
ispec_max_skewness_MPI,skewness_max_rank,NSPEC_ALL_SLICES
@@ -91,7 +92,11 @@
!character(len=256):: line
+ ! debug: for vtk output
+ real(kind=CUSTOM_REAL),dimension(:),allocatable :: tmp1
+ integer:: ier,ipoin
+
if (myrank == 0) then
write(IMAIN,*) '**************************'
write(IMAIN,*) 'Checking mesh quality'
@@ -119,17 +124,28 @@
ispec_min_edge_length = -1
ispec_max_edge_length = -1
+ ! debug: for vtk output
+ if( CREATE_VTK_FILES ) then
+ allocate(tmp1(NSPEC),stat=ier)
+ if( ier /= 0 ) stop 'error allocating array tmp'
+ tmp1(:) = 0.0
+ endif
+
+
! loop on all the elements
do ispec = 1,NSPEC
- call create_mesh_quality_data_3D(x,y,z,ibool,ispec,NSPEC,NPOIN,VP_MAX,dt_suggested, &
- equiangle_skewness,edge_aspect_ratio,diagonal_aspect_ratio,stability,distmin,distmax)
+ call create_mesh_quality_data_3D(x,y,z,ibool,ispec,NSPEC,NGLOB,VP_MAX,dt_suggested, &
+ equiangle_skewness,edge_aspect_ratio,diagonal_aspect_ratio, &
+ stability,distmin,distmax)
! store element number in which the edge of minimum or maximum length is located
if(distmin < distance_min) ispec_min_edge_length = ispec
if(distmax > distance_max) ispec_max_edge_length = ispec
if(equiangle_skewness > equiangle_skewness_max) ispec_max_skewness = ispec
+ if( CREATE_VTK_FILES ) tmp1(ispec) = equiangle_skewness
+
! compute minimum and maximum of quality numbers
equiangle_skewness_min = min(equiangle_skewness_min,equiangle_skewness)
edge_aspect_ratio_min = min(edge_aspect_ratio_min,edge_aspect_ratio)
@@ -250,7 +266,7 @@
! create statistics about mesh quality
write(IMAIN,*) 'creating histogram and statistics of mesh quality'
-end if
+ end if
! erase histogram of skewness
@@ -259,8 +275,9 @@
! loop on all the elements
do ispec = 1,NSPEC
- call create_mesh_quality_data_3D(x,y,z,ibool,ispec,NSPEC,NPOIN,VP_MAX,dt_suggested, &
- equiangle_skewness,edge_aspect_ratio,diagonal_aspect_ratio,stability,distmin,distmax)
+ call create_mesh_quality_data_3D(x,y,z,ibool,ispec,NSPEC,NGLOB,VP_MAX,dt_suggested, &
+ equiangle_skewness,edge_aspect_ratio,diagonal_aspect_ratio, &
+ stability,distmin,distmax)
! store skewness in histogram
iclass = int(equiangle_skewness * dble(NCLASS))
@@ -327,18 +344,60 @@
stop 'total percentage should be 100%'
endif
-end if
+ end if
-end subroutine check_mesh_quality
+ ! debug: for vtk output
+ if( CREATE_VTK_FILES ) then
+ ! vtk file output
+ open(66,file=prname(1:len_trim(prname))//'skewness.vtk',status='unknown')
+ write(66,'(a)') '# vtk DataFile Version 3.1'
+ write(66,'(a)') 'material model VTK file'
+ write(66,'(a)') 'ASCII'
+ write(66,'(a)') 'DATASET UNSTRUCTURED_GRID'
+ write(66, '(a,i12,a)') 'POINTS ', nglob, ' float'
+ do ipoin = 1,nglob
+ write(66,*) sngl(x(ipoin)),sngl(y(ipoin)),sngl(z(ipoin))
+ enddo
+ write(66,*) ""
+ ! note: indices for vtk start at 0
+ write(66,'(a,i12,i12)') "CELLS ",nspec,nspec*9
+ do ispec=1,nspec
+ write(66,'(9i12)') 8, &
+ ibool(1,ispec)-1,ibool(2,ispec)-1,ibool(4,ispec)-1,ibool(3,ispec)-1,&
+ ibool(5,ispec)-1,ibool(6,ispec)-1,ibool(8,ispec)-1,ibool(7,ispec)-1
+ enddo
+ write(66,*) ""
+
+ ! type: hexahedrons
+ write(66,'(a,i12)') "CELL_TYPES ",nspec
+ write(66,*) (12,ispec=1,nspec)
+ write(66,*) ""
+
+ write(66,'(a,i12)') "CELL_DATA ",nspec
+ write(66,'(a)') "SCALARS skewness float"
+ write(66,'(a)') "LOOKUP_TABLE default"
+ do ispec = 1,nspec
+ write(66,*) tmp1(ispec)
+ enddo
+ write(66,*) ""
+ close(66)
+
+ deallocate(tmp1)
+ endif
+
+
+ end subroutine check_mesh_quality
+
!
!=====================================================================
!
! create mesh quality data for a given 3D spectral element
-subroutine create_mesh_quality_data_3D(x,y,z,ibool,ispec,NSPEC,NPOIN,VP_MAX,dt_suggested, &
- equiangle_skewness,edge_aspect_ratio,diagonal_aspect_ratio,stability,distmin,distmax)
+ subroutine create_mesh_quality_data_3D(x,y,z,ibool,ispec,NSPEC,NGLOB,VP_MAX,dt_suggested, &
+ equiangle_skewness,edge_aspect_ratio,diagonal_aspect_ratio, &
+ stability,distmin,distmax)
implicit none
@@ -346,9 +405,9 @@
integer :: true_NGLLX = 5
- integer :: iface,icorner,ispec,NSPEC,NPOIN,i
+ integer :: iface,icorner,ispec,NSPEC,NGLOB,i
- double precision, dimension(NPOIN) :: x,y,z
+ double precision, dimension(NGLOB) :: x,y,z
integer, dimension(NGNOD,NSPEC) :: ibool
Modified: seismo/3D/SPECFEM3D/trunk/src/meshfem3D/compute_parameters.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/meshfem3D/compute_parameters.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/meshfem3D/compute_parameters.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -24,13 +24,13 @@
!
!=====================================================================
-subroutine compute_parameters(NER,NEX_XI,NEX_ETA,NPROC_XI,NPROC_ETA, &
- NPROC,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
- NSPEC_AB,NSPEC2D_A_XI,NSPEC2D_B_XI, &
- NSPEC2D_A_ETA,NSPEC2D_B_ETA, &
- NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
- NPOIN2DMAX_XMIN_XMAX,NPOIN2DMAX_YMIN_YMAX,NGLOB_AB,&
- USE_REGULAR_MESH,NDOUBLINGS,ner_doublings)
+ subroutine compute_parameters(NER,NEX_XI,NEX_ETA,NPROC_XI,NPROC_ETA, &
+ NPROC,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
+ NSPEC_AB,NSPEC2D_A_XI,NSPEC2D_B_XI, &
+ NSPEC2D_A_ETA,NSPEC2D_B_ETA, &
+ NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
+ NPOIN2DMAX_XMIN_XMAX,NPOIN2DMAX_YMIN_YMAX,NGLOB_AB,&
+ USE_REGULAR_MESH,NDOUBLINGS,ner_doublings)
implicit none
@@ -164,7 +164,7 @@
! exact number of surface elements in the doubling regions
! number of elementary bricks in the two regions with doubling
- NUM2D_DOUBLING_BRICKS_XI = (NEX_PER_PROC_XI/4 &
+ NUM2D_DOUBLING_BRICKS_XI = (NEX_PER_PROC_XI/2 &
+ NEX_DOUBLING_ABOVE_PER_PROC_XI)/2
NUM2D_DOUBLING_BRICKS_ETA = (NEX_PER_PROC_ETA/2 &
@@ -204,8 +204,8 @@
! 2-D addressing and buffers for summation between slices
! we add one to number of points because of the flag after the last point
- NPOIN2DMAX_XMIN_XMAX = NSPEC2DMAX_XMIN_XMAX*2*2 + 1
- NPOIN2DMAX_YMIN_YMAX = NSPEC2DMAX_YMIN_YMAX*2*2 + 1
+ NPOIN2DMAX_XMIN_XMAX = NSPEC2DMAX_XMIN_XMAX*NGLLY*NGLLZ + 1
+ NPOIN2DMAX_YMIN_YMAX = NSPEC2DMAX_YMIN_YMAX*NGLLX*NGLLZ + 1
! exact number of global points
@@ -272,7 +272,7 @@
NSPEC2D_NO_DOUBLING_ETA = &
(NEX_PER_PROC_ETA/4)*NER_REGULAR1 &
- + (NEX_PER_PROC_ETA/4)*NER_REGULAR2 &
+ + (NEX_PER_PROC_ETA/2)*NER_REGULAR2 &
+ NEX_PER_PROC_ETA*NER_REGULAR3
! exact number of surface elements in the doubling regions
@@ -315,14 +315,18 @@
NSPEC2DMAX_XMIN_XMAX = NSPEC2D_B_ETA
NSPEC2DMAX_YMIN_YMAX = NSPEC2D_B_XI
+ !debug
+ !print*,'nspec minmax:',NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_yMAX
+
! theoretical number of Gauss-Lobatto points in radial direction
! NPOIN1D_RADIAL_BEDROCK = NSPEC1D_RADIAL_BEDROCK*(NGLLZ-1)+1
! 2-D addressing and buffers for summation between slices
! we add one to number of points because of the flag after the last point
- NPOIN2DMAX_XMIN_XMAX = NSPEC2DMAX_XMIN_XMAX*2*2 + 1
- NPOIN2DMAX_YMIN_YMAX = NSPEC2DMAX_YMIN_YMAX*2*2 + 1
+ NPOIN2DMAX_XMIN_XMAX = NSPEC2DMAX_XMIN_XMAX*NGLLY*NGLLZ + 1
+ NPOIN2DMAX_YMIN_YMAX = NSPEC2DMAX_YMIN_YMAX*NGLLX*NGLLZ + 1
+
! exact number of global points
! case of the doubling regions
Modified: seismo/3D/SPECFEM3D/trunk/src/meshfem3D/create_regions_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/meshfem3D/create_regions_mesh.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/meshfem3D/create_regions_mesh.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -427,14 +427,16 @@
! stores boundary informations
call store_boundaries(myrank,iboun,nspec, &
- ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
- nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
- NSPEC2D_BOTTOM,NSPEC2D_TOP, &
- NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX)
+ ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
+ nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
+ NSPEC2D_BOTTOM,NSPEC2D_TOP, &
+ NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX)
! checks mesh resolution
VP_MAX = maxval(material_properties(:,2))
- call check_mesh_quality(myrank,VP_MAX,nglob,nspec,nodes_coords(:,1),nodes_coords(:,2),nodes_coords(:,3),ibool)
+ call check_mesh_quality(myrank,VP_MAX,nglob,nspec, &
+ nodes_coords(:,1),nodes_coords(:,2),nodes_coords(:,3),ibool, &
+ CREATE_VTK_FILES,prname)
! saves mesh as databases file
call save_databases(prname,nspec,nglob,iproc_xi,iproc_eta, &
Modified: seismo/3D/SPECFEM3D/trunk/src/meshfem3D/create_visual_files.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/meshfem3D/create_visual_files.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/meshfem3D/create_visual_files.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -55,7 +55,7 @@
if(CREATE_ABAQUS_FILES) then
- open(unit=64,file=prname(1:len_trim(prname))//'.INP',status='unknown',action='write',form='formatted')
+ open(unit=64,file=prname(1:len_trim(prname))//'mesh.INP',status='unknown',action='write',form='formatted')
write(64,'(a8)') '*HEADING'
! write(64,'(a52)') 'cubit(mesh): 04/17/2009: 18:11:24'
write(64,'(a27)') 'SPECFEM3D meshfem3D(mesh): '
@@ -77,7 +77,7 @@
if(CREATE_DX_FILES) then
- open(unit=66,file=prname(1:len_trim(prname))//'.dx',status='unknown')
+ open(unit=66,file=prname(1:len_trim(prname))//'mesh.dx',status='unknown')
! write OpenDX header
write(66,*) 'object 1 class array type float rank 1 shape 3 items ',nglob,' data follows'
@@ -115,7 +115,6 @@
write(66,*) true_material_num(ispec)
enddo
-
write(66,*) 'attribute "dep" string "connections"'
write(66,*) 'object "irregular positions irregular connections" class field'
write(66,*) 'component "positions" value 1'
@@ -129,7 +128,7 @@
if( CREATE_VTK_FILES ) then
! vtk file output
- open(66,file=prname(1:len_trim(prname))//'.vtk',status='unknown')
+ open(66,file=prname(1:len_trim(prname))//'mesh.vtk',status='unknown')
write(66,'(a)') '# vtk DataFile Version 3.1'
write(66,'(a)') 'material model VTK file'
write(66,'(a)') 'ASCII'
@@ -165,11 +164,7 @@
endif
-
-
call sync_all()
-
end subroutine create_visual_files
-
Modified: seismo/3D/SPECFEM3D/trunk/src/meshfem3D/meshfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/meshfem3D/meshfem3D.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/meshfem3D/meshfem3D.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -213,11 +213,9 @@
integer, dimension(:,:), allocatable :: addressing
! use integer array to store topography values
- integer icornerlat,icornerlong !,NX_TOPO,NY_TOPO
- double precision lat,long !,elevation,ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO
+ integer icornerlat,icornerlong
+ double precision lat,long
double precision long_corner,lat_corner,ratio_xi,ratio_eta
- !character(len=100) topo_file
- !integer, dimension(:,:), allocatable :: itopo_bathy
! timer MPI
double precision, external :: wtime
@@ -405,8 +403,10 @@
if( myrank == 0 ) then
write(IMAIN,*) 'error: number of processors supposed to run on: ',NPROC
write(IMAIN,*) 'error: number of MPI processors actually run on: ',sizeprocs
- print*, 'error: number of processors supposed to run on: ',NPROC
- print*, 'error: number of MPI processors actually run on: ',sizeprocs
+ print*
+ print*, 'error meshfem3D: number of processors supposed to run on: ',NPROC
+ print*, 'error meshfem3D: number of MPI processors actually run on: ',sizeprocs
+ print*
endif
call exit_MPI(myrank,'wrong number of MPI processes')
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/meshfem3D/save_databases.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/meshfem3D/save_databases.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/meshfem3D/save_databases.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -37,31 +37,27 @@
include "constants.h"
-! number of spectral elements in each block
+ ! number of spectral elements in each block
integer nspec
-! number of vertices in each block
+ ! number of vertices in each block
integer nglob
-! MPI cartesian topology
-! E for East (= XI_MIN), W for West (= XI_MAX), S for South (= ETA_MIN), N for North (= ETA_MAX)
+ ! MPI cartesian topology
+ ! E for East (= XI_MIN), W for West (= XI_MAX), S for South (= ETA_MIN), N for North (= ETA_MAX)
integer, parameter :: W=1,E=2,S=3,N=4,NW=5,NE=6,SE=7,SW=8
integer iproc_xi,iproc_eta
integer NPROC_XI,NPROC_ETA
logical iMPIcut_xi(2,nspec),iMPIcut_eta(2,nspec)
integer addressing(0:NPROC_XI-1,0:NPROC_ETA-1)
-! arrays with the mesh
+ ! arrays with the mesh
integer ibool(NGLLX,NGLLY,NGLLZ,nspec)
-! real(kind=CUSTOM_REAL) :: nodes_coords(nglob,3)
double precision :: nodes_coords(nglob,3)
-
integer true_material_num(nspec)
- !double precision rho,vp,vs
-
-! boundary parameters locator
+ ! boundary parameters locator
integer NSPEC2D_BOTTOM,NSPEC2D_TOP,NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX
integer nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax
integer ibelm_xmin(NSPEC2DMAX_XMIN_XMAX),ibelm_xmax(NSPEC2DMAX_XMIN_XMAX)
@@ -69,24 +65,25 @@
integer ibelm_bottom(NSPEC2D_BOTTOM)
integer ibelm_top(NSPEC2D_TOP)
-! material properties
+ ! material properties
integer :: NMATERIALS
-! first dimension : material_id
-! second dimension : #rho #vp #vs #Q_flag #anisotropy_flag #domain_id
+ ! first dimension : material_id
+ ! second dimension : #rho #vp #vs #Q_flag #anisotropy_flag #domain_id
double precision , dimension(NMATERIALS,6) :: material_properties
double precision , dimension(16) :: matpropl
integer :: i,ispec,iglob,ier
-! name of the database files
+ ! name of the database files
character(len=256) prname
-! for MPI interfaces
+ ! for MPI interfaces
integer :: nb_interfaces,nspec_interfaces_max,idoubl
logical, dimension(8) :: interfaces
integer, dimension(8) :: nspec_interface
integer, parameter :: IIN_database = 15
+ ! opens database file
open(unit=IIN_database,file=prname(1:len_trim(prname))//'Database', &
status='unknown',action='write',form='unformatted',iostat=ier)
if( ier /= 0 ) stop 'error opening Database file'
@@ -96,8 +93,7 @@
write(IIN_database) iglob,nodes_coords(iglob,1),nodes_coords(iglob,2),nodes_coords(iglob,3)
end do
-
-! Materials properties
+ ! Materials properties
write(IIN_database) NMATERIALS, 0
do idoubl = 1,NMATERIALS
!write(IIN_database,*) material_properties(idoubl,:)
Modified: seismo/3D/SPECFEM3D/trunk/src/meshfem3D/store_boundaries.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/meshfem3D/store_boundaries.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/meshfem3D/store_boundaries.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -26,10 +26,10 @@
subroutine store_boundaries(myrank,iboun,nspec,&
- ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
- nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
- NSPEC2D_BOTTOM,NSPEC2D_TOP, &
- NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX)
+ ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
+ nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
+ NSPEC2D_BOTTOM,NSPEC2D_TOP, &
+ NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX)
implicit none
@@ -45,17 +45,17 @@
logical iboun(6,nspec)
-! global element numbering
+ ! global element numbering
integer ispec
-! counters to keep track of number of elements on each of the boundaries
+ ! counters to keep track of number of elements on each of the boundaries
integer ispecb1,ispecb2,ispecb3,ispecb4,ispecb5,ispecb6
-
-! check that the parameter file is correct
+ ! check that the parameter file is correct
if(NGNOD /= 8) call exit_MPI(myrank,'elements should have 8 control nodes')
if(NGNOD2D /= 4) call exit_MPI(myrank,'surface elements should have 4 control nodes')
+ ! initializes
ispecb1 = 0
ispecb2 = 0
ispecb3 = 0
@@ -63,71 +63,57 @@
ispecb5 = 0
ispecb6 = 0
+ ! determine if the element falls on a boundary
do ispec=1,nspec
-! determine if the element falls on a boundary
+ ! on boundary: xmin
+ if(iboun(1,ispec)) then
+ ispecb1=ispecb1+1
+ if( ispecb1 > NSPEC2DMAX_XMIN_XMAX ) stop 'error NSPEC2DMAX_XMIN_XMAX too small'
+ ibelm_xmin(ispecb1)=ispec
+ endif
-! on boundary: xmin
+ ! on boundary: xmax
+ if(iboun(2,ispec)) then
+ ispecb2=ispecb2+1
+ if( ispecb2 > NSPEC2DMAX_XMIN_XMAX ) stop 'error NSPEC2DMAX_XMIN_XMAX too small'
+ ibelm_xmax(ispecb2)=ispec
+ endif
- if(iboun(1,ispec)) then
+ ! on boundary: ymin
+ if(iboun(3,ispec)) then
+ ispecb3=ispecb3+1
+ if( ispecb3 > NSPEC2DMAX_YMIN_YMAX ) stop 'error NSPEC2DMAX_YMIN_YMAX too small'
+ ibelm_ymin(ispecb3)=ispec
+ endif
- ispecb1=ispecb1+1
- ibelm_xmin(ispecb1)=ispec
+ ! on boundary: ymax
+ if(iboun(4,ispec)) then
+ ispecb4=ispecb4+1
+ if( ispecb4 > NSPEC2DMAX_YMIN_YMAX ) stop 'error NSPEC2DMAX_YMIN_YMAX too small'
+ ibelm_ymax(ispecb4)=ispec
+ endif
- endif
+ ! on boundary: bottom
+ if(iboun(5,ispec)) then
+ ispecb5=ispecb5+1
+ if( ispecb5 > NSPEC2D_BOTTOM ) stop 'error NSPEC2D_BOTTOM too small'
+ ibelm_bottom(ispecb5)=ispec
+ endif
+ ! on boundary: top
+ if(iboun(6,ispec)) then
+ ispecb6=ispecb6+1
+ if( ispecb6 > NSPEC2D_TOP ) stop 'error NSPEC2D_TOP too small'
+ ibelm_top(ispecb6)=ispec
+ endif
-! on boundary: xmax
-
- if(iboun(2,ispec)) then
-
- ispecb2=ispecb2+1
- ibelm_xmax(ispecb2)=ispec
-
- endif
-
-! on boundary: ymin
-
- if(iboun(3,ispec)) then
-
- ispecb3=ispecb3+1
- ibelm_ymin(ispecb3)=ispec
-
- endif
-
-! on boundary: ymax
-
- if(iboun(4,ispec)) then
-
- ispecb4=ispecb4+1
- ibelm_ymax(ispecb4)=ispec
-
- endif
-
-! on boundary: bottom
-
- if(iboun(5,ispec)) then
-
- ispecb5=ispecb5+1
- ibelm_bottom(ispecb5)=ispec
-
- endif
-
-! on boundary: top
-
- if(iboun(6,ispec)) then
-
- ispecb6=ispecb6+1
- ibelm_top(ispecb6)=ispec
-
- endif
-
enddo
-! check theoretical value of elements at the bottom
+ ! check theoretical value of elements at the bottom
if(ispecb5 /= NSPEC2D_BOTTOM) call exit_MPI(myrank,'ispecb5 should equal NSPEC2D_BOTTOM')
-! check theoretical value of elements at the top
+ ! check theoretical value of elements at the top
if(ispecb6 /= NSPEC2D_TOP) call exit_MPI(myrank,'ispecb6 should equal NSPEC2D_TOP')
nspec2D_xmin = ispecb1
@@ -135,20 +121,24 @@
nspec2D_ymin = ispecb3
nspec2D_ymax = ispecb4
-end subroutine store_boundaries
+ end subroutine store_boundaries
+!
+!-------------------------------------------------------------------------------------------------
+!
+
subroutine get_jacobian_boundaries(myrank,iboun,nspec,xstore,ystore,zstore, &
- dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
- ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
- nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
- jacobian2D_xmin,jacobian2D_xmax, &
- jacobian2D_ymin,jacobian2D_ymax, &
- jacobian2D_bottom,jacobian2D_top, &
- normal_xmin,normal_xmax, &
- normal_ymin,normal_ymax, &
- normal_bottom,normal_top, &
- NSPEC2D_BOTTOM,NSPEC2D_TOP, &
- NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX)
+ dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
+ ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
+ nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
+ jacobian2D_xmin,jacobian2D_xmax, &
+ jacobian2D_ymin,jacobian2D_ymax, &
+ jacobian2D_bottom,jacobian2D_top, &
+ normal_xmin,normal_xmax, &
+ normal_ymin,normal_ymax, &
+ normal_bottom,normal_top, &
+ NSPEC2D_BOTTOM,NSPEC2D_TOP, &
+ NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX)
implicit none
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/check_mesh_resolution.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/check_mesh_resolution.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/check_mesh_resolution.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -356,7 +356,8 @@
subroutine check_mesh_resolution_poro(myrank,NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore, &
DT, model_speed_max,min_resolved_period, &
phistore,tortstore,rhoarraystore, &
- rho_vpI,rho_vpII,rho_vsI )
+ rho_vpI,rho_vpII,rho_vsI, &
+ LOCAL_PATH,SAVE_MESH_FILES )
! check the mesh, stability and resolved period for poroelastic domains
!
@@ -375,6 +376,9 @@
double precision :: DT
real(kind=CUSTOM_REAL) :: model_speed_max,min_resolved_period
+ character(len=256):: LOCAL_PATH
+ logical :: SAVE_MESH_FILES
+
! local parameters
real(kind=CUSTOM_REAL) :: vpmin,vpmax,vsmin,vsmax,vpmin_glob,vpmax_glob,vsmin_glob,vsmax_glob
real(kind=CUSTOM_REAL) :: vp2min,vp2max,vp2min_glob,vp2max_glob
@@ -401,9 +405,14 @@
!********************************************************************************
!real(kind=CUSTOM_REAL),parameter :: NELEM_PER_WAVELENGTH = 1.5
-
logical :: has_vs_zero,has_vp2_zero
+ ! debug: for vtk output
+ real(kind=CUSTOM_REAL),dimension(:),allocatable :: tmp1,tmp2
+ integer:: ier
+ character(len=256) :: filename,prname
+
+
! initializations
if( DT <= 0.0d0) then
DT_PRESENT = .false.
@@ -434,6 +443,16 @@
has_vs_zero = .false.
has_vp2_zero = .false.
+ ! debug: for vtk output
+ if( SAVE_MESH_FILES ) then
+ allocate(tmp1(NSPEC_AB),stat=ier)
+ allocate(tmp2(NSPEC_AB),stat=ier)
+ if( ier /= 0 ) stop 'error allocating array tmp'
+ tmp1(:) = 0.0
+ tmp2(:) = 0.0
+ endif
+
+
! checks courant number & minimum resolved period for each grid cell
do ispec=1,NSPEC_AB
@@ -472,6 +491,10 @@
if( DT_PRESENT ) then
cmax = max( vpmax,vp2max,vsmax ) * DT / distance_min
cmax_glob = max(cmax_glob,cmax)
+
+ ! debug: for vtk output
+ if( SAVE_MESH_FILES ) tmp1(ispec) = cmax
+
endif
! suggested timestep
@@ -506,6 +529,9 @@
!pmax = distance_max / min( vpmin,vsmin ) * NELEM_PER_WAVELENGTH
!pmax_glob = max(pmax_glob,pmax)
+ ! debug: for vtk output
+ if( SAVE_MESH_FILES ) tmp2(ispec) = pmax
+
enddo
! determines global min/max values from all cpu partitions
@@ -660,6 +686,23 @@
if( myrank == 0 ) min_resolved_period = pmax_glob
call bcast_all_cr(min_resolved_period,1)
+ ! debug: for vtk output
+ if( SAVE_MESH_FILES ) then
+ call create_name_database(prname,myrank,LOCAL_PATH)
+ ! courant number
+ if( DT_PRESENT ) then
+ filename = trim(prname)//'res_courant_number'
+ call write_VTK_data_elem_cr(NSPEC_AB,NGLOB_AB, &
+ xstore,ystore,zstore,ibool, &
+ tmp1,filename)
+ endif
+ ! minimum period estimate
+ filename = trim(prname)//'res_minimum_period'
+ call write_VTK_data_elem_cr(NSPEC_AB,NGLOB_AB, &
+ xstore,ystore,zstore,ibool, &
+ tmp2,filename)
+ deallocate(tmp1,tmp2)
+ endif
end subroutine check_mesh_resolution_poro
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/combine_vol_data.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/combine_vol_data.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/combine_vol_data.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -75,7 +75,8 @@
logical :: ABSORBING_CONDITIONS,SAVE_FORWARD
logical :: ANISOTROPY,SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION
character(len=256) LOCAL_PATH
-
+ integer :: IMODEL
+
! checks given arguments
print *
print *,'Recombining ParaView data for slices'
@@ -151,7 +152,7 @@
NTSTEP_BETWEEN_FRAMES,USE_HIGHRES_FOR_MOVIES,HDUR_MOVIE, &
SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION, &
NTSTEP_BETWEEN_OUTPUT_INFO,SIMULATION_TYPE,SAVE_FORWARD, &
- NTSTEP_BETWEEN_READ_ADJSRC,NOISE_TOMOGRAPHY)
+ NTSTEP_BETWEEN_READ_ADJSRC,NOISE_TOMOGRAPHY,IMODEL)
print *, 'Slice list: '
print *, node_list(1:num_node)
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in 2012-05-07 11:03:03 UTC (rev 20046)
@@ -53,9 +53,6 @@
! apply heuristic rule to modify doubling regions to balance angles
logical, parameter :: APPLY_HEURISTIC_RULE = .true.
-! adds/superimposes velocity model values from 'model_external_values.f90'
- logical, parameter :: USE_MODEL_EXTERNAL_VALUES = .false.
-
! use inlined products of Deville et al. (2002) to speedup the calculations to compute internal forces
logical, parameter :: USE_DEVILLE_PRODUCTS = .true.
@@ -302,14 +299,14 @@
integer, parameter :: NUM_ITER = 4
! size of topography and bathymetry file for Southern California
- integer, parameter :: NX_TOPO_SOCAL = 1401,NY_TOPO_SOCAL = 1001
- double precision, parameter :: ORIG_LAT_TOPO_SOCAL = 32.d0
- double precision, parameter :: ORIG_LONG_TOPO_SOCAL = -121.d0
- double precision, parameter :: DEGREES_PER_CELL_TOPO_SOCAL = 5.d0 / 1000.d0
- character(len=100), parameter :: TOPO_FILE_SOCAL = 'DATA/la_topography/topo_bathy_final.dat'
+ integer, parameter :: NX_TOPO_FILE = 1401,NY_TOPO_FILE = 1001
+ double precision, parameter :: ORIG_LAT_TOPO = 32.d0
+ double precision, parameter :: ORIG_LONG_TOPO = -121.d0
+ double precision, parameter :: DEGREES_PER_CELL_TOPO = 5.d0 / 1000.d0
+ character(len=100), parameter :: TOPO_FILE = 'DATA/la_topography/topo_bathy_final.dat'
! ! size of topography and bathymetry file for Piero Basini's model
-! integer, parameter :: NX_TOPO = 787, NY_TOPO = 793
+! integer, parameter :: NX_TOPO_FILE = 787, NY_TOPO_FILE = 793
! double precision, parameter :: ORIG_LAT_TOPO = -102352.d0
! double precision, parameter :: ORIG_LONG_TOPO = 729806.d0
! ! for Piero Basini's model this is the resolution in meters of the topo file
@@ -332,3 +329,13 @@
! number of points in each AVS or OpenDX quadrangular cell for movies
integer, parameter :: NGNOD2D_AVS_DX = 4
+
+! model ids
+ integer, parameter :: IMODEL_DEFAULT = 1
+ integer, parameter :: IMODEL_1D_PREM = 2
+ integer, parameter :: IMODEL_1D_SOCAL = 3
+ integer, parameter :: IMODEL_1D_CASCADIA = 4
+ integer, parameter :: IMODEL_TOMO = 5
+ integer, parameter :: IMODEL_USER_EXTERNAL = 6
+ integer, parameter :: IMODEL_GLL = 7
+ integer, parameter :: IMODEL_SALTON_TROUGH = 8
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/create_movie_shakemap_AVS_DX_GMT.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/create_movie_shakemap_AVS_DX_GMT.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/create_movie_shakemap_AVS_DX_GMT.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -98,8 +98,8 @@
character(len=256) OUTPUT_FILES,LOCAL_PATH
integer NPROC
integer ier
+ integer :: IMODEL
-
!--------------------------------------------
!!!! NL NL for external meshes
!--------------------------------------------
@@ -135,7 +135,7 @@
NTSTEP_BETWEEN_FRAMES,USE_HIGHRES_FOR_MOVIES,HDUR_MOVIE, &
SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION, &
NTSTEP_BETWEEN_OUTPUT_INFO,SIMULATION_TYPE,SAVE_FORWARD, &
- NTSTEP_BETWEEN_READ_ADJSRC,NOISE_TOMOGRAPHY)
+ NTSTEP_BETWEEN_READ_ADJSRC,NOISE_TOMOGRAPHY,IMODEL)
! get the base pathname for output files
call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', OUTPUT_FILES_PATH(1:len_trim(OUTPUT_FILES_PATH)))
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/parallel.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/parallel.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/parallel.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -143,6 +143,30 @@
!----
!
+ subroutine bcast_all_r(buffer, count)
+
+ implicit none
+
+! standard include of the MPI library
+ include 'mpif.h'
+
+ include "constants.h"
+ include "precision.h"
+
+ integer count
+ real, dimension(count) :: buffer
+
+ integer ier
+
+ call MPI_BCAST(buffer,count,MPI_REAL,0,MPI_COMM_WORLD,ier)
+
+ end subroutine bcast_all_r
+
+
+!
+!----
+!
+
subroutine gather_all_i(sendbuf, sendcnt, recvbuf, recvcount, NPROC)
implicit none
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/read_parameter_file.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/read_parameter_file.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/read_parameter_file.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -32,7 +32,7 @@
NTSTEP_BETWEEN_FRAMES,USE_HIGHRES_FOR_MOVIES,HDUR_MOVIE, &
SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION,NTSTEP_BETWEEN_OUTPUT_INFO, &
SIMULATION_TYPE,SAVE_FORWARD, &
- NTSTEP_BETWEEN_READ_ADJSRC,NOISE_TOMOGRAPHY )
+ NTSTEP_BETWEEN_READ_ADJSRC,NOISE_TOMOGRAPHY,IMODEL )
implicit none
@@ -41,6 +41,7 @@
integer NPROC,NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,SIMULATION_TYPE, NTSTEP_BETWEEN_READ_ADJSRC
integer NSOURCES,NTSTEP_BETWEEN_FRAMES,NTSTEP_BETWEEN_OUTPUT_INFO,UTM_PROJECTION_ZONE
integer NOISE_TOMOGRAPHY
+ integer IMODEL
double precision DT,HDUR_MOVIE
@@ -49,13 +50,16 @@
logical ANISOTROPY,SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION,SUPPRESS_UTM_PROJECTION
character(len=256) LOCAL_PATH,CMTSOLUTION
-
+
! local variables
integer ::ios,icounter,isource,idummy,nproc_eta_old,nproc_xi_old
double precision :: hdur,minval_hdur
character(len=256) :: dummystring
integer, external :: err_occurred
+ character(len=150) MODEL
+ integer :: i,irange
+
! opens file Par_file
call open_parameter_file()
@@ -93,6 +97,11 @@
if(err_occurred() /= 0) return
call read_value_double_precision(DT, 'solver.DT')
if(err_occurred() /= 0) return
+
+ ! define the velocity model
+ call read_value_string(MODEL, 'model.MODEL')
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MODEL'
+
call read_value_logical(OCEANS, 'model.OCEANS')
if(err_occurred() /= 0) return
call read_value_logical(TOPOGRAPHY, 'model.TOPOGRAPHY')
@@ -132,6 +141,9 @@
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()
+
! noise simulations:
! double the number of time steps, if running noise simulations (+/- branches)
if ( NOISE_TOMOGRAPHY /= 0 ) NSTEP = 2*NSTEP-1
@@ -205,12 +217,49 @@
enddo
close(1)
-! one cannot use a Heaviside source for the movies
+ ! one cannot use a Heaviside source for the movies
if((MOVIE_SURFACE .or. MOVIE_VOLUME) .and. sqrt(minval_hdur**2 + HDUR_MOVIE**2) < TINYVAL) &
stop 'hdur too small for movie creation, movies do not make sense for Heaviside source'
-! close parameter file
- call close_parameter_file()
+ ! converts all string characters to lowercase
+ irange = iachar('a') - iachar('A')
+ do i = 1,len_trim(MODEL)
+ if( lge(MODEL(i:i),'A') .and. lle(MODEL(i:i),'Z') ) then
+ MODEL(i:i) = achar( iachar(MODEL(i:i)) + irange )
+ endif
+ enddo
+ ! determines velocity model
+ select case( trim(MODEL) )
+
+ ! default mesh model
+ case( 'default' )
+ IMODEL = IMODEL_DEFAULT
+
+ ! 1-D models
+ case( '1d_prem' )
+ IMODEL = IMODEL_1D_PREM
+ case( '1d_cascadia')
+ IMODEL = IMODEL_1D_CASCADIA
+
+ ! user models
+ case( 'salton_trough')
+ IMODEL = IMODEL_SALTON_TROUGH
+ case( 'tomo' )
+ IMODEL = IMODEL_TOMO
+ case( 'external' )
+ IMODEL = IMODEL_USER_EXTERNAL
+ case( 'aniso' )
+ IMODEL = IMODEL_DEFAULT
+ ANISOTROPY = .true.
+ case default
+ print*
+ print*,'********** model not recognized: ',trim(MODEL),' **************'
+ print*,'********** using model: default',' **************'
+ print*
+ IMODEL = IMODEL_DEFAULT
+ end select
+
+
end subroutine read_parameter_file
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/read_topo_bathy_file.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/read_topo_bathy_file.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/read_topo_bathy_file.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -24,26 +24,32 @@
!
!=====================================================================
- subroutine read_topo_bathy_file(itopo_bathy,NX_TOPO,NY_TOPO,topo_file)
-!
-!---- read topography and bathymetry file once and for all
-!
+ subroutine read_topo_bathy_file(itopo_bathy,NX_TOPO,NY_TOPO)
+
+! reads topography and bathymetry file
+
implicit none
include "constants.h"
- integer NX_TOPO,NY_TOPO
+ ! use integer array to store topography values
+ integer :: NX_TOPO,NY_TOPO
+ integer, dimension(NX_TOPO,NY_TOPO) :: itopo_bathy
-! use integer array to store topography values
- integer itopo_bathy(NX_TOPO,NY_TOPO)
+ ! local parameters
+ integer :: ix,iy,ier
- character(len=100) topo_file
-
- integer ix,iy
-
+ ! initializes
itopo_bathy(:,:) = 0
- open(unit=13,file=topo_file,status='old',action='read')
+ ! opens file
+ open(unit=13,file=trim(TOPO_FILE),status='old',action='read',iostat=ier)
+ if( ier /= 0 ) then
+ print*,'error opening topography file: ',trim(TOPO_FILE)
+ stop 'error opening topography file'
+ endif
+
+ ! reads in values
do iy=1,NY_TOPO
do ix=1,NX_TOPO
read(13,*) itopo_bathy(ix,iy)
@@ -53,3 +59,360 @@
end subroutine read_topo_bathy_file
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine get_topo_bathy_elevation(x_target,y_target,target_elevation, &
+ itopo_bathy,NX_TOPO,NY_TOPO, &
+ UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION)
+
+! finds elevation from topography file
+
+ implicit none
+
+ include "constants.h"
+
+ real(kind=CUSTOM_REAL),intent(in) :: x_target,y_target
+
+ real(kind=CUSTOM_REAL),intent(out) :: target_elevation
+
+ integer :: NX_TOPO,NY_TOPO
+ integer, dimension(NX_TOPO,NY_TOPO) :: itopo_bathy
+
+ integer :: UTM_PROJECTION_ZONE
+ logical :: SUPPRESS_UTM_PROJECTION
+
+ ! local parameters
+ double precision :: xval,yval,long,lat
+ double precision :: long_corner,lat_corner,ratio_xi,ratio_eta
+ integer :: icornerlong,icornerlat
+
+ ! get coordinates of current point
+ xval = dble(x_target)
+ yval = dble(y_target)
+
+ ! project x and y in UTM back to long/lat since topo file is in long/lat
+ call utm_geo(long,lat,xval,yval,UTM_PROJECTION_ZONE,IUTM2LONGLAT,SUPPRESS_UTM_PROJECTION)
+
+ ! get coordinate of corner in bathy/topo model
+ icornerlong = int((long - ORIG_LONG_TOPO) / DEGREES_PER_CELL_TOPO) + 1
+ icornerlat = int((lat - ORIG_LAT_TOPO) / DEGREES_PER_CELL_TOPO) + 1
+
+ ! avoid edge effects and extend with identical point if outside model
+ if(icornerlong < 1) icornerlong = 1
+ if(icornerlong > NX_TOPO-1) icornerlong = NX_TOPO-1
+ if(icornerlat < 1) icornerlat = 1
+ if(icornerlat > NY_TOPO-1) icornerlat = NY_TOPO-1
+
+ ! compute coordinates of corner
+ long_corner = ORIG_LONG_TOPO + (icornerlong-1)*DEGREES_PER_CELL_TOPO
+ lat_corner = ORIG_LAT_TOPO + (icornerlat-1)*DEGREES_PER_CELL_TOPO
+
+ ! compute ratio for interpolation
+ ratio_xi = (long - long_corner) / DEGREES_PER_CELL_TOPO
+ ratio_eta = (lat - lat_corner) / DEGREES_PER_CELL_TOPO
+
+ ! avoid edge effects
+ if(ratio_xi < 0.) ratio_xi = 0.
+ if(ratio_xi > 1.) ratio_xi = 1.
+ if(ratio_eta < 0.) ratio_eta = 0.
+ if(ratio_eta > 1.) ratio_eta = 1.
+
+ ! interpolate elevation at current point
+ target_elevation = &
+ itopo_bathy(icornerlong,icornerlat)*(1.-ratio_xi)*(1.-ratio_eta) + &
+ itopo_bathy(icornerlong+1,icornerlat)*ratio_xi*(1.-ratio_eta) + &
+ itopo_bathy(icornerlong+1,icornerlat+1)*ratio_xi*ratio_eta + &
+ itopo_bathy(icornerlong,icornerlat+1)*(1.-ratio_xi)*ratio_eta
+
+ end subroutine get_topo_bathy_elevation
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine get_topo_elevation_free(x_target,y_target,target_elevation,target_distmin, &
+ NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore, &
+ num_free_surface_faces,free_surface_ispec,free_surface_ijk)
+
+! get approximate topography elevation at source long/lat coordinates
+
+ implicit none
+
+ include "constants.h"
+
+ real(kind=CUSTOM_REAL),intent(in) :: x_target,y_target
+
+ real(kind=CUSTOM_REAL),intent(out) :: target_elevation
+ real(kind=CUSTOM_REAL),intent(out) :: target_distmin
+
+ integer :: NSPEC_AB,NGLOB_AB
+
+ integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
+
+ ! arrays containing coordinates of the points
+ real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: xstore,ystore,zstore
+
+ ! free surface
+ integer :: num_free_surface_faces
+ integer, dimension(num_free_surface_faces) :: free_surface_ispec
+ integer, dimension(3,NGLLSQUARE,num_free_surface_faces) :: free_surface_ijk
+
+ ! local parameters
+ real(kind=CUSTOM_REAL),dimension(4) :: elevation_node,dist_node
+ real(kind=CUSTOM_REAL) :: distmin,dist
+
+ integer :: iface,i,j,ispec,iglob,igll,jgll,kgll
+ integer :: iselected,jselected,iface_selected
+ integer :: inode,iadjust,jadjust
+
+ ! faster element search
+ logical,parameter :: USE_DISTANCE_CRITERION = .true.
+ integer,parameter :: MIDX = (NGLLX+1)/2
+ integer,parameter :: MIDY = (NGLLY+1)/2
+ integer,parameter :: MIDZ = (NGLLZ+1)/2
+
+ real(kind=CUSTOM_REAL) :: typical_size
+ logical :: located_target
+
+ ! initialize
+ target_elevation = 0.0_CUSTOM_REAL
+ target_distmin = HUGEVAL
+
+
+ if(num_free_surface_faces > 0) then
+
+ ! computes typical size of elements at the surface (uses first element for estimation)
+ if( USE_DISTANCE_CRITERION ) then
+ ispec = free_surface_ispec(1)
+ typical_size = (xstore(ibool(1,1,1,ispec)) - xstore(ibool(NGLLX,NGLLY,NGLLZ,ispec)))**2 &
+ + (ystore(ibool(1,1,1,ispec)) - ystore(ibool(NGLLX,NGLLY,NGLLZ,ispec)))**2
+ ! use 10 times the distance as a criterion for point detection
+ typical_size = 10. * typical_size
+ endif
+
+ ! flag to check that we located at least one target element
+ located_target = .false.
+
+ ! set distance to huge initial value
+ distmin = HUGEVAL
+ iselected = 2
+ jselected = 2
+ iface_selected = 1
+
+ ! loops over all free surface faces
+ do iface=1,num_free_surface_faces
+ ispec = free_surface_ispec(iface)
+
+ ! exclude elements that are too far from target
+ if( USE_DISTANCE_CRITERION ) then
+ iglob = ibool(MIDX,MIDY,MIDZ,ispec)
+ dist = (x_target - xstore(iglob))**2 + (y_target - ystore(iglob))**2
+ if( dist > typical_size ) cycle
+ endif
+
+ ! loop only on points inside the element
+ ! exclude edges to ensure this point is not shared with other elements
+ do j = 2,NGLLY - 1
+ do i = 2,NGLLX - 1
+
+ igll = free_surface_ijk(1,(j-1)*NGLLY+i,iface)
+ jgll = free_surface_ijk(2,(j-1)*NGLLY+i,iface)
+ kgll = free_surface_ijk(3,(j-1)*NGLLY+i,iface)
+
+ iglob = ibool(igll,jgll,kgll,ispec)
+
+ ! distance (squared) to target
+ dist = ( x_target - xstore(iglob) )**2 + &
+ ( y_target - ystore(iglob) )**2
+
+ ! keep this point if it is closer to the receiver
+ if(dist < distmin) then
+ distmin = dist
+ iface_selected = iface
+ iselected = i
+ jselected = j
+ ! elevation (given in z - coordinate)
+ target_elevation = zstore(iglob)
+ located_target = .true.
+ endif
+ enddo
+ enddo
+ end do
+
+ ! if we have not located a target element, the point is not in this slice
+ ! therefore use first element only for fictitious iterative search
+ if(.not. located_target) then
+ iselected = 2
+ jselected = 2
+ iface_selected = 1
+ endif
+
+ ! weighted mean at current point of topography elevation of the four closest nodes
+ ! set distance to huge initial value
+ distmin = HUGEVAL
+ do j=jselected,jselected+1
+ do i=iselected,iselected+1
+ ! distances to target
+ dist_node(:) = HUGEVAL
+ inode = 0
+ do jadjust=0,1
+ do iadjust= 0,1
+ ispec = free_surface_ispec(iface_selected)
+ igll = free_surface_ijk(1,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
+ jgll = free_surface_ijk(2,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
+ kgll = free_surface_ijk(3,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
+ iglob = ibool(igll,jgll,kgll,ispec)
+
+ ! stores node infos
+ inode = inode + 1
+ elevation_node(inode) = zstore(iglob)
+ dist_node(inode) = sqrt( (x_target - xstore(iglob))**2 + (y_target - ystore(iglob))**2 )
+ end do
+ end do
+
+ ! weighted elevation
+ dist = sum( dist_node(:) )
+ if(dist < distmin) then
+
+ ! sets new minimum distance (of all 4 closest nodes)
+ distmin = dist
+ target_distmin = distmin
+
+ ! interpolates elevation
+ if( dist > TINYVAL ) then
+ target_elevation = (dist_node(1)/dist)*elevation_node(1) + &
+ (dist_node(2)/dist)*elevation_node(2) + &
+ (dist_node(3)/dist)*elevation_node(3) + &
+ (dist_node(4)/dist)*elevation_node(4)
+ else
+ stop 'error summed distance to node is zero'
+ endif
+ endif
+
+ end do
+ end do
+
+ end if
+
+ end subroutine get_topo_elevation_free
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine get_topo_elevation_free_closest(x_target,y_target,target_elevation,target_distmin, &
+ NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore, &
+ num_free_surface_faces,free_surface_ispec,free_surface_ijk)
+
+! get approximate topography elevation at long/lat coordinates from closest point
+
+ implicit none
+
+ include "constants.h"
+
+ real(kind=CUSTOM_REAL),intent(in) :: x_target,y_target
+
+ real(kind=CUSTOM_REAL),intent(out) :: target_elevation
+ real(kind=CUSTOM_REAL),intent(out) :: target_distmin
+
+ integer :: NSPEC_AB,NGLOB_AB
+
+ integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
+
+ ! arrays containing coordinates of the points
+ real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: xstore,ystore,zstore
+
+ ! free surface
+ integer :: num_free_surface_faces
+ integer, dimension(num_free_surface_faces) :: free_surface_ispec
+ integer, dimension(3,NGLLSQUARE,num_free_surface_faces) :: free_surface_ijk
+
+ ! local parameters
+ real(kind=CUSTOM_REAL) :: distmin,dist
+
+ integer :: iface,i,ispec,iglob,igll,jgll,kgll
+
+ ! faster element search
+ logical,parameter :: USE_DISTANCE_CRITERION = .true.
+ integer,parameter :: MIDX = (NGLLX+1)/2
+ integer,parameter :: MIDY = (NGLLY+1)/2
+ integer,parameter :: MIDZ = (NGLLZ+1)/2
+
+ real(kind=CUSTOM_REAL) :: typical_size
+ logical :: located_target
+
+ ! initialize
+ target_elevation = 0.0_CUSTOM_REAL
+ target_distmin = HUGEVAL
+
+
+ if(num_free_surface_faces > 0) then
+
+ ! computes typical size of elements at the surface (uses first element for estimation)
+ if( USE_DISTANCE_CRITERION ) then
+ ispec = free_surface_ispec(1)
+ typical_size = (xstore(ibool(1,1,1,ispec)) - xstore(ibool(NGLLX,NGLLY,NGLLZ,ispec)))**2 &
+ + (ystore(ibool(1,1,1,ispec)) - ystore(ibool(NGLLX,NGLLY,NGLLZ,ispec)))**2
+ ! use 10 times the distance as a criterion for point detection
+ typical_size = 10. * typical_size
+ endif
+
+ ! flag to check that we located at least one target element
+ located_target = .false.
+
+ ! set distance to huge initial value
+ distmin = HUGEVAL
+
+ ! loops over all free surface faces
+ do iface=1,num_free_surface_faces
+ ispec = free_surface_ispec(iface)
+
+ ! excludes elements that are too far from target
+ if( USE_DISTANCE_CRITERION ) then
+ iglob = ibool(MIDX,MIDY,MIDZ,ispec)
+ dist = (x_target - xstore(iglob))**2 + (y_target - ystore(iglob))**2
+ if( dist > typical_size ) cycle
+ endif
+
+ ! loop only on points inside the element
+ do i = 1,NGLLSQUARE
+ igll = free_surface_ijk(1,i,iface)
+ jgll = free_surface_ijk(2,i,iface)
+ kgll = free_surface_ijk(3,i,iface)
+
+ iglob = ibool(igll,jgll,kgll,ispec)
+
+ ! distance (squared) to target
+ dist = ( x_target - xstore(iglob) )**2 + &
+ ( y_target - ystore(iglob) )**2
+
+ ! keep this point if it is closer to the receiver
+ if(dist < distmin) then
+ distmin = dist
+
+ ! elevation (given in z - coordinate)
+ target_elevation = zstore(iglob)
+ target_distmin = dist
+ located_target = .true.
+ endif
+ enddo
+ end do
+
+ ! if we have not located a target element, the point is not in this slice
+ ! therefore use first element only for fictitious iterative search
+ if(.not. located_target) then
+ !stop 'error: point was not located in get_elevation_closest()'
+ ! takes first point for estimation
+ iglob = ibool(1,1,1,ispec)
+ ! elevation (given in z - coordinate)
+ target_elevation = zstore(iglob)
+ target_distmin = ( x_target - xstore(iglob) )**2 + ( y_target - ystore(iglob) )**2
+ located_target = .true.
+ endif
+
+ end if
+
+ end subroutine get_topo_elevation_free_closest
+
\ No newline at end of file
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/serial.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/serial.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/serial.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -93,6 +93,20 @@
!----
!
+ subroutine bcast_all_r(buffer, count)
+
+ implicit none
+
+ integer count
+ real, dimension(count) :: buffer
+
+ end subroutine bcast_all_r
+
+
+!
+!----
+!
+
subroutine gather_all_i(sendbuf, sendcnt, recvbuf, recvcount, NPROC)
implicit none
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/smooth_vol_data.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/smooth_vol_data.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/smooth_vol_data.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -138,7 +138,7 @@
logical :: ACOUSTIC_SIMULATION,ELASTIC_SIMULATION,POROELASTIC_SIMULATION
integer :: idummy_a
integer :: myrank,sizeprocs
-
+ integer :: IMODEL
!------------------
! initialize the MPI communicator and start the NPROCTOT MPI processes
@@ -219,7 +219,7 @@
NTSTEP_BETWEEN_FRAMES,USE_HIGHRES_FOR_MOVIES,HDUR_MOVIE, &
SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION, &
NTSTEP_BETWEEN_OUTPUT_INFO,SIMULATION_TYPE,SAVE_FORWARD, &
- NTSTEP_BETWEEN_READ_ADJSRC,NOISE_TOMOGRAPHY)
+ NTSTEP_BETWEEN_READ_ADJSRC,NOISE_TOMOGRAPHY,IMODEL)
! checks if number of MPI process as specified
if (sizeprocs /= NPROC) then
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_poroelastic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_poroelastic.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_poroelastic.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -228,12 +228,19 @@
! adjoint simulations
if (SIMULATION_TYPE == 2 .or. SIMULATION_TYPE == 3) then
- stop 'adjoint poroelastic simulation not implemented yet'
+ stop 'adjoint poroelastic simulation not implemented yet'
endif !adjoint
! adjoint simulations
if (SIMULATION_TYPE == 3) then
- stop 'adjoint poroelastic simulation not implemented yet'
+ stop 'adjoint poroelastic simulation not implemented yet'
+
+ ! to avoid compiler warning
+ i = NGLOB_ADJOINT
+ i = adj_sourcearrays(1,1,1,1,1,1)
+ i = islice_selected_rec(1)
+ i = ispec_selected_rec(1)
+
endif ! adjoint
! master prints out source time function to file
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_elastic_po.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_elastic_po.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_elastic_po.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -222,6 +222,13 @@
tempz1lw = tempz1lw + displw_poroelastic(3,iglob)*hp1
! adjoint simulations
if (SIMULATION_TYPE == 3) then
+ ! to do
+ stop 'compute_coupling_elastic_po() : adjoint run not implemented yet'
+
+ ! dummy to avoid compiler warnings
+ iglob = NGLOB_ADJOINT
+ iglob = NSPEC_ADJOINT
+
endif ! adjoint
!!! can merge these loops because NGLLX = NGLLY = NGLLZ enddo
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_poroelastic_el.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_poroelastic_el.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_poroelastic_el.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -358,7 +358,14 @@
tempz1lw = tempz1lw + displw_poroelastic(3,iglob)*hp1
! adjoint simulations
if (SIMULATION_TYPE == 3) then
+ ! to do
+ stop 'compute_coupling_poroelastic_el() : adjoint run not implemented yet'
+
+ ! dummy to avoid compiler warnings
+ iglob = NGLOB_ADJOINT
+ iglob = NSPEC_ADJOINT
endif ! adjoint
+
!!! can merge these loops because NGLLX = NGLLY = NGLLZ enddo
!!! can merge these loops because NGLLX = NGLLY = NGLLZ do
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_fluid.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_fluid.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_fluid.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -225,7 +225,13 @@
tempz3lw = 0.
if (SIMULATION_TYPE == 3) then
+ ! to do
+ stop 'compute_forces_fluid() : adjoint run not implemented yet'
+ ! to avoid compiler warning
+ l = NGLOB_ADJOINT
+ l = NSPEC_ADJOINT
endif
+
! first double loop over GLL points to compute and store gradients
do l = 1,NGLLX
hp1 = hprime_xx(i,l)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_poroelastic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_poroelastic.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_poroelastic.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -396,9 +396,14 @@
velocw_poroelastic(2,iglob) = 0.d0
velocw_poroelastic(3,iglob) = 0.d0
- if(SIMULATION_TYPE == 3) then
-! to do
- endif
+ if(SIMULATION_TYPE == 3) then
+ ! to do
+ stop 'compute_continuity_disp_po_el() : adjoint run not implemented yet'
+
+ ! dummy to avoid compiler warnings
+ i = NGLOB_ADJOINT
+ j = NSPEC_ADJOINT
+ endif
endif !if(icount(iglob) ==1)
enddo ! igll
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_solid.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_solid.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_solid.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -225,6 +225,11 @@
tempz3lw = 0.
if (SIMULATION_TYPE == 3) then
+ ! to do
+ stop 'compute_forces_solid() : adjoint run not implemented yet'
+ ! to avoid compiler warning
+ l = NGLOB_ADJOINT
+ l = NSPEC_ADJOINT
endif
! first double loop over GLL points to compute and store gradients
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -46,7 +46,7 @@
NTSTEP_BETWEEN_FRAMES,USE_HIGHRES_FOR_MOVIES,HDUR_MOVIE, &
SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION, &
NTSTEP_BETWEEN_OUTPUT_INFO,SIMULATION_TYPE,SAVE_FORWARD, &
- NTSTEP_BETWEEN_READ_ADJSRC,NOISE_TOMOGRAPHY)
+ NTSTEP_BETWEEN_READ_ADJSRC,NOISE_TOMOGRAPHY,IMODEL)
! get the base pathname for output files
call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', OUTPUT_FILES_PATH(1:len_trim(OUTPUT_FILES_PATH)))
@@ -93,6 +93,27 @@
write(IMAIN,*) 'smallest and largest possible floating-point numbers are: ',&
tiny(1._CUSTOM_REAL),huge(1._CUSTOM_REAL)
write(IMAIN,*)
+ write(IMAIN,'(a)',advance='no') ' velocity model: '
+ select case(IMODEL)
+ case( IMODEL_DEFAULT )
+ write(IMAIN,'(a)',advance='yes') ' default '
+ case( IMODEL_GLL )
+ write(IMAIN,'(a)',advance='yes') ' gll'
+ case( IMODEL_1D_PREM )
+ write(IMAIN,'(a)',advance='yes') ' 1d_prem'
+ case( IMODEL_1D_CASCADIA )
+ write(IMAIN,'(a)',advance='yes') ' 1d_cascadia'
+ case( IMODEL_1D_SOCAL )
+ write(IMAIN,'(a)',advance='yes') ' 1d_socal'
+ case( IMODEL_SALTON_TROUGH )
+ write(IMAIN,'(a)',advance='yes') ' salton_trough'
+ case( IMODEL_TOMO )
+ write(IMAIN,'(a)',advance='yes') ' tomo'
+ case( IMODEL_USER_EXTERNAL )
+ write(IMAIN,'(a)',advance='yes') ' external'
+ end select
+
+ write(IMAIN,*)
endif
! reads in numbers of spectral elements and points for this process' domain
@@ -191,8 +212,10 @@
if( myrank == 0 ) then
write(IMAIN,*) 'error: number of processors supposed to run on: ',NPROC
write(IMAIN,*) 'error: number of MPI processors actually run on: ',sizeprocs
- print*, 'error: number of processors supposed to run on: ',NPROC
- print*, 'error: number of MPI processors actually run on: ',sizeprocs
+ print*
+ print*, 'error specfem3D: number of processors supposed to run on: ',NPROC
+ print*, 'error specfem3D: number of MPI processors actually run on: ',sizeprocs
+ print*
endif
call exit_MPI(myrank,'wrong number of MPI processes')
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_receivers.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_receivers.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_receivers.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -86,12 +86,17 @@
integer ios
double precision,dimension(1) :: altitude_rec,distmin_ele
- double precision,dimension(4) :: elevation_node,dist_node
+ !double precision,dimension(4) :: elevation_node,dist_node
double precision,dimension(NPROC) :: distmin_ele_all,elevation_all
+
+ real(kind=CUSTOM_REAL) :: xloc,yloc,loc_ele,loc_distmin
+
double precision, allocatable, dimension(:) :: x_target,y_target,z_target
+
double precision, allocatable, dimension(:) :: horiz_dist
double precision, allocatable, dimension(:) :: x_found,y_found,z_found
double precision dist
+
double precision xi,eta,gamma,dx,dy,dz,dxi,deta,dgamma
double precision x,y,z
double precision xix,xiy,xiz
@@ -102,8 +107,11 @@
double precision xelm(NGNOD),yelm(NGNOD),zelm(NGNOD)
integer irec
- integer i,j,k,ispec,iglob,iface,inode,imin,imax,jmin,jmax,kmin,kmax,igll,jgll,kgll
- integer iselected,jselected,iface_selected,iadjust,jadjust
+ integer i,j,k,ispec,iglob
+ integer imin,imax,jmin,jmax,kmin,kmax
+ !integer iface,inode,igll,jgll,kgll
+
+! integer iselected,jselected,iface_selected,iadjust,jadjust
integer iproc(1)
! topology of the control points of the surface element
@@ -123,7 +131,7 @@
! receiver information
! station information for writing the seismograms
- integer :: iglob_selected
+! integer :: iglob_selected
double precision, allocatable, dimension(:) :: stlat,stlon,stele,stbur,stutm_x,stutm_y,elevation
double precision, allocatable, dimension(:) :: x_found_all,y_found_all,z_found_all
double precision, dimension(:), allocatable :: final_distance_all
@@ -210,10 +218,13 @@
! write the locations of stations, so that we can load them and write them to SU headers later
open(unit=IOUT_SU,file=trim(OUTPUT_FILES)//'/output_list_stations.txt', &
status='unknown',action='write',iostat=ios)
- if( ios /= 0 ) call exit_mpi(myrank,'error opening file '//trim(OUTPUT_FILES)//'/output_list_stations.txt')
+ if( ios /= 0 ) &
+ call exit_mpi(myrank,'error opening file '//trim(OUTPUT_FILES)//'/output_list_stations.txt')
+
do irec=1,nrec
write(IOUT_SU,*) x_found(irec),y_found(irec),z_found(irec)
enddo
+
close(IOUT_SU)
deallocate(x_found,y_found,z_found)
endif
@@ -273,7 +284,9 @@
! loop on all the stations
do irec=1,nrec
- read(1,*,iostat=ios) station_name(irec),network_name(irec),stlat(irec),stlon(irec),stele(irec),stbur(irec)
+ read(1,*,iostat=ios) station_name(irec),network_name(irec), &
+ stlat(irec),stlon(irec),stele(irec),stbur(irec)
+
if (ios /= 0) call exit_mpi(myrank, 'Error reading station file '//trim(rec_filename))
! convert station location to UTM
@@ -281,7 +294,8 @@
UTM_PROJECTION_ZONE,ILONGLAT2UTM,SUPPRESS_UTM_PROJECTION)
! compute horizontal distance between source and receiver in km
- horiz_dist(irec) = dsqrt((stutm_y(irec)-utm_y_source)**2 + (stutm_x(irec)-utm_x_source)**2) / 1000.
+ horiz_dist(irec) = dsqrt((stutm_y(irec)-utm_y_source)**2 &
+ + (stutm_x(irec)-utm_x_source)**2) / 1000.d0
! print some information about stations
if(myrank == 0) then
@@ -294,79 +308,88 @@
endif
! get approximate topography elevation at source long/lat coordinates
- ! set distance to huge initial value
- distmin = HUGEVAL
- if(num_free_surface_faces > 0) then
- iglob_selected = 1
- ! loop only on points inside the element
- ! exclude edges to ensure this point is not shared with other elements
- imin = 2
- imax = NGLLX - 1
- jmin = 2
- jmax = NGLLY - 1
- iselected = 0
- jselected = 0
- iface_selected = 0
- do iface=1,num_free_surface_faces
- do j=jmin,jmax
- do i=imin,imax
-
- ispec = free_surface_ispec(iface)
- igll = free_surface_ijk(1,(j-1)*NGLLY+i,iface)
- jgll = free_surface_ijk(2,(j-1)*NGLLY+i,iface)
- kgll = free_surface_ijk(3,(j-1)*NGLLY+i,iface)
- iglob = ibool(igll,jgll,kgll,ispec)
-
- ! keep this point if it is closer to the receiver
- dist = (stutm_x(irec)-dble(xstore(iglob)))**2 + &
- (stutm_y(irec)-dble(ystore(iglob)))**2
- if(dist < distmin) then
- distmin = dist
- iglob_selected = iglob
- iface_selected = iface
- iselected = i
- jselected = j
- altitude_rec(1) = zstore(iglob_selected)
- endif
- enddo
- enddo
- ! end of loop on all the elements on the free surface
- end do
- ! weighted mean at current point of topography elevation of the four closest nodes
- ! set distance to huge initial value
- distmin = HUGEVAL
- do j=jselected,jselected+1
- do i=iselected,iselected+1
- inode = 1
- do jadjust=0,1
- do iadjust= 0,1
- ispec = free_surface_ispec(iface_selected)
- igll = free_surface_ijk(1,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
- jgll = free_surface_ijk(2,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
- kgll = free_surface_ijk(3,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
- iglob = ibool(igll,jgll,kgll,ispec)
-
- elevation_node(inode) = zstore(iglob)
- dist_node(inode) = dsqrt((stutm_x(irec)-dble(xstore(iglob)))**2 + &
- (stutm_y(irec)-dble(ystore(iglob)))**2)
- inode = inode + 1
- end do
- end do
- dist = sum(dist_node)
- if(dist < distmin) then
- distmin = dist
- altitude_rec(1) = (dist_node(1)/dist)*elevation_node(1) + &
- (dist_node(2)/dist)*elevation_node(2) + &
- (dist_node(3)/dist)*elevation_node(3) + &
- (dist_node(4)/dist)*elevation_node(4)
- endif
- end do
- end do
- end if
+ xloc = stutm_x(irec)
+ yloc = stutm_y(irec)
+ call get_topo_elevation_free(xloc,yloc,loc_ele,loc_distmin, &
+ NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore, &
+ num_free_surface_faces,free_surface_ispec,free_surface_ijk)
+ altitude_rec(1) = loc_ele
+ distmin_ele(1) = loc_distmin
+
+! ! set distance to huge initial value
+! distmin = HUGEVAL
+! if(num_free_surface_faces > 0) then
+! iglob_selected = 1
+! ! loop only on points inside the element
+! ! exclude edges to ensure this point is not shared with other elements
+! imin = 2
+! imax = NGLLX - 1
+! jmin = 2
+! jmax = NGLLY - 1
+! iselected = 0
+! jselected = 0
+! iface_selected = 0
+! do iface=1,num_free_surface_faces
+! do j=jmin,jmax
+! do i=imin,imax
+!
+! ispec = free_surface_ispec(iface)
+! igll = free_surface_ijk(1,(j-1)*NGLLY+i,iface)
+! jgll = free_surface_ijk(2,(j-1)*NGLLY+i,iface)
+! kgll = free_surface_ijk(3,(j-1)*NGLLY+i,iface)
+! iglob = ibool(igll,jgll,kgll,ispec)
+!
+! ! keep this point if it is closer to the receiver
+! dist = (stutm_x(irec)-dble(xstore(iglob)))**2 + &
+! (stutm_y(irec)-dble(ystore(iglob)))**2
+! if(dist < distmin) then
+! distmin = dist
+! iglob_selected = iglob
+! iface_selected = iface
+! iselected = i
+! jselected = j
+! altitude_rec(1) = zstore(iglob_selected)
+! endif
+! enddo
+! enddo
+! ! end of loop on all the elements on the free surface
+! end do
+! ! weighted mean at current point of topography elevation of the four closest nodes
+! ! set distance to huge initial value
+! distmin = HUGEVAL
+! do j=jselected,jselected+1
+! do i=iselected,iselected+1
+! inode = 1
+! do jadjust=0,1
+! do iadjust= 0,1
+! ispec = free_surface_ispec(iface_selected)
+! igll = free_surface_ijk(1,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
+! jgll = free_surface_ijk(2,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
+! kgll = free_surface_ijk(3,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
+! iglob = ibool(igll,jgll,kgll,ispec)
+!
+! elevation_node(inode) = zstore(iglob)
+! dist_node(inode) = dsqrt((stutm_x(irec)-dble(xstore(iglob)))**2 + &
+! (stutm_y(irec)-dble(ystore(iglob)))**2)
+! inode = inode + 1
+! end do
+! end do
+! dist = sum(dist_node)
+! if(dist < distmin) then
+! distmin = dist
+! altitude_rec(1) = (dist_node(1)/dist)*elevation_node(1) + &
+! (dist_node(2)/dist)*elevation_node(2) + &
+! (dist_node(3)/dist)*elevation_node(3) + &
+! (dist_node(4)/dist)*elevation_node(4)
+! endif
+! end do
+! end do
+! end if
+
! MPI communications to determine the best slice
- distmin_ele(1)= distmin
call gather_all_dp(distmin_ele,1,distmin_ele_all,1,NPROC)
call gather_all_dp(altitude_rec,1,elevation_all,1,NPROC)
+
if(myrank == 0) then
iproc = minloc(distmin_ele_all)
altitude_rec(1) = elevation_all(iproc(1))
@@ -374,8 +397,6 @@
call bcast_all_dp(altitude_rec,1)
elevation(irec) = altitude_rec(1)
- ! reset distance to huge initial value
- distmin=HUGEVAL
! get the Cartesian components of n in the model: nu
@@ -406,6 +427,9 @@
endif
!if (myrank == 0) write(IOVTK,*) x_target(irec), y_target(irec), z_target(irec)
+ ! reset distance to huge initial value
+ distmin=HUGEVAL
+
if (.not. SU_FORMAT) then
! determines closest GLL point
ispec_selected_rec(irec) = 0
@@ -495,7 +519,8 @@
(y_target(irec)>=ymin_ELE .and. y_target(irec)<=ymax_ELE) .and. &
(z_target(irec)>=zmin_ELE .and. z_target(irec)<=zmax_ELE) ) then
! we find the element (ispec) which "may" contain the receiver (irec)
- ! so we only need to compute distances (which is expensive because of "dsqrt") within those elements
+ ! so we only need to compute distances
+ !(which is expensive because of "dsqrt") within those elements
ispec_selected_rec(irec) = ispec
do k = kmin_temp,kmax_temp
do j = jmin_temp,jmax_temp
@@ -899,28 +924,30 @@
write(IMAIN,*) ' closest estimate found: ',sngl(final_distance(irec)),' m away'
write(IMAIN,*) ' in slice ',islice_selected_rec(irec),' in element ',ispec_selected_rec(irec)
if(FASTER_RECEIVERS_POINTS_ONLY) then
- write(IMAIN,*) ' in point i,j,k = ',nint(xi_receiver(irec)),nint(eta_receiver(irec)),nint(gamma_receiver(irec))
+ write(IMAIN,*) ' in point i,j,k = ',nint(xi_receiver(irec)), &
+ nint(eta_receiver(irec)), &
+ nint(gamma_receiver(irec))
write(IMAIN,*) ' nu1 = ',nu(1,:,irec)
write(IMAIN,*) ' nu2 = ',nu(2,:,irec)
write(IMAIN,*) ' nu3 = ',nu(3,:,irec)
else
write(IMAIN,*) ' at coordinates: '
- write(IMAIN,*) ' xi = ',xi_receiver(irec)
- write(IMAIN,*) ' eta = ',eta_receiver(irec)
- write(IMAIN,*) ' gamma = ',gamma_receiver(irec)
+ write(IMAIN,*) ' xi = ',xi_receiver(irec)
+ write(IMAIN,*) ' eta = ',eta_receiver(irec)
+ write(IMAIN,*) ' gamma = ',gamma_receiver(irec)
endif
if( SUPPRESS_UTM_PROJECTION ) then
- write(IMAIN,*) ' x: ',x_found(irec)
- write(IMAIN,*) ' y: ',y_found(irec)
+ write(IMAIN,*) ' x: ',x_found(irec)
+ write(IMAIN,*) ' y: ',y_found(irec)
else
write(IMAIN,*) ' UTM x: ',x_found(irec)
write(IMAIN,*) ' UTM y: ',y_found(irec)
endif
if( USE_SOURCES_RECVS_Z ) then
- write(IMAIN,*) ' z: ',z_found(irec)
+ write(IMAIN,*) ' z: ',z_found(irec)
else
write(IMAIN,*) ' depth: ',dabs(z_found(irec) - elevation(irec)),' m'
- write(IMAIN,*) ' z: ',z_found(irec)
+ write(IMAIN,*) ' z: ',z_found(irec)
endif
write(IMAIN,*)
@@ -965,10 +992,13 @@
! write the locations of stations, so that we can load them and write them to SU headers later
open(unit=IOUT_SU,file=trim(OUTPUT_FILES)//'/output_list_stations.txt', &
status='unknown',action='write',iostat=ios)
- if( ios /= 0 ) call exit_mpi(myrank,'error opening file '//trim(OUTPUT_FILES)//'/output_list_stations.txt')
+ if( ios /= 0 ) &
+ call exit_mpi(myrank,'error opening file '//trim(OUTPUT_FILES)//'/output_list_stations.txt')
+
do irec=1,nrec
write(IOUT_SU,*) x_found(irec),y_found(irec),z_found(irec)
enddo
+
close(IOUT_SU)
! stores station infos for later runs
@@ -1032,12 +1062,14 @@
end subroutine locate_receivers
-!=====================================================================
+!
+!-------------------------------------------------------------------------------------------------
+!
+ subroutine station_filter(SUPPRESS_UTM_PROJECTION,UTM_PROJECTION_ZONE, &
+ myrank,filename,filtered_filename,nfilter, &
+ LATITUDE_MIN, LATITUDE_MAX, LONGITUDE_MIN, LONGITUDE_MAX)
- subroutine station_filter(SUPPRESS_UTM_PROJECTION,UTM_PROJECTION_ZONE,myrank,filename,filtered_filename,nfilter, &
- LATITUDE_MIN, LATITUDE_MAX, LONGITUDE_MIN, LONGITUDE_MAX)
-
implicit none
include 'constants.h'
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_source.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_source.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_source.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -67,9 +67,10 @@
integer iprocloop
- integer i,j,k,ispec,iglob,iglob_selected,inode,iface,isource
- integer imin,imax,jmin,jmax,kmin,kmax,igll,jgll,kgll
- integer iselected,jselected,iface_selected,iadjust,jadjust
+ integer i,j,k,ispec,iglob,isource
+ integer imin,imax,jmin,jmax,kmin,kmax
+! integer igll,jgll,kgll,inode,iface,iglob_selected,
+! integer iselected,jselected,iface_selected,iadjust,jadjust
integer iproc(1)
double precision, dimension(NSOURCES) :: utm_x_source,utm_y_source
@@ -102,9 +103,13 @@
double precision x_target_source,y_target_source,z_target_source
double precision,dimension(1) :: altitude_source,distmin_ele
+
double precision,dimension(NPROC) :: distmin_ele_all,elevation_all
- double precision,dimension(4) :: elevation_node,dist_node
+! double precision,dimension(4) :: elevation_node,dist_node
+ real(kind=CUSTOM_REAL) :: xloc,yloc,loc_ele,loc_distmin
+
+
integer islice_selected_source(NSOURCES)
! timer MPI
@@ -208,81 +213,93 @@
UTM_PROJECTION_ZONE,ILONGLAT2UTM,SUPPRESS_UTM_PROJECTION)
! get approximate topography elevation at source long/lat coordinates
- ! set distance to huge initial value
- distmin = HUGEVAL
- if(num_free_surface_faces > 0) then
- iglob_selected = 1
- ! loop only on points inside the element
- ! exclude edges to ensure this point is not shared with other elements
- imin = 2
- imax = NGLLX - 1
+ xloc = utm_x_source(isource)
+ yloc = utm_y_source(isource)
+ call get_topo_elevation_free(xloc,yloc,loc_ele,loc_distmin, &
+ NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore, &
+ num_free_surface_faces,free_surface_ispec,free_surface_ijk)
+ altitude_source(1) = loc_ele
+ distmin_ele(1) = loc_distmin
+
- jmin = 2
- jmax = NGLLY - 1
-
- iselected = 0
- jselected = 0
- iface_selected = 0
- do iface=1,num_free_surface_faces
- do j=jmin,jmax
- do i=imin,imax
-
- ispec = free_surface_ispec(iface)
- igll = free_surface_ijk(1,(j-1)*NGLLY+i,iface)
- jgll = free_surface_ijk(2,(j-1)*NGLLY+i,iface)
- kgll = free_surface_ijk(3,(j-1)*NGLLY+i,iface)
- iglob = ibool(igll,jgll,kgll,ispec)
-
- ! keep this point if it is closer to the receiver
- dist = dsqrt((utm_x_source(isource)-dble(xstore(iglob)))**2 + &
- (utm_y_source(isource)-dble(ystore(iglob)))**2)
- if(dist < distmin) then
- distmin = dist
- iglob_selected = iglob
- iface_selected = iface
- iselected = i
- jselected = j
- altitude_source(1) = zstore(iglob_selected)
- endif
- enddo
- enddo
- ! end of loop on all the elements on the free surface
- end do
- ! weighted mean at current point of topography elevation of the four closest nodes
- ! set distance to huge initial value
- distmin = HUGEVAL
- do j=jselected,jselected+1
- do i=iselected,iselected+1
- inode = 1
- do jadjust=0,1
- do iadjust= 0,1
- ispec = free_surface_ispec(iface_selected)
- igll = free_surface_ijk(1,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
- jgll = free_surface_ijk(2,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
- kgll = free_surface_ijk(3,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
- iglob = ibool(igll,jgll,kgll,ispec)
-
- elevation_node(inode) = zstore(iglob)
- dist_node(inode) = dsqrt((utm_x_source(isource)-dble(xstore(iglob)))**2 + &
- (utm_y_source(isource)-dble(ystore(iglob)))**2)
- inode = inode + 1
- end do
- end do
- dist = sum(dist_node)
- if(dist < distmin) then
- distmin = dist
- altitude_source(1) = (dist_node(1)/dist)*elevation_node(1) + &
- (dist_node(2)/dist)*elevation_node(2) + &
- (dist_node(3)/dist)*elevation_node(3) + &
- (dist_node(4)/dist)*elevation_node(4)
- endif
- end do
- end do
- end if
+
+! ! set distance to huge initial value
+! distmin = HUGEVAL
+! if(num_free_surface_faces > 0) then
+! iglob_selected = 1
+! ! loop only on points inside the element
+! ! exclude edges to ensure this point is not shared with other elements
+! imin = 2
+! imax = NGLLX - 1
+!
+! jmin = 2
+! jmax = NGLLY - 1
+!
+! iselected = 0
+! jselected = 0
+! iface_selected = 0
+! do iface=1,num_free_surface_faces
+! do j=jmin,jmax
+! do i=imin,imax
+!
+! ispec = free_surface_ispec(iface)
+! igll = free_surface_ijk(1,(j-1)*NGLLY+i,iface)
+! jgll = free_surface_ijk(2,(j-1)*NGLLY+i,iface)
+! kgll = free_surface_ijk(3,(j-1)*NGLLY+i,iface)
+! iglob = ibool(igll,jgll,kgll,ispec)
+!
+! ! keep this point if it is closer to the receiver
+! dist = dsqrt((utm_x_source(isource)-dble(xstore(iglob)))**2 + &
+! (utm_y_source(isource)-dble(ystore(iglob)))**2)
+! if(dist < distmin) then
+! distmin = dist
+! iglob_selected = iglob
+! iface_selected = iface
+! iselected = i
+! jselected = j
+! altitude_source(1) = zstore(iglob_selected)
+! endif
+! enddo
+! enddo
+! ! end of loop on all the elements on the free surface
+! end do
+! ! weighted mean at current point of topography elevation of the four closest nodes
+! ! set distance to huge initial value
+! distmin = HUGEVAL
+! do j=jselected,jselected+1
+! do i=iselected,iselected+1
+! inode = 1
+! do jadjust=0,1
+! do iadjust= 0,1
+! ispec = free_surface_ispec(iface_selected)
+! igll = free_surface_ijk(1,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
+! jgll = free_surface_ijk(2,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
+! kgll = free_surface_ijk(3,(j-jadjust-1)*NGLLY+i-iadjust,iface_selected)
+! iglob = ibool(igll,jgll,kgll,ispec)
+!
+! elevation_node(inode) = zstore(iglob)
+! dist_node(inode) = dsqrt((utm_x_source(isource)-dble(xstore(iglob)))**2 + &
+! (utm_y_source(isource)-dble(ystore(iglob)))**2)
+! inode = inode + 1
+! end do
+! end do
+! dist = sum(dist_node)
+! if(dist < distmin) then
+! distmin = dist
+! altitude_source(1) = (dist_node(1)/dist)*elevation_node(1) + &
+! (dist_node(2)/dist)*elevation_node(2) + &
+! (dist_node(3)/dist)*elevation_node(3) + &
+! (dist_node(4)/dist)*elevation_node(4)
+! endif
+! end do
+! end do
+! end if
+! distmin_ele(1)= distmin
+
! MPI communications to determine the best slice
- distmin_ele(1)= distmin
call gather_all_dp(distmin_ele,1,distmin_ele_all,1,NPROC)
call gather_all_dp(altitude_source,1,elevation_all,1,NPROC)
+
if(myrank == 0) then
iproc = minloc(distmin_ele_all)
altitude_source(1) = elevation_all(iproc(1))
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -210,6 +210,10 @@
write(IMAIN,*) 'total simulated time: ',sngl(NSTEP*DT),' seconds'
write(IMAIN,*) 'start time:',sngl(-t0),' seconds'
write(IMAIN,*)
+
+ !debug: time estimation
+ ! elastic elements: time per element t_per_element = 1.40789368e-05 s
+ ! total time = nspec * nstep * t_per_element
endif
! prepares ADJOINT simulations
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -466,7 +466,8 @@
call check_mesh_resolution_poro(myrank,NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore, &
rho_vp,rho_vs, &
DT,model_speed_max,min_resolved_period, &
- phistore,tortstore,rhoarraystore,rho_vpI,rho_vpII,rho_vsI)
+ phistore,tortstore,rhoarraystore,rho_vpI,rho_vpII,rho_vsI, &
+ LOCAL_PATH,SAVE_MESH_FILES)
deallocate(rho_vp,rho_vs)
else if( ACOUSTIC_SIMULATION ) then
allocate(rho_vp(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_topography_bathymetry.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_topography_bathymetry.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_topography_bathymetry.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -26,41 +26,39 @@
!
! United States and French Government Sponsorship Acknowledged.
- subroutine read_topography_bathymetry()
- use specfem_par
- implicit none
- integer :: ier
+! obsolete...
-! read topography and bathymetry file
-
- if( OCEANS .and. TOPOGRAPHY ) then
-
- NX_TOPO = NX_TOPO_SOCAL
- NY_TOPO = NY_TOPO_SOCAL
- ORIG_LAT_TOPO = ORIG_LAT_TOPO_SOCAL
- ORIG_LONG_TOPO = ORIG_LONG_TOPO_SOCAL
- DEGREES_PER_CELL_TOPO = DEGREES_PER_CELL_TOPO_SOCAL
- topo_file = TOPO_FILE_SOCAL
-
- allocate(itopo_bathy(NX_TOPO,NY_TOPO),stat=ier)
- if( ier /= 0 ) stop 'error allocating array itopo_bathy'
-
- call read_topo_bathy_file(itopo_bathy,NX_TOPO,NY_TOPO,topo_file)
-
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) 'regional topography file read ranges in m from ', &
- minval(itopo_bathy),' to ',maxval(itopo_bathy)
- write(IMAIN,*)
- endif
-
- else
- NX_TOPO = 1
- NY_TOPO = 1
- allocate(itopo_bathy(NX_TOPO,NY_TOPO),stat=ier)
- if( ier /= 0 ) stop 'error allocating dummy array itopo_bathy'
-
- endif
-
- end subroutine read_topography_bathymetry
+! subroutine read_topography_bathymetry()
+!
+! use specfem_par
+! implicit none
+! integer :: ier
+!
+!! read topography and bathymetry file
+!
+! if( OCEANS .and. TOPOGRAPHY ) then
+!
+! NX_TOPO = NX_TOPO_FILE
+! NY_TOPO = NY_TOPO_FILE
+! allocate(itopo_bathy(NX_TOPO,NY_TOPO),stat=ier)
+! if( ier /= 0 ) stop 'error allocating array itopo_bathy'
+!
+! call read_topo_bathy_file(itopo_bathy,NX_TOPO,NY_TOPO)
+!
+! if(myrank == 0) then
+! write(IMAIN,*)
+! write(IMAIN,*) 'regional topography file read ranges in m from ', &
+! minval(itopo_bathy),' to ',maxval(itopo_bathy)
+! write(IMAIN,*)
+! endif
+!
+! else
+! NX_TOPO = 1
+! NY_TOPO = 1
+! allocate(itopo_bathy(NX_TOPO,NY_TOPO),stat=ier)
+! if( ier /= 0 ) stop 'error allocating dummy array itopo_bathy'
+!
+! endif
+!
+! end subroutine read_topography_bathymetry
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/save_external_bin_m_up.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/save_external_bin_m_up.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/save_external_bin_m_up.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -400,7 +400,7 @@
v_tmp_i,filename)
endif
- !! saves 1. MPI interface
+ !debug: saves 1. MPI interface
! if( num_interfaces_ext_mesh >= 1 ) then
! filename = prname(1:len_trim(prname))//'MPI_1_points'
! call write_VTK_data_points(nglob, &
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -316,10 +316,6 @@
call detect_mesh_surfaces()
-! reads topography & bathymetry
- call read_topography_bathymetry()
-
-
! prepares sources and receivers
call setup_sources_receivers()
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D_par.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D_par.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/specfem3D_par.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -45,12 +45,6 @@
! attenuation
integer :: NSPEC_ATTENUATION_AB
-! use integer array to store topography values
- integer :: NX_TOPO,NY_TOPO
- double precision :: ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO
- character(len=100) :: topo_file
- integer, dimension(:,:), allocatable :: itopo_bathy
-
! absorbing boundary arrays (for all boundaries) - keeps all infos, allowing for irregular surfaces
real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: abs_boundary_normal
real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: abs_boundary_jacobian2Dw
@@ -147,7 +141,8 @@
integer :: NPROC_XI,NPROC_ETA
integer :: NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,UTM_PROJECTION_ZONE
integer :: SIMULATION_TYPE
-
+ integer :: IMODEL
+
double precision :: DT
double precision :: LATITUDE_MIN,LATITUDE_MAX,LONGITUDE_MIN,LONGITUDE_MAX
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_movie_output.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_movie_output.f90 2012-05-05 17:49:17 UTC (rev 20045)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_movie_output.f90 2012-05-07 11:03:03 UTC (rev 20046)
@@ -146,6 +146,7 @@
if (USE_HIGHRES_FOR_MOVIES) then
do ipoin = 1, NGLLX*NGLLY
iglob = faces_surface_ext_mesh(ipoin,ispec2D)
+
! saves norm of displacement,velocity and acceleration vector
if( ispec_is_elastic(ispec) ) then
! norm of displacement
@@ -165,7 +166,7 @@
! acoustic domains
if( ispec_is_acoustic(ispec) ) then
! sets velocity vector with maximum norm of wavefield values
- call wmo_get_max_vector(ispec,ispec2D,ipoin, &
+ call wmo_get_max_vector(ispec,ispec2D,iglob,ipoin, &
displ_element,veloc_element,accel_element, &
NGLLX*NGLLY)
endif
@@ -194,7 +195,7 @@
! acoustic domains
if( ispec_is_acoustic(ispec) ) then
! sets velocity vector with maximum norm of wavefield values
- call wmo_get_max_vector(ispec,ispec2D,ipoin, &
+ call wmo_get_max_vector(ispec,ispec2D,iglob,ipoin, &
displ_element,veloc_element,accel_element, &
NGNOD2D)
endif
@@ -266,7 +267,7 @@
!================================================================
- subroutine wmo_get_max_vector(ispec,ispec2D,ipoin, &
+ subroutine wmo_get_max_vector(ispec,ispec2D,iglob,ipoin, &
displ_element,veloc_element,accel_element, &
narraydim)
@@ -276,15 +277,17 @@
use specfem_par_movie
implicit none
- integer :: ispec,ispec2D,ipoin,narraydim
+ integer,intent(in) :: ispec,ispec2D,iglob,ipoin,narraydim
real(kind=CUSTOM_REAL),dimension(NDIM,NGLLX,NGLLY,NGLLZ) :: &
displ_element,veloc_element,accel_element
! local parameters
- integer :: i,j,k,iglob
+ integer :: i,j,k
logical :: is_done
is_done = .false.
+
+ ! loops over all gll points from this element
do k=1,NGLLZ
do j=1,NGLLY
do i=1,NGLLX
@@ -809,7 +812,7 @@
! acoustic domains
if( ispec_is_acoustic(ispec) ) then
! stores maximum values
- call wmo_get_max_vector_o(ispec,ipoin,displ_element,veloc_element,accel_element)
+ call wmo_get_max_vector_o(ispec,iglob,ipoin,displ_element,veloc_element,accel_element)
endif
enddo
@@ -847,7 +850,7 @@
! acoustic domains
if( ispec_is_acoustic(ispec) ) then
! stores maximum values
- call wmo_get_max_vector_o(ispec,ipoin,displ_element,veloc_element,accel_element)
+ call wmo_get_max_vector_o(ispec,iglob,ipoin,displ_element,veloc_element,accel_element)
endif
enddo
@@ -919,7 +922,7 @@
!================================================================
- subroutine wmo_get_max_vector_o(ispec,ipoin,displ_element,veloc_element,accel_element)
+ subroutine wmo_get_max_vector_o(ispec,iglob,ipoin,displ_element,veloc_element,accel_element)
! put into this separate routine to make compilation faster
@@ -927,20 +930,24 @@
use specfem_par_movie
implicit none
- integer :: ispec,ipoin
+ integer,intent(in) :: ispec,iglob,ipoin
real(kind=CUSTOM_REAL),dimension(NDIM,NGLLX,NGLLY,NGLLZ) :: &
displ_element,veloc_element,accel_element
! local parameters
- integer :: i,j,k,iglob
+ integer :: i,j,k
logical :: is_done
! velocity vector
is_done = .false.
+
+ ! loops over all gll points from this element
do k=1,NGLLZ
do j=1,NGLLY
do i=1,NGLLX
+ ! checks if global point is found
if( iglob == ibool(i,j,k,ispec) ) then
+
! horizontal displacement
store_val_ux_external_mesh(ipoin) = max(store_val_ux_external_mesh(ipoin),&
abs(displ_element(1,i,j,k)),abs(displ_element(2,i,j,k)))
More information about the CIG-COMMITS
mailing list