[cig-commits] r17293 - in seismo/3D/SPECFEM3D/trunk: . doc in_data_files in_data_files/meshfem3D_files in_out_files src src/decimate_mesh src/decompose_mesh_SCOTCH src/generate_databases src/meshfem3D src/shared src/specfem3D utils utils/Visualization/opendx_AVS utils/archimedes utils/from_old_DATA utils/from_old_DATA/cmtsolution_files utils/from_old_DATA/par_files utils/from_old_DATA/stations_files utils/obsolete_routines_from_SPECFEM3D_v1.4.4 utils/oldstuff
pieyre at geodynamics.org
pieyre at geodynamics.org
Wed Oct 20 05:16:54 PDT 2010
Author: pieyre
Date: 2010-10-20 05:16:18 -0700 (Wed, 20 Oct 2010)
New Revision: 17293
Added:
seismo/3D/SPECFEM3D/trunk/AUTHORS
seismo/3D/SPECFEM3D/trunk/README
seismo/3D/SPECFEM3D/trunk/doc/
seismo/3D/SPECFEM3D/trunk/doc/LICENSE
seismo/3D/SPECFEM3D/trunk/doc/USER_MANUAL/
seismo/3D/SPECFEM3D/trunk/examples/
seismo/3D/SPECFEM3D/trunk/in_data_files/
seismo/3D/SPECFEM3D/trunk/in_data_files/meshfem3D_files/
seismo/3D/SPECFEM3D/trunk/in_data_files/meshfem3D_files/Mesh_Par_file
seismo/3D/SPECFEM3D/trunk/in_data_files/meshfem3D_files/interface1.dat
seismo/3D/SPECFEM3D/trunk/in_data_files/meshfem3D_files/interface2.dat
seismo/3D/SPECFEM3D/trunk/in_data_files/meshfem3D_files/interfaces.dat
seismo/3D/SPECFEM3D/trunk/in_out_files/
seismo/3D/SPECFEM3D/trunk/in_out_files/DATABASES_MPI/
seismo/3D/SPECFEM3D/trunk/in_out_files/OUTPUT_FILES/
seismo/3D/SPECFEM3D/trunk/src/
seismo/3D/SPECFEM3D/trunk/src/check_mesh_quality_CUBIT_Abaqus/
seismo/3D/SPECFEM3D/trunk/src/decimate_mesh/
seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/
seismo/3D/SPECFEM3D/trunk/src/generate_databases/
seismo/3D/SPECFEM3D/trunk/src/generate_databases/Makefile.in
seismo/3D/SPECFEM3D/trunk/src/generate_databases/calc_jacobian.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/constants_gocad.h
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_MPI.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_global.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_model.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/memory_eval.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/model_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/program_generate_databases.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/save_arrays_solver.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/
seismo/3D/SPECFEM3D/trunk/src/shared/
seismo/3D/SPECFEM3D/trunk/src/shared/assemble_MPI_scalar.f90
seismo/3D/SPECFEM3D/trunk/src/shared/check_mesh_resolution.f90
seismo/3D/SPECFEM3D/trunk/src/shared/combine_AVS_DX.f90
seismo/3D/SPECFEM3D/trunk/src/shared/combine_surf_data.f90
seismo/3D/SPECFEM3D/trunk/src/shared/combine_vol_data.f90
seismo/3D/SPECFEM3D/trunk/src/shared/compute_arrays_source.f90
seismo/3D/SPECFEM3D/trunk/src/shared/compute_boundary_kernel.f90
seismo/3D/SPECFEM3D/trunk/src/shared/compute_kernels.f90
seismo/3D/SPECFEM3D/trunk/src/shared/compute_parameters.f90
seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in
seismo/3D/SPECFEM3D/trunk/src/shared/convolve_source_timefunction.f90
seismo/3D/SPECFEM3D/trunk/src/shared/create_header_file.f90
seismo/3D/SPECFEM3D/trunk/src/shared/create_movie_shakemap_AVS_DX_GMT.f90
seismo/3D/SPECFEM3D/trunk/src/shared/create_name_database.f90
seismo/3D/SPECFEM3D/trunk/src/shared/create_serial_name_database.f90
seismo/3D/SPECFEM3D/trunk/src/shared/define_derivation_matrices.f90
seismo/3D/SPECFEM3D/trunk/src/shared/detect_surface.f90
seismo/3D/SPECFEM3D/trunk/src/shared/exit_mpi.f90
seismo/3D/SPECFEM3D/trunk/src/shared/get_attenuation_model.f90
seismo/3D/SPECFEM3D/trunk/src/shared/get_cmt.f90
seismo/3D/SPECFEM3D/trunk/src/shared/get_element_face.f90
seismo/3D/SPECFEM3D/trunk/src/shared/get_jacobian_boundaries.f90
seismo/3D/SPECFEM3D/trunk/src/shared/get_shape2D.f90
seismo/3D/SPECFEM3D/trunk/src/shared/get_shape3D.f90
seismo/3D/SPECFEM3D/trunk/src/shared/get_value_parameters.f90
seismo/3D/SPECFEM3D/trunk/src/shared/gll_library.f90
seismo/3D/SPECFEM3D/trunk/src/shared/hex_nodes.f90
seismo/3D/SPECFEM3D/trunk/src/shared/lagrange_poly.f90
seismo/3D/SPECFEM3D/trunk/src/shared/netlib_specfun_erf.f90
seismo/3D/SPECFEM3D/trunk/src/shared/parallel.f90
seismo/3D/SPECFEM3D/trunk/src/shared/param_reader.c
seismo/3D/SPECFEM3D/trunk/src/shared/precision.h.in
seismo/3D/SPECFEM3D/trunk/src/shared/prepare_assemble_MPI.f90
seismo/3D/SPECFEM3D/trunk/src/shared/program_create_header_file.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/read_value_parameters.f90
seismo/3D/SPECFEM3D/trunk/src/shared/recompute_jacobian.f90
seismo/3D/SPECFEM3D/trunk/src/shared/save_header_file.f90
seismo/3D/SPECFEM3D/trunk/src/shared/serial.f90
seismo/3D/SPECFEM3D/trunk/src/shared/sort_array_coordinates.f90
seismo/3D/SPECFEM3D/trunk/src/shared/utm_geo.f90
seismo/3D/SPECFEM3D/trunk/src/shared/write_AVS_DX_global_data.f90
seismo/3D/SPECFEM3D/trunk/src/shared/write_AVS_DX_global_faces_data.f90
seismo/3D/SPECFEM3D/trunk/src/shared/write_AVS_DX_surface_data.f90
seismo/3D/SPECFEM3D/trunk/src/shared/write_VTK_data.f90
seismo/3D/SPECFEM3D/trunk/src/shared/write_c_binary.c
seismo/3D/SPECFEM3D/trunk/src/specfem3D/
seismo/3D/SPECFEM3D/trunk/src/specfem3D/Makefile.in
seismo/3D/SPECFEM3D/trunk/src/specfem3D/PML_init.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/ascii_2_sep.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/assemble_MPI_vector.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/comp_source_time_function.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_acoustic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_elastic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_acoustic_el.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_coupling_elastic_ac.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_PML.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_pot.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_elastic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_elastic_Dev.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_elastic_noDev.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_gradient.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_interpolated_dva.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_stacey_acoustic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_stacey_elastic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/constants_gocad.h
seismo/3D/SPECFEM3D/trunk/src/specfem3D/detect_mesh_surfaces.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/finalize_simulation.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/iterate_time.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_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/program_specfem3D.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_adjoint_kernels.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_GLL_points.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_movie_meshes.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_sources_receivers.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_PNM_GIF_data.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_movie_output.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_seismograms.f90
seismo/3D/SPECFEM3D/trunk/utils/
seismo/3D/SPECFEM3D/trunk/utils/Visualization/opendx_AVS/example_meshfem_seq_dx.cfg
seismo/3D/SPECFEM3D/trunk/utils/Visualization/opendx_AVS/example_meshfem_seq_dx.net
seismo/3D/SPECFEM3D/trunk/utils/archimedes/
seismo/3D/SPECFEM3D/trunk/utils/archimedes/__init__.py
seismo/3D/SPECFEM3D/trunk/utils/change_simulation_type1.pl
seismo/3D/SPECFEM3D/trunk/utils/change_simulation_type2.pl
seismo/3D/SPECFEM3D/trunk/utils/convolve_source_timefunction.csh
seismo/3D/SPECFEM3D/trunk/utils/files_needed_asteroid/
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/Specfem3DBasin.cfg
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/cmtsolution_files/
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/cmtsolution_files/CMTSOLUTION.default
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/cmtsolution_files/CMTSOLUTION.layered_halfspace
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/cmtsolution_files/CMTSOLUTION_1857_new
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/cmtsolution_files/CMTSOLUTION_CARCIONE_COPPER
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/cmtsolution_files/CMTSOLUTION_LQY_HOLLYWOOD
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/cmtsolution_files/CMTSOLUTION_LQY_YORBA_LINDA
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/cmtsolution_files/CMTSOLUTION_MOVIE
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/cmtsolution_files/CMTSOLUTION_Northridge
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/cmtsolution_files/CMTSOLUTION_POLET_HOLLYWOOD
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/cmtsolution_files/CMTSOLUTION_POLET_YORBA_LINDA
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/cmtsolution_files/CMTSOLUTION_ZHU_YORBA_LINDA
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/hauksson_model/
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/la_3D_block_harvard/
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/la_basement/
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/la_topography/
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/lin_model/
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/moho_map/
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/par_files/
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/par_files/Par_file.cfg
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/par_files/Par_file.default
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/par_files/Par_file.layered_halfspace
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/par_files/Par_file_Carcione_copper_ori_r2d2_serial
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/par_files/Par_file_Carcione_copper_very_small_serial
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/par_files/Par_file_EGEE_gros
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/par_files/Par_file_EGEE_petit
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/par_files/Par_file_EGEE_small_4
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/par_files/Par_file_SC_288
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/par_files/Par_file_SC_384
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/st_3D_block_harvard/
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/stations_files/
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/stations_files/STATIONS.default
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/stations_files/STATIONS.layered_halfspace
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/stations_files/STATIONS_ALL
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/stations_files/STATIONS_CALIFORNIA_BROADBAND
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/stations_files/STATIONS_CALIFORNIA_TOMO
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/stations_files/STATIONS_CALIFORNIA_TOMO_INNER
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/stations_files/STATIONS_CALIFORNIA_TOMO_OUTER
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/stations_files/STATIONS_CARCIONE_COPPER
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/stations_files/STATIONS_DAVE_WALD
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/stations_files/STATIONS_SWAMI
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/stations_files/STATIONS_TRINET
seismo/3D/SPECFEM3D/trunk/utils/from_old_DATA/stations_files/STATIONS_tsuboi_tokachi-oki
seismo/3D/SPECFEM3D/trunk/utils/mymachines
seismo/3D/SPECFEM3D/trunk/utils/obsolete_routines_from_SPECFEM3D_v1.4.4/
seismo/3D/SPECFEM3D/trunk/utils/obsolete_routines_from_SPECFEM3D_v1.4.4/aniso_model.f90
seismo/3D/SPECFEM3D/trunk/utils/obsolete_routines_from_SPECFEM3D_v1.4.4/check_buffers_2D.f90
seismo/3D/SPECFEM3D/trunk/utils/obsolete_routines_from_SPECFEM3D_v1.4.4/cmt.h
seismo/3D/SPECFEM3D/trunk/utils/obsolete_routines_from_SPECFEM3D_v1.4.4/get_MPI_cutplanes_eta.f90
seismo/3D/SPECFEM3D/trunk/utils/obsolete_routines_from_SPECFEM3D_v1.4.4/get_MPI_cutplanes_xi.f90
seismo/3D/SPECFEM3D/trunk/utils/obsolete_routines_from_SPECFEM3D_v1.4.4/model_interface_bedrock.f90
seismo/3D/SPECFEM3D/trunk/utils/obsolete_routines_from_SPECFEM3D_v1.4.4/read_arrays_solver.f90
seismo/3D/SPECFEM3D/trunk/utils/obsolete_routines_from_SPECFEM3D_v1.4.4/save_moho_arrays.f90
seismo/3D/SPECFEM3D/trunk/utils/oldstuff/readme_external_mesh
Removed:
seismo/3D/SPECFEM3D/trunk/DATA/
seismo/3D/SPECFEM3D/trunk/DATABASES_MPI/
seismo/3D/SPECFEM3D/trunk/EXAMPLES/
seismo/3D/SPECFEM3D/trunk/LICENSE
seismo/3D/SPECFEM3D/trunk/OUTPUT_FILES/
seismo/3D/SPECFEM3D/trunk/PML_init.f90
seismo/3D/SPECFEM3D/trunk/README_SPECFEM3D
seismo/3D/SPECFEM3D/trunk/USER_MANUAL/
seismo/3D/SPECFEM3D/trunk/UTILS/
seismo/3D/SPECFEM3D/trunk/aniso_model.f90
seismo/3D/SPECFEM3D/trunk/ascii_2_sep.f90
seismo/3D/SPECFEM3D/trunk/assemble_MPI_scalar.f90
seismo/3D/SPECFEM3D/trunk/assemble_MPI_vector.f90
seismo/3D/SPECFEM3D/trunk/calc_jacobian.f90
seismo/3D/SPECFEM3D/trunk/change_simulation_type.pl
seismo/3D/SPECFEM3D/trunk/check_mesh_quality_CUBIT_Abaqus/
seismo/3D/SPECFEM3D/trunk/check_mesh_resolution.f90
seismo/3D/SPECFEM3D/trunk/combine_AVS_DX.f90
seismo/3D/SPECFEM3D/trunk/combine_surf_data.f90
seismo/3D/SPECFEM3D/trunk/combine_vol_data.f90
seismo/3D/SPECFEM3D/trunk/comp_source_time_function.f90
seismo/3D/SPECFEM3D/trunk/compute_add_sources_acoustic.f90
seismo/3D/SPECFEM3D/trunk/compute_add_sources_elastic.f90
seismo/3D/SPECFEM3D/trunk/compute_arrays_source.f90
seismo/3D/SPECFEM3D/trunk/compute_boundary_kernel.f90
seismo/3D/SPECFEM3D/trunk/compute_coupling_acoustic_el.f90
seismo/3D/SPECFEM3D/trunk/compute_coupling_elastic_ac.f90
seismo/3D/SPECFEM3D/trunk/compute_forces_acoustic.f90
seismo/3D/SPECFEM3D/trunk/compute_forces_acoustic_PML.f90
seismo/3D/SPECFEM3D/trunk/compute_forces_acoustic_pot.f90
seismo/3D/SPECFEM3D/trunk/compute_forces_elastic.f90
seismo/3D/SPECFEM3D/trunk/compute_forces_elastic_Dev.f90
seismo/3D/SPECFEM3D/trunk/compute_forces_elastic_noDev.f90
seismo/3D/SPECFEM3D/trunk/compute_gradient.f90
seismo/3D/SPECFEM3D/trunk/compute_interpolated_dva.f90
seismo/3D/SPECFEM3D/trunk/compute_kernels.f90
seismo/3D/SPECFEM3D/trunk/compute_parameters.f90
seismo/3D/SPECFEM3D/trunk/compute_stacey_acoustic.f90
seismo/3D/SPECFEM3D/trunk/compute_stacey_elastic.f90
seismo/3D/SPECFEM3D/trunk/constants.h.in
seismo/3D/SPECFEM3D/trunk/constants_gocad.h
seismo/3D/SPECFEM3D/trunk/convolve_source_timefunction.csh
seismo/3D/SPECFEM3D/trunk/convolve_source_timefunction.f90
seismo/3D/SPECFEM3D/trunk/create_header_file.f90
seismo/3D/SPECFEM3D/trunk/create_mass_matrices.f90
seismo/3D/SPECFEM3D/trunk/create_movie_shakemap_AVS_DX_GMT.f90
seismo/3D/SPECFEM3D/trunk/create_name_database.f90
seismo/3D/SPECFEM3D/trunk/create_regions_mesh.f90
seismo/3D/SPECFEM3D/trunk/create_serial_name_database.f90
seismo/3D/SPECFEM3D/trunk/decimate_mesh/
seismo/3D/SPECFEM3D/trunk/decompose_mesh_SCOTCH/
seismo/3D/SPECFEM3D/trunk/define_derivation_matrices.f90
seismo/3D/SPECFEM3D/trunk/detect_mesh_surfaces.f90
seismo/3D/SPECFEM3D/trunk/detect_surface.f90
seismo/3D/SPECFEM3D/trunk/exit_mpi.f90
seismo/3D/SPECFEM3D/trunk/files_needed_asteroid/
seismo/3D/SPECFEM3D/trunk/finalize_simulation.f90
seismo/3D/SPECFEM3D/trunk/generate_databases.f90
seismo/3D/SPECFEM3D/trunk/get_MPI.f90
seismo/3D/SPECFEM3D/trunk/get_absorbing_boundary.f90
seismo/3D/SPECFEM3D/trunk/get_attenuation_model.f90
seismo/3D/SPECFEM3D/trunk/get_cmt.f90
seismo/3D/SPECFEM3D/trunk/get_coupling_surfaces.f90
seismo/3D/SPECFEM3D/trunk/get_element_face.f90
seismo/3D/SPECFEM3D/trunk/get_global.f90
seismo/3D/SPECFEM3D/trunk/get_jacobian_boundaries.f90
seismo/3D/SPECFEM3D/trunk/get_model.f90
seismo/3D/SPECFEM3D/trunk/get_shape2D.f90
seismo/3D/SPECFEM3D/trunk/get_shape3D.f90
seismo/3D/SPECFEM3D/trunk/get_value_parameters.f90
seismo/3D/SPECFEM3D/trunk/gll_library.f90
seismo/3D/SPECFEM3D/trunk/hex_nodes.f90
seismo/3D/SPECFEM3D/trunk/in_data_files/CMTSOLUTION.default
seismo/3D/SPECFEM3D/trunk/in_data_files/CMTSOLUTION.layered_halfspace
seismo/3D/SPECFEM3D/trunk/in_data_files/CMTSOLUTION_1857_new
seismo/3D/SPECFEM3D/trunk/in_data_files/CMTSOLUTION_CARCIONE_COPPER
seismo/3D/SPECFEM3D/trunk/in_data_files/CMTSOLUTION_LQY_HOLLYWOOD
seismo/3D/SPECFEM3D/trunk/in_data_files/CMTSOLUTION_LQY_YORBA_LINDA
seismo/3D/SPECFEM3D/trunk/in_data_files/CMTSOLUTION_MOVIE
seismo/3D/SPECFEM3D/trunk/in_data_files/CMTSOLUTION_Northridge
seismo/3D/SPECFEM3D/trunk/in_data_files/CMTSOLUTION_POLET_HOLLYWOOD
seismo/3D/SPECFEM3D/trunk/in_data_files/CMTSOLUTION_POLET_YORBA_LINDA
seismo/3D/SPECFEM3D/trunk/in_data_files/CMTSOLUTION_ZHU_YORBA_LINDA
seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file.cfg
seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file.default
seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file.layered_halfspace
seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file_Carcione_copper_ori_r2d2_serial
seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file_Carcione_copper_very_small_serial
seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file_EGEE_gros
seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file_EGEE_petit
seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file_EGEE_small_4
seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file_SC_288
seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file_SC_384
seismo/3D/SPECFEM3D/trunk/in_data_files/STATIONS.default
seismo/3D/SPECFEM3D/trunk/in_data_files/STATIONS.layered_halfspace
seismo/3D/SPECFEM3D/trunk/in_data_files/STATIONS_ALL
seismo/3D/SPECFEM3D/trunk/in_data_files/STATIONS_CALIFORNIA_BROADBAND
seismo/3D/SPECFEM3D/trunk/in_data_files/STATIONS_CALIFORNIA_TOMO
seismo/3D/SPECFEM3D/trunk/in_data_files/STATIONS_CALIFORNIA_TOMO_INNER
seismo/3D/SPECFEM3D/trunk/in_data_files/STATIONS_CALIFORNIA_TOMO_OUTER
seismo/3D/SPECFEM3D/trunk/in_data_files/STATIONS_CARCIONE_COPPER
seismo/3D/SPECFEM3D/trunk/in_data_files/STATIONS_DAVE_WALD
seismo/3D/SPECFEM3D/trunk/in_data_files/STATIONS_SWAMI
seismo/3D/SPECFEM3D/trunk/in_data_files/STATIONS_TRINET
seismo/3D/SPECFEM3D/trunk/in_data_files/STATIONS_tsuboi_tokachi-oki
seismo/3D/SPECFEM3D/trunk/in_data_files/Specfem3DBasin.cfg
seismo/3D/SPECFEM3D/trunk/in_data_files/hauksson_model/
seismo/3D/SPECFEM3D/trunk/in_data_files/la_3D_block_harvard/
seismo/3D/SPECFEM3D/trunk/in_data_files/la_basement/
seismo/3D/SPECFEM3D/trunk/in_data_files/la_topography/
seismo/3D/SPECFEM3D/trunk/in_data_files/lin_model/
seismo/3D/SPECFEM3D/trunk/in_data_files/moho_map/
seismo/3D/SPECFEM3D/trunk/in_data_files/st_3D_block_harvard/
seismo/3D/SPECFEM3D/trunk/initialize_simulation.f90
seismo/3D/SPECFEM3D/trunk/iterate_time.f90
seismo/3D/SPECFEM3D/trunk/lagrange_poly.f90
seismo/3D/SPECFEM3D/trunk/locate_receivers.f90
seismo/3D/SPECFEM3D/trunk/locate_source.f90
seismo/3D/SPECFEM3D/trunk/memory_eval.f90
seismo/3D/SPECFEM3D/trunk/meshfem3D/
seismo/3D/SPECFEM3D/trunk/model_aniso.f90
seismo/3D/SPECFEM3D/trunk/model_external_values.f90
seismo/3D/SPECFEM3D/trunk/model_tomography.f90
seismo/3D/SPECFEM3D/trunk/mymachines
seismo/3D/SPECFEM3D/trunk/netlib_specfun_erf.f90
seismo/3D/SPECFEM3D/trunk/obj/
seismo/3D/SPECFEM3D/trunk/obsolete_routines_from_SPECFEM3D_v1.4.4/
seismo/3D/SPECFEM3D/trunk/parallel.f90
seismo/3D/SPECFEM3D/trunk/param_reader.c
seismo/3D/SPECFEM3D/trunk/precision.h.in
seismo/3D/SPECFEM3D/trunk/prepare_assemble_MPI.f90
seismo/3D/SPECFEM3D/trunk/prepare_timerun.f90
seismo/3D/SPECFEM3D/trunk/program_create_header_file.f90
seismo/3D/SPECFEM3D/trunk/program_generate_databases.f90
seismo/3D/SPECFEM3D/trunk/program_specfem3D.f90
seismo/3D/SPECFEM3D/trunk/read_arrays_solver.f90
seismo/3D/SPECFEM3D/trunk/read_mesh_databases.f90
seismo/3D/SPECFEM3D/trunk/read_parameter_file.f90
seismo/3D/SPECFEM3D/trunk/read_topo_bathy_file.f90
seismo/3D/SPECFEM3D/trunk/read_topography_bathymetry.f90
seismo/3D/SPECFEM3D/trunk/read_value_parameters.f90
seismo/3D/SPECFEM3D/trunk/readme_external_mesh
seismo/3D/SPECFEM3D/trunk/recompute_jacobian.f90
seismo/3D/SPECFEM3D/trunk/save_adjoint_kernels.f90
seismo/3D/SPECFEM3D/trunk/save_arrays_solver.f90
seismo/3D/SPECFEM3D/trunk/save_header_file.f90
seismo/3D/SPECFEM3D/trunk/save_moho_arrays.f90
seismo/3D/SPECFEM3D/trunk/serial.f90
seismo/3D/SPECFEM3D/trunk/setup_GLL_points.f90
seismo/3D/SPECFEM3D/trunk/setup_movie_meshes.f90
seismo/3D/SPECFEM3D/trunk/setup_sources_receivers.f90
seismo/3D/SPECFEM3D/trunk/sort_array_coordinates.f90
seismo/3D/SPECFEM3D/trunk/specfem3D.f90
seismo/3D/SPECFEM3D/trunk/specfem3D_par.f90
seismo/3D/SPECFEM3D/trunk/src/decimate_mesh/HOMO_3D_lisse_300
seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/compile_all.csh
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/DATA/
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/OUTPUT_FILES/
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/configure
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/configure.ac
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/constants.h.in
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/exit_mpi.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/mesh_vertical.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/obj/
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/precision.h.in
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/read_moho_map.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/salton_trough_gocad.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/socal_model.f90
seismo/3D/SPECFEM3D/trunk/utils/change_simulation_type.pl
seismo/3D/SPECFEM3D/trunk/utils/oldstuff/check_buffers_2D.f90
seismo/3D/SPECFEM3D/trunk/utils/oldstuff/cmt.h
seismo/3D/SPECFEM3D/trunk/utils/oldstuff/get_MPI_cutplanes_eta.f90
seismo/3D/SPECFEM3D/trunk/utils/oldstuff/get_MPI_cutplanes_xi.f90
seismo/3D/SPECFEM3D/trunk/utils/oldstuff/model_interface_bedrock.f90
seismo/3D/SPECFEM3D/trunk/utm_geo.f90
seismo/3D/SPECFEM3D/trunk/write_AVS_DX_global_data.f90
seismo/3D/SPECFEM3D/trunk/write_AVS_DX_global_faces_data.f90
seismo/3D/SPECFEM3D/trunk/write_AVS_DX_surface_data.f90
seismo/3D/SPECFEM3D/trunk/write_PNM_GIF_data.f90
seismo/3D/SPECFEM3D/trunk/write_VTK_data.f90
seismo/3D/SPECFEM3D/trunk/write_c_binary.c
seismo/3D/SPECFEM3D/trunk/write_movie_output.f90
seismo/3D/SPECFEM3D/trunk/write_seismograms.f90
Modified:
seismo/3D/SPECFEM3D/trunk/INSTALL
seismo/3D/SPECFEM3D/trunk/Makefile.in
seismo/3D/SPECFEM3D/trunk/config.h.in
seismo/3D/SPECFEM3D/trunk/configure
seismo/3D/SPECFEM3D/trunk/configure.ac
seismo/3D/SPECFEM3D/trunk/in_data_files/Par_file.in
seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/Makefile.in
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/Makefile.in
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/check_mesh_quality.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/meshfem3D.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/read_parameter_file.f90
seismo/3D/SPECFEM3D/trunk/src/meshfem3D/read_value_parameters.f90
Log:
modified the tree structure of the software package, created the src/ folder and put the source code in it. Moved, created, deleted and renamed many files and folders. Modified README and added AUTHORS. binaries are now created in bin/,_the old DATA is in in_data_files, in_out_files contains DATABASES_MPI and OUTPUT_FILES. To compile type 'make' of 'make xspecfem3D' for instance in the main folder.
Added: seismo/3D/SPECFEM3D/trunk/AUTHORS
===================================================================
--- seismo/3D/SPECFEM3D/trunk/AUTHORS (rev 0)
+++ seismo/3D/SPECFEM3D/trunk/AUTHORS 2010-10-20 12:16:18 UTC (rev 17293)
@@ -0,0 +1,19 @@
+ AUTHORS :
+-----------
+
+Emanuele Casarotti
+Min Chen
+Vala Hjörleifsdóttir
+Sue Kientz
+Dimitri Komatitsch
+Qynia Liu
+Yang Luo
+Nicolas Le Goff
+Pieyre Le Loher
+Alessia Maggi
+Daniel Peter
+Brian Savage
+Leif Strand
+Carl Tape
+Jeroen Tromp
+
Modified: seismo/3D/SPECFEM3D/trunk/INSTALL
===================================================================
--- seismo/3D/SPECFEM3D/trunk/INSTALL 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/INSTALL 2010-10-20 12:16:18 UTC (rev 17293)
@@ -11,13 +11,7 @@
Main developers: Dimitri Komatitsch and Jeroen Tromp
-Additional contributions by:
-Qinya Liu
-Min Chen
-
-
-
Basic installation
------------------
Deleted: seismo/3D/SPECFEM3D/trunk/LICENSE
===================================================================
--- seismo/3D/SPECFEM3D/trunk/LICENSE 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/LICENSE 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,339 +0,0 @@
- GNU GENERAL PUBLIC LICENSE
- Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users. This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it. (Some other Free Software Foundation software is covered by
-the GNU Lesser General Public License instead.) You can apply it to
-your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
- To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have. You must make sure that they, too, receive or can get the
-source code. And you must show them these terms so they know their
-rights.
-
- We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
- Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software. If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
- Finally, any free program is threatened constantly by software
-patents. We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary. To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-
- GNU GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License. The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language. (Hereinafter, translation is included without limitation in
-the term "modification".) Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
- 1. You may copy and distribute verbatim copies of the Program's
-source code as you receive it, in any medium, provided that you
-conspicuously and appropriately publish on each copy an appropriate
-copyright notice and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
- 2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) You must cause the modified files to carry prominent notices
- stating that you changed the files and the date of any change.
-
- b) You must cause any work that you distribute or publish, that in
- whole or in part contains or is derived from the Program or any
- part thereof, to be licensed as a whole at no charge to all third
- parties under the terms of this License.
-
- c) If the modified program normally reads commands interactively
- when run, you must cause it, when started running for such
- interactive use in the most ordinary way, to print or display an
- announcement including an appropriate copyright notice and a
- notice that there is no warranty (or else, saying that you provide
- a warranty) and that users may redistribute the program under
- these conditions, and telling the user how to view a copy of this
- License. (Exception: if the Program itself is interactive but
- does not normally print such an announcement, your work based on
- the Program is not required to print an announcement.)
-
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
- a) Accompany it with the complete corresponding machine-readable
- source code, which must be distributed under the terms of Sections
- 1 and 2 above on a medium customarily used for software interchange; or,
-
- b) Accompany it with a written offer, valid for at least three
- years, to give any third party, for a charge no more than your
- cost of physically performing source distribution, a complete
- machine-readable copy of the corresponding source code, to be
- distributed under the terms of Sections 1 and 2 above on a medium
- customarily used for software interchange; or,
-
- c) Accompany it with the information you received as to the offer
- to distribute corresponding source code. (This alternative is
- allowed only for noncommercial distribution and only if you
- received the program in object code or executable form with such
- an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it. For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable. However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
- 4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
- 5. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Program or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
- 6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
- 7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all. For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
- 8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 9. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Program
-specifies a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation. If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
- 10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission. For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this. Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
- NO WARRANTY
-
- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
- END OF TERMS AND CONDITIONS
-
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- 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.
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
- Gnomovision version 69, Copyright (C) year name of author
- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License. Of course, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the program
- `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
- <signature of Ty Coon>, 1 April 1989
- Ty Coon, President of Vice
-
-This General Public License does not permit incorporating your program into
-proprietary programs. If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library. If this is what you want to do, use the GNU Lesser General
-Public License instead of this License.
Modified: seismo/3D/SPECFEM3D/trunk/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D/trunk/Makefile.in 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/Makefile.in 2010-10-20 12:16:18 UTC (rev 17293)
@@ -53,602 +53,84 @@
ARFLAGS = cru
RANLIB = ranlib
+##.PHONY: clean default all backup bak generate_databases specfem3D meshfem3D
-O = obj
+required: bin lib obj
-libspecfem_a_OBJECTS = \
- $O/assemble_MPI_scalar.o \
- $O/calc_jacobian.o \
- $O/check_mesh_resolution.o \
- $O/comp_source_time_function.o \
- $O/compute_arrays_source.o \
- $O/compute_parameters.o \
- $O/create_header_file.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 \
- $O/detect_surface.o \
- $O/exit_mpi.o \
- $O/get_absorbing_boundary.o \
- $O/get_coupling_surfaces.o \
- $O/get_model.o \
- $O/get_MPI.o \
- $O/get_attenuation_model.o \
- $O/get_cmt.o \
- $O/get_element_face.o \
- $O/get_global.o \
- $O/get_jacobian_boundaries.o \
- $O/get_shape2D.o \
- $O/get_shape3D.o \
- $O/get_value_parameters.o \
- $O/gll_library.o \
- $O/hex_nodes.o \
- $O/lagrange_poly.o \
- $O/locate_receivers.o \
- $O/locate_source.o \
- $O/generate_databases.o \
- $O/model_external_values.o \
- $O/model_aniso.o \
- $O/model_tomography.o \
- $O/netlib_specfun_erf.o \
- $O/param_reader.o \
- $O/prepare_assemble_MPI.o \
- $O/read_topo_bathy_file.o \
- $O/read_parameter_file.o \
- $O/read_value_parameters.o \
- $O/recompute_jacobian.o \
- $O/save_arrays_solver.o \
- $O/save_header_file.o \
- $O/save_moho_arrays.o \
- $O/sort_array_coordinates.o \
- $O/utm_geo.o \
- $O/write_AVS_DX_global_data.o \
- $O/write_AVS_DX_global_faces_data.o \
- $O/write_AVS_DX_surface_data.o \
- $O/write_VTK_data.o \
- $O/memory_eval.o \
- $(EMPTY_MACRO)
-
-###
-###--obsolete routines
-###
-# $O/compute_rho_estimate.o \
-# $O/define_subregions.o \
-# $O/define_subregions_heuristic.o \
-# $O/get_absorb.o \
-# $O/get_flags_boundaries.o \
-# $O/hauksson_model.o \
-# $O/interpolate_gocad_block_HR.o \
-# $O/interpolate_gocad_block_MR.o \
-# $O/mesh_vertical.o \
-# $O/read_arrays_buffers_solver.o \
-# $O/read_moho_map.o \
-# $O/salton_trough_gocad.o \
-# $O/socal_model.o \
-
-
-
-# solver objects with statically allocated arrays; not dependent upon
-# values_from_mesher.h anymore
-SOLVER_ARRAY_OBJECTS = \
- $O/specfem3D_par.o \
- $O/PML_init.o \
- $O/compute_boundary_kernel.o \
- $O/compute_kernels.o \
- $O/compute_forces_acoustic.o \
- $O/compute_forces_acoustic_pot.o \
- $O/compute_forces_acoustic_PML.o \
- $O/compute_forces_elastic.o \
- $O/compute_forces_elastic_Dev.o \
- $O/compute_forces_elastic_noDev.o \
- $O/compute_add_sources_acoustic.o \
- $O/compute_add_sources_elastic.o \
- $O/compute_coupling_acoustic_el.o \
- $O/compute_coupling_elastic_ac.o \
- $O/compute_stacey_acoustic.o \
- $O/compute_stacey_elastic.o \
- $O/compute_gradient.o \
- $O/compute_interpolated_dva.o \
- $O/initialize_simulation.o \
- $O/read_mesh_databases.o \
- $O/setup_GLL_points.o \
- $O/write_movie_output.o \
- $O/write_PNM_GIF_data.o \
- $O/write_seismograms.o \
- $O/detect_mesh_surfaces.o \
- $O/setup_movie_meshes.o \
- $O/read_topography_bathymetry.o \
- $O/setup_sources_receivers.o \
- $O/prepare_timerun.o \
- $O/iterate_time.o \
- $O/finalize_simulation.o \
- $O/save_adjoint_kernels.o \
- $O/specfem3D.o \
- $O/assemble_MPI_vector.o \
- $(EMPTY_MACRO)
-
-###
-###--obsolete routines
-###
-# $O/read_arrays_solver.o \
-
-
-# objects toggled between the parallel and serial version
- at COND_MPI_TRUE@COND_MPI_OBJECTS = $O/parallel.o
- at COND_MPI_FALSE@COND_MPI_OBJECTS = $O/serial.o
-
-LIBSPECFEM = $O/libspecfem.a
-
-# objects for the pure Fortran version
- at COND_PYRE_FALSE@XGENERATE_DATABASES_OBJECTS = $O/program_generate_databases.o $(LIBSPECFEM)
- at COND_PYRE_FALSE@XSPECFEM_OBJECTS = $O/program_specfem3D.o $(SOLVER_ARRAY_OBJECTS) $(LIBSPECFEM)
-
####
#### targets
####
# default targets for the pure Fortran version
@COND_PYRE_FALSE at DEFAULT = \
+ at COND_PYRE_FALSE@ xdecompose_mesh_SCOTCH \
+ at COND_PYRE_FALSE@ meshfem3D \
@COND_PYRE_FALSE@ generate_databases \
@COND_PYRE_FALSE@ specfem3D \
- at COND_PYRE_FALSE@ combine_AVS_DX \
- at COND_PYRE_FALSE@ combine_vol_data \
- at COND_PYRE_FALSE@ combine_surf_data \
- at COND_PYRE_FALSE@ convolve_source_timefunction \
@COND_PYRE_FALSE@ $(EMPTY_MACRO)
+# @COND_PYRE_FALSE@ combine_AVS_DX \
+# @COND_PYRE_FALSE@ combine_vol_data \
+# @COND_PYRE_FALSE@ combine_surf_data \
+# @COND_PYRE_FALSE@ convolve_source_timefunction \
+
default: $(DEFAULT)
-all: clean default
+all: default
backup:
cp *f90 *h README_SPECFEM3D DATA/Par_file* Makefile go_generate_databases* go_mesher* go_solver* mymachines bak
bak: backup
-generate_databases: xgenerate_databases
+mesh : meshfem3D
-specfem3D: xspecfem3D
+gen : generate_databases
+spec : specfem3D
-####
-#### rules for executables
-####
+dec : decompose_mesh_SCOTCH
-# rules for the pure Fortran version
- at COND_PYRE_FALSE@xgenerate_databases: $(XGENERATE_DATABASES_OBJECTS) $(COND_MPI_OBJECTS)
- at COND_PYRE_FALSE@ ${FCLINK} -o xgenerate_databases $(XGENERATE_DATABASES_OBJECTS) $(COND_MPI_OBJECTS) $(MPILIBS)
- at COND_PYRE_FALSE@
- at COND_PYRE_FALSE@# solver also depends on values from mesher
- at COND_PYRE_FALSE@xspecfem3D: $(XSPECFEM_OBJECTS) $(COND_MPI_OBJECTS)
- at COND_PYRE_FALSE@ ${FCLINK} -o xspecfem3D $(XSPECFEM_OBJECTS) $(COND_MPI_OBJECTS) $(MPILIBS)
- at COND_PYRE_FALSE@
+generate_databases: xgenerate_databases
-combine_AVS_DX: xcombine_AVS_DX
-convolve_source_timefunction: xconvolve_source_timefunction
-create_header_file: xcreate_header_file
-create_movie_shakemap_AVS_DX_GMT: xcreate_movie_shakemap_AVS_DX_GMT
-combine_vol_data: xcombine_vol_data
-combine_surf_data: xcombine_surf_data
+specfem3D: xspecfem3D
-xconvolve_source_timefunction: $O/convolve_source_timefunction.o
- ${FCCOMPILE_CHECK} -o xconvolve_source_timefunction $O/convolve_source_timefunction.o
+meshfem3D: xmeshfem3D
-xcreate_header_file: $O/program_create_header_file.o $(LIBSPECFEM)
- ${FCCOMPILE_CHECK} -o xcreate_header_file $O/program_create_header_file.o $(LIBSPECFEM)
+decompose_mesh_SCOTCH: xdecompose_mesh_SCOTCH
- at COND_PYRE_FALSE@xcreate_movie_shakemap_AVS_DX_GMT: $O/create_movie_shakemap_AVS_DX_GMT.o $(LIBSPECFEM) OUTPUT_FILES/surface_from_mesher.h
- at COND_PYRE_FALSE@ ${FCCOMPILE_CHECK} -o xcreate_movie_shakemap_AVS_DX_GMT $O/create_movie_shakemap_AVS_DX_GMT.o $(LIBSPECFEM)
+bin:
+ mkdir bin
+lib:
+ mkdir lib
-xcombine_AVS_DX: $O/combine_AVS_DX.o $(LIBSPECFEM)
- ${FCCOMPILE_CHECK} -o xcombine_AVS_DX $O/combine_AVS_DX.o $(LIBSPECFEM)
+obj:
+ mkdir obj
-xcombine_vol_data: $O/combine_vol_data.o $O/write_c_binary.o $O/read_parameter_file.o $O/read_value_parameters.o $O/get_value_parameters.o $O/param_reader.o
- ${FCCOMPILE_CHECK} -o xcombine_vol_data $O/combine_vol_data.o $O/write_c_binary.o $O/read_parameter_file.o $O/read_value_parameters.o $O/get_value_parameters.o $O/param_reader.o
+reqmesh:
+ (cd obj; mkdir mesh)
-xcombine_surf_data: $O/combine_surf_data.o $O/write_c_binary.o $O/param_reader.o
- ${FCCOMPILE_CHECK} -o xcombine_surf_data $O/combine_surf_data.o $O/write_c_binary.o $O/param_reader.o
+reqspec:
+ (cd obj; mkdir spec)
+reqdec:
+ (cd obj; mkdir dec)
-clean:
- rm -f $O/* *.o *.gnu *.mod OUTPUT_FILES/timestamp* OUTPUT_FILES/starttime*txt work.pc* \
- xgenerate_databases xspecfem3D xcombine_AVS_DX \
- xconvolve_source_timefunction xcreate_header_file \
- xcreate_movie_shakemap_AVS_DX_GMT xcombine_vol_data xcombine_surf_data
+reqgen :
+ (cd obj; mkdir gen)
-###
-### rule for the archive library
-###
+xmeshfem3D: required reqmesh
+ (cd src/meshfem3D; make)
-$O/libspecfem.a: $(libspecfem_a_OBJECTS)
- -rm -f $O/libspecfem.a
- $(AR) $(ARFLAGS) $O/libspecfem.a $(libspecfem_a_OBJECTS)
- $(RANLIB) $O/libspecfem.a
+xspecfem3D: required reqspec
+ (cd src/specfem3D; make specfem3D)
-####
-#### rule to build each .o file below
-####
+xgenerate_databases: required reqgen
+ (cd src/generate_databases ; make generate_databases)
-###
-### optimized flags (not dependent on values from mesher anymore)
-###
+xdecompose_mesh_SCOTCH: required reqdec
+ (cd src/decompose_mesh_SCOTCH ; make)
-$O/specfem3D_par.o: constants.h specfem3D_par.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/specfem3D_par.o specfem3D_par.f90
-
-$O/specfem3D.o: constants.h specfem3D.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/specfem3D.o specfem3D.f90
-
-$O/compute_forces_elastic_noDev.o: constants.h compute_forces_elastic_noDev.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_forces_elastic_noDev.o compute_forces_elastic_noDev.f90
-
-$O/compute_forces_elastic_Dev.o: constants.h compute_forces_elastic_Dev.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_forces_elastic_Dev.o compute_forces_elastic_Dev.f90
-
-$O/compute_forces_elastic.o: constants.h compute_forces_elastic.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_forces_elastic.o compute_forces_elastic.f90
-
-$O/compute_forces_acoustic.o: constants.h compute_forces_acoustic.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_forces_acoustic.o compute_forces_acoustic.f90
-
-$O/compute_forces_acoustic_pot.o: constants.h compute_forces_acoustic_pot.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_forces_acoustic_pot.o compute_forces_acoustic_pot.f90
-
-$O/compute_forces_acoustic_PML.o: constants.h compute_forces_acoustic_PML.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_forces_acoustic_PML.o compute_forces_acoustic_PML.f90
-
-$O/compute_add_sources_acoustic.o: constants.h compute_add_sources_acoustic.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_add_sources_acoustic.o compute_add_sources_acoustic.f90
-
-$O/compute_add_sources_elastic.o: constants.h compute_add_sources_elastic.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_add_sources_elastic.o compute_add_sources_elastic.f90
-
-$O/compute_coupling_acoustic_el.o: constants.h compute_coupling_acoustic_el.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_coupling_acoustic_el.o compute_coupling_acoustic_el.f90
-
-$O/compute_coupling_elastic_ac.o: constants.h compute_coupling_elastic_ac.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_coupling_elastic_ac.o compute_coupling_elastic_ac.f90
-
-$O/compute_stacey_acoustic.o: constants.h compute_stacey_acoustic.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_stacey_acoustic.o compute_stacey_acoustic.f90
-
-$O/compute_stacey_elastic.o: constants.h compute_stacey_elastic.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_stacey_elastic.o compute_stacey_elastic.f90
-
-$O/compute_gradient.o: constants.h compute_gradient.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_gradient.o compute_gradient.f90
-
-$O/compute_interpolated_dva.o: constants.h compute_interpolated_dva.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/compute_interpolated_dva.o compute_interpolated_dva.f90
-
-$O/initialize_simulation.o: constants.h initialize_simulation.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/initialize_simulation.o initialize_simulation.f90
-
-$O/read_mesh_databases.o: constants.h read_mesh_databases.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/read_mesh_databases.o read_mesh_databases.f90
-
-$O/setup_GLL_points.o: constants.h setup_GLL_points.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/setup_GLL_points.o setup_GLL_points.f90
-
-$O/detect_mesh_surfaces.o: constants.h detect_mesh_surfaces.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/detect_mesh_surfaces.o detect_mesh_surfaces.f90
-
-$O/setup_movie_meshes.o: constants.h setup_movie_meshes.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/setup_movie_meshes.o setup_movie_meshes.f90
-
-$O/read_topography_bathymetry.o: constants.h read_topography_bathymetry.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/read_topography_bathymetry.o read_topography_bathymetry.f90
-
-$O/setup_sources_receivers.o: constants.h setup_sources_receivers.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/setup_sources_receivers.o setup_sources_receivers.f90
-
-$O/prepare_timerun.o: constants.h prepare_timerun.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/prepare_timerun.o prepare_timerun.f90
-
-$O/iterate_time.o: constants.h iterate_time.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/iterate_time.o iterate_time.f90
-
-$O/finalize_simulation.o: constants.h finalize_simulation.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/finalize_simulation.o finalize_simulation.f90
-
-$O/assemble_MPI_vector.o: constants.h assemble_MPI_vector.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/assemble_MPI_vector.o assemble_MPI_vector.f90
-
-$O/assemble_MPI_scalar.o: constants.h assemble_MPI_scalar.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/assemble_MPI_scalar.o assemble_MPI_scalar.f90
-
-$O/save_adjoint_kernels.o: constants.h save_adjoint_kernels.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/save_adjoint_kernels.o save_adjoint_kernels.f90
-
-$O/write_movie_output.o: constants.h write_movie_output.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/write_movie_output.o write_movie_output.f90
-
-$O/write_PNM_GIF_data.o: constants.h write_PNM_GIF_data.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/write_PNM_GIF_data.o write_PNM_GIF_data.f90
-
-$O/write_seismograms.o: constants.h write_seismograms.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/write_seismograms.o write_seismograms.f90
-
-
-###
-### MPI compilation without optimization
-###
-
-$O/parallel.o: constants.h parallel.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/parallel.o parallel.f90
-
-$O/model_external_values.o: constants.h model_external_values.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_external_values.o model_external_values.f90
-
-$O/model_tomography.o: constants.h model_tomography.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_tomography.o model_tomography.f90
-
-###
-### serial compilation without optimization
-###
-
-$O/model_aniso.o: constants.h model_aniso.f90
- ${FCCOMPILE_CHECK} -c -o $O/model_aniso.o model_aniso.f90
-
-$O/serial.o: constants.h exit_mpi.f90
- ${FCCOMPILE_CHECK} -c -o $O/serial.o serial.f90
-
-$O/program_specfem3D.o: program_specfem3D.f90
- ${FCCOMPILE_CHECK} -c -o $O/program_specfem3D.o program_specfem3D.f90
-
-$O/program_generate_databases.o: program_generate_databases.f90
- ${FCCOMPILE_CHECK} -c -o $O/program_generate_databases.o program_generate_databases.f90
-
-$O/generate_databases.o: constants.h generate_databases.f90
- ${FCCOMPILE_CHECK} -c -o $O/generate_databases.o generate_databases.f90
-
-$O/locate_source.o: constants.h locate_source.f90
- ${FCCOMPILE_CHECK} -c -o $O/locate_source.o locate_source.f90
-
-$O/locate_receivers.o: constants.h locate_receivers.f90
- ${FCCOMPILE_CHECK} -c -o $O/locate_receivers.o locate_receivers.f90
-
-$O/memory_eval.o: constants.h memory_eval.f90
- ${FCCOMPILE_CHECK} -c -o $O/memory_eval.o memory_eval.f90
-
-$O/exit_mpi.o: constants.h exit_mpi.f90
- ${FCCOMPILE_CHECK} -c -o $O/exit_mpi.o exit_mpi.f90
-
-$O/convolve_source_timefunction.o: convolve_source_timefunction.f90
- ${FCCOMPILE_CHECK} -c -o $O/convolve_source_timefunction.o convolve_source_timefunction.f90
-
-$O/program_create_header_file.o: program_create_header_file.f90
- ${FCCOMPILE_CHECK} -c -o $O/program_create_header_file.o program_create_header_file.f90
-
-$O/create_header_file.o: create_header_file.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_header_file.o create_header_file.f90
-
-$O/combine_AVS_DX.o: constants.h combine_AVS_DX.f90
- ${FCCOMPILE_CHECK} -c -o $O/combine_AVS_DX.o combine_AVS_DX.f90
-
-$O/save_header_file.o: constants.h save_header_file.f90
- ${FCCOMPILE_CHECK} -c -o $O/save_header_file.o save_header_file.f90
-
-$O/read_parameter_file.o: constants.h read_parameter_file.f90
- ${FCCOMPILE_CHECK} -c -o $O/read_parameter_file.o read_parameter_file.f90
-
-$O/read_value_parameters.o: constants.h read_value_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/read_value_parameters.o read_value_parameters.f90
-
-$O/get_value_parameters.o: constants.h get_value_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_value_parameters.o get_value_parameters.f90
-
-$O/utm_geo.o: constants.h utm_geo.f90
- ${FCCOMPILE_CHECK} -c -o $O/utm_geo.o utm_geo.f90
-
-$O/compute_parameters.o: constants.h compute_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/compute_parameters.o compute_parameters.f90
-
-$O/calc_jacobian.o: constants.h calc_jacobian.f90
- ${FCCOMPILE_CHECK} -c -o $O/calc_jacobian.o calc_jacobian.f90
-
-$O/check_mesh_resolution.o: constants.h check_mesh_resolution.f90
- ${FCCOMPILE_CHECK} -c -o $O/check_mesh_resolution.o check_mesh_resolution.f90
-
-$O/detect_surface.o: constants.h detect_surface.f90
- ${FCCOMPILE_CHECK} -c -o $O/detect_surface.o detect_surface.f90
-
-$O/gll_library.o: constants.h gll_library.f90
- ${FCCOMPILE_CHECK} -c -o $O/gll_library.o gll_library.f90
-
-$O/get_jacobian_boundaries.o: constants.h get_jacobian_boundaries.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_jacobian_boundaries.o get_jacobian_boundaries.f90
-
-$O/get_flags_boundaries.o: constants.h get_flags_boundaries.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_flags_boundaries.o get_flags_boundaries.f90
-
-$O/get_cmt.o: constants.h get_cmt.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_cmt.o get_cmt.f90
-
-$O/create_movie_shakemap_AVS_DX_GMT.o: constants.h create_movie_shakemap_AVS_DX_GMT.f90 OUTPUT_FILES/surface_from_mesher.h
- ${FCCOMPILE_CHECK} -c -o $O/create_movie_shakemap_AVS_DX_GMT.o create_movie_shakemap_AVS_DX_GMT.f90
-
-$O/get_element_face.o: constants.h get_element_face.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_element_face.o get_element_face.f90
-
-$O/get_global.o: constants.h get_global.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_global.o get_global.f90
-
-$O/write_AVS_DX_global_faces_data.o: constants.h write_AVS_DX_global_faces_data.f90
- ${FCCOMPILE_CHECK} -c -o $O/write_AVS_DX_global_faces_data.o write_AVS_DX_global_faces_data.f90
-
-$O/write_AVS_DX_surface_data.o: constants.h write_AVS_DX_surface_data.f90
- ${FCCOMPILE_CHECK} -c -o $O/write_AVS_DX_surface_data.o write_AVS_DX_surface_data.f90
-
-$O/write_AVS_DX_global_data.o: constants.h write_AVS_DX_global_data.f90
- ${FCCOMPILE_CHECK} -c -o $O/write_AVS_DX_global_data.o write_AVS_DX_global_data.f90
-
-$O/write_VTK_data.o: constants.h write_VTK_data.f90
- ${FCCOMPILE_CHECK} -c -o $O/write_VTK_data.o write_VTK_data.f90
-
-$O/get_shape3D.o: constants.h get_shape3D.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_shape3D.o get_shape3D.f90
-
-$O/get_shape2D.o: constants.h get_shape2D.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_shape2D.o get_shape2D.f90
-
-$O/hex_nodes.o: constants.h hex_nodes.f90
- ${FCCOMPILE_CHECK} -c -o $O/hex_nodes.o hex_nodes.f90
-
-$O/netlib_specfun_erf.o: netlib_specfun_erf.f90
- ${FCCOMPILE_CHECK} -c -o $O/netlib_specfun_erf.o netlib_specfun_erf.f90
-
-$O/sort_array_coordinates.o: constants.h sort_array_coordinates.f90
- ${FCCOMPILE_CHECK} -c -o $O/sort_array_coordinates.o sort_array_coordinates.f90
-
-$O/save_arrays_solver.o: constants.h save_arrays_solver.f90
- ${FCCOMPILE_CHECK} -c -o $O/save_arrays_solver.o save_arrays_solver.f90
-
-$O/comp_source_time_function.o: constants.h comp_source_time_function.f90
- ${FCCOMPILE_CHECK} -c -o $O/comp_source_time_function.o comp_source_time_function.f90
-
-$O/read_topo_bathy_file.o: constants.h read_topo_bathy_file.f90
- ${FCCOMPILE_CHECK} -c -o $O/read_topo_bathy_file.o read_topo_bathy_file.f90
-
-$O/lagrange_poly.o: constants.h lagrange_poly.f90
- ${FCCOMPILE_CHECK} -c -o $O/lagrange_poly.o lagrange_poly.f90
-
-$O/recompute_jacobian.o: constants.h recompute_jacobian.f90
- ${FCCOMPILE_CHECK} -c -o $O/recompute_jacobian.o recompute_jacobian.f90
-
-
-$O/create_regions_mesh.o: constants.h create_regions_mesh.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_regions_mesh.o create_regions_mesh.f90
-
-$O/create_mass_matrices.o: constants.h create_mass_matrices.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_mass_matrices.o create_mass_matrices.f90
-
-$O/get_absorbing_boundary.o: constants.h get_absorbing_boundary.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_absorbing_boundary.o get_absorbing_boundary.f90
-
-$O/get_coupling_surfaces.o: constants.h get_coupling_surfaces.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_coupling_surfaces.o get_coupling_surfaces.f90
-
-$O/get_model.o: constants.h get_model.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_model.o get_model.f90
-
-$O/get_MPI.o: constants.h get_MPI.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_MPI.o get_MPI.f90
-
-$O/save_moho_arrays.o: constants.h save_moho_arrays.f90
- ${FCCOMPILE_CHECK} -c -o $O/save_moho_arrays.o save_moho_arrays.f90
-
-
-$O/create_name_database.o: constants.h create_name_database.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_name_database.o create_name_database.f90
-
-$O/create_serial_name_database.o: constants.h create_serial_name_database.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_serial_name_database.o create_serial_name_database.f90
-
-$O/define_derivation_matrices.o: constants.h define_derivation_matrices.f90
- ${FCCOMPILE_CHECK} -c -o $O/define_derivation_matrices.o define_derivation_matrices.f90
-
-$O/compute_arrays_source.o: constants.h compute_arrays_source.f90
- ${FCCOMPILE_CHECK} -c -o $O/compute_arrays_source.o compute_arrays_source.f90
-
-$O/get_attenuation_model.o: constants.h get_attenuation_model.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_attenuation_model.o get_attenuation_model.f90
-
-$O/compute_boundary_kernel.o: constants.h compute_boundary_kernel.f90
- ${FCCOMPILE_CHECK} -c -o $O/compute_boundary_kernel.o compute_boundary_kernel.f90
-
-$O/compute_kernels.o: constants.h compute_kernels.f90
- ${FCCOMPILE_CHECK} -c -o $O/compute_kernels.o compute_kernels.f90
-
-$O/combine_vol_data.o: constants.h combine_vol_data.f90
- ${FCCOMPILE_CHECK} -c -o $O/combine_vol_data.o combine_vol_data.f90
-
-$O/combine_surf_data.o: constants.h combine_surf_data.f90
- ${FCCOMPILE_CHECK} -c -o $O/combine_surf_data.o combine_surf_data.f90
-
-$O/prepare_assemble_MPI.o: constants.h prepare_assemble_MPI.f90
- ${FCCOMPILE_CHECK} -c -o $O/prepare_assemble_MPI.o prepare_assemble_MPI.f90
-
-$O/PML_init.o: constants.h PML_init.f90
- ${FCCOMPILE_CHECK} -c -o $O/PML_init.o PML_init.f90
-
-
-
-
-
-###
-### all obsolete files ?
-###
-#--obsolete
-#$O/mesh_vertical.o: constants.h mesh_vertical.f90
-# ${FCCOMPILE_CHECK} -c -o $O/mesh_vertical.o mesh_vertical.f90
-
-#--obsolete
-#$O/get_absorb.o: constants.h get_absorb.f90
-# ${FCCOMPILE_CHECK} -c -o $O/get_absorb.o get_absorb.f90
-
-#--obsolete
-#$O/interpolate_gocad_block_MR.o: constants.h interpolate_gocad_block_MR.f90
-# ${FCCOMPILE_CHECK} -c -o $O/interpolate_gocad_block_MR.o interpolate_gocad_block_MR.f90
-
-#--obsolete
-#$O/interpolate_gocad_block_HR.o: constants.h interpolate_gocad_block_HR.f90
-# ${FCCOMPILE_CHECK} -c -o $O/interpolate_gocad_block_HR.o interpolate_gocad_block_HR.f90
-
-#--obsolete
-#$O/socal_model.o: constants.h socal_model.f90
-# ${FCCOMPILE_CHECK} -c -o $O/socal_model.o socal_model.f90
-
-# --obsolete
-#$O/define_subregions.o: constants.h define_subregions.f90
-# ${FCCOMPILE_CHECK} -c -o $O/define_subregions.o define_subregions.f90
-
-# --obsolete
-#$O/define_subregions_heuristic.o: constants.h define_subregions_heuristic.f90
-# ${FCCOMPILE_CHECK} -c -o $O/define_subregions_heuristic.o define_subregions_heuristic.f90
-
-#--obsolete
-#$O/read_moho_map.o: constants.h read_moho_map.f90
-# ${FCCOMPILE_CHECK} -c -o $O/read_moho_map.o read_moho_map.f90
-
-#--obsolete
-#$O/compute_rho_estimate.o: constants.h compute_rho_estimate.f90
-# ${FCCOMPILE_CHECK} -c -o $O/compute_rho_estimate.o compute_rho_estimate.f90
-
-#--obsolete
-#$O/hauksson_model.o: constants.h hauksson_model.f90
-# ${FCCOMPILE_CHECK} -c -o $O/hauksson_model.o hauksson_model.f90
-
-#--obsolete
-#$O/salton_trough_gocad.o: constants.h salton_trough_gocad.f90
-# ${FCCOMPILE_CHECK} -c -o $O/salton_trough_gocad.o salton_trough_gocad.f90
-
-#--obsolete
-#$O/read_arrays_solver.o: constants.h OUTPUT_FILES/values_from_mesher.h read_arrays_solver.f90
-# ${FCCOMPILE_CHECK} -c -o $O/read_arrays_solver.o read_arrays_solver.f90
-
-#--obsolete
-#$O/read_arrays_buffers_solver.o: constants.h read_arrays_buffers_solver.f90
-# ${FCCOMPILE_CHECK} -c -o $O/read_arrays_buffers_solver.o read_arrays_buffers_solver.f90
-
-
-###
-### rule for the header file
-###
-
- at COND_PYRE_FALSE@OUTPUT_FILES/values_from_mesher.h: xcreate_header_file
- at COND_PYRE_FALSE@ ./xcreate_header_file
-
-###
-### C files below
-###
-
-$O/param_reader.o: param_reader.c
- ${CC} -c $(CFLAGS) -o $O/param_reader.o param_reader.c
-
-$O/write_c_binary.o: write_c_binary.c
- ${CC} -c $(CFLAGS) -o $O/write_c_binary.o write_c_binary.c
-
+clean: required
+ (rm -rf bin lib obj src/meshfem3D/*.mod src/generate_databases/*.mod src/specfem3D/*.mod)
Deleted: seismo/3D/SPECFEM3D/trunk/PML_init.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/PML_init.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/PML_init.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,1232 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-module PML_par
-
- use constants,only: CUSTOM_REAL
-
- !--------------------------------------------------------------------
- ! USER PARAMETERS
-
- ! damping profile coefficients:
- ! R: theoretical reflection coefficient after discretization
- real(kind=CUSTOM_REAL),parameter:: PML_damp_R = 1.e-3
-
- ! number of element layers for PML region
- ! default is 2 element layers
- integer :: PML_LAYERS = 2
-
- ! additional absorbing, Sommerfeld (^Stacey) condition at the boundaries
- logical,parameter:: PML_USE_SOMMERFELD = .false.
-
- !--------------------------------------------------------------------
-
- real(kind=CUSTOM_REAL):: PML_width
- real(kind=CUSTOM_REAL):: PML_width_min,PML_width_max
-
- ! PML element type flag
- integer,dimension(:),allocatable :: ispec_is_PML_inum
-
- ! PML global points
- integer,dimension(:),allocatable :: iglob_is_PML
-
- ! PML spectral elements
- integer,dimension(:),allocatable :: PML_ispec
- integer :: num_PML_ispec
-
- ! PML normal for each PML spectral element
- real(kind=CUSTOM_REAL),dimension(:,:),allocatable :: PML_normal
- ! PML damping coefficients d & dprime
- real(kind=CUSTOM_REAL),dimension(:,:,:,:),allocatable :: PML_damping_d,PML_damping_dprime
-
- !real(kind=CUSTOM_REAL),dimension(:),allocatable :: PML_damping_d_global
-
- ! PML interface
- integer,dimension(:),allocatable :: iglob_is_PML_interface
-
- ! mask ibool needed for time marching
- logical,dimension(:),allocatable :: PML_mask_ibool
-
- ! PML damping flag
- logical:: PML = .false.
-
-end module PML_par
-
-!--------
-
-module PML_par_acoustic
-
- ! potentials split into 4 terms plus temporary potential:
- ! chi = chi1 + chi2 + chi3 + chi4
- ! temporary: chi2_t = (\partial_t + d ) chi2
-
- use constants,only: CUSTOM_REAL
-
- real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: &
- chi1,chi2,chi2_t,chi3,chi4
- real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: &
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot
- real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: &
- chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot
-
-end module PML_par_acoustic
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_damping_profile_l(d,x,vp,delta)
-
-! calculates damping coefficient value d for a given
-! x: distance x and
-! vp: p-velocity alpha
-! delta: PML width
-!
-! returns: d damping coefficients
- use PML_par,only: CUSTOM_REAL,PML_damp_R
- implicit none
- real(kind=CUSTOM_REAL),intent(out):: d
- real(kind=CUSTOM_REAL),intent(in):: x,vp,delta
-
- ! damping profile coefficients:
- ! d : damping function of (x)
- ! vp: P-velocity
- ! delta: width of PML layer
- ! R: theoretical reflection coefficient after discretization
-
- ! damping profile function: d = f(x)
- ! Komatitsch & Tromp, 2003: eq. 24 page 150
- d = 3.0*vp/(2.0*delta)*log(1.0/PML_damp_R)*x*x/(delta*delta)
-
-end subroutine PML_damping_profile_l
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_initialize()
-
- use specfem_par,only: NGLOB_AB,NSPEC_AB,myrank, &
- ibool,xstore,ystore,zstore,&
- model_speed_max,hdur
- use PML_par
- use PML_par_acoustic
- use constants,only: FIX_UNDERFLOW_PROBLEM,VERYSMALLVAL,IMAIN,&
- NGLLX,NGLLY,NGLLZ,TINYVAL
- use specfem_par_acoustic,only: ACOUSTIC_SIMULATION
- implicit none
-
- ! local parameters
- real(kind=CUSTOM_REAL):: d,dprime,d_glob,dprime_glob
- real(kind=CUSTOM_REAL) :: dominant_wavelength,hdur_max
- integer :: count,ilayer,sign
-
- ! sets flag
- PML = .true.
-
- ! user output
- if( myrank == 0 ) then
- write(IMAIN,*)
- write(IMAIN,*) 'incorporating PML '
- write(IMAIN,*)
- endif
-
- ! PML element type array: 1 = face, 2 = edge, 3 = corner
- allocate(ispec_is_PML_inum(NSPEC_AB))
- num_PML_ispec = 0
-
- ! PML interface points between PML and "regular" region
- allocate(iglob_is_PML_interface(NGLOB_AB))
- iglob_is_PML_interface(:) = 0
-
- ! PML global points
- allocate(iglob_is_PML(NGLOB_AB))
- iglob_is_PML(:) = 0
-
- ! PML ibool mask
- allocate(PML_mask_ibool(NGLOB_AB))
- PML_mask_ibool(:) = .false.
-
- ! determines dominant wavelength based on maximum model speed
- ! and source half time duration
- hdur_max = maxval(hdur(:))
- if( hdur_max > 0.0 ) then
- dominant_wavelength = model_speed_max * 2.0 * hdur_max
- else
- dominant_wavelength = 0._CUSTOM_REAL
- endif
-
- ! for multiple PML element layers
- ilayer = 0
- do while( ilayer < PML_LAYERS )
- ilayer = ilayer + 1
-
- if( ilayer == 1 ) then
- ! sets ispec occurrences for first element layer in PML region based on absorbing boundary elements
- call PML_set_firstlayer()
- else
- ! adds an additional element layer based on adjacent elements on PML interface points
- call PML_add_layer()
- endif
-
- ! update global interface points of PML region to "regular" domain
- call PML_determine_interfacePoints()
-
- ! optional? update PML width according to dominant wavelength
- !call PML_get_width()
- ! checks with wavelength criteria
- !if( dominant_wavelength > 0.0 ) then
- ! if( PML_width > dominant_wavelength/2.0 ) then
- ! PML_LAYERS = ilayer
- ! exit
- ! else
- ! PML_LAYERS = ilayer + 1
- ! endif
- !endif
- enddo
-
- ! checks PML normals at edges and corners,
- ! tries to gather elements at edges & corners
- do ilayer=1,PML_LAYERS-1
- call PML_update_normals(ilayer)
- enddo
-
- ! updates statistics global PML width
- call PML_get_width()
-
- ! pre-calculates damping profiles on PML points
- ! damping coefficients
- call PML_set_local_dampingcoeff()
-
- ! pre-calculates derivatives of damping coefficients
- call PML_determine_dprime()
-
- ! wavefield array initialization
- allocate(chi1(NGLLX,NGLLY,NGLLZ,num_PML_ispec),&
- chi2(NGLLX,NGLLY,NGLLZ,num_PML_ispec),&
- chi2_t(NGLLX,NGLLY,NGLLZ,num_PML_ispec),&
- chi3(NGLLX,NGLLY,NGLLZ,num_PML_ispec),&
- chi4(NGLLX,NGLLY,NGLLZ,num_PML_ispec))
- allocate(chi1_dot(NGLLX,NGLLY,NGLLZ,num_PML_ispec),&
- chi2_t_dot(NGLLX,NGLLY,NGLLZ,num_PML_ispec),&
- chi3_dot(NGLLX,NGLLY,NGLLZ,num_PML_ispec),&
- chi4_dot(NGLLX,NGLLY,NGLLZ,num_PML_ispec))
- allocate(chi1_dot_dot(NGLLX,NGLLY,NGLLZ,num_PML_ispec),&
- chi2_t_dot_dot(NGLLX,NGLLY,NGLLZ,num_PML_ispec),&
- chi3_dot_dot(NGLLX,NGLLY,NGLLZ,num_PML_ispec),&
- chi4_dot_dot(NGLLX,NGLLY,NGLLZ,num_PML_ispec))
-
- ! potentials
- chi1 = 0._CUSTOM_REAL
- chi2 = 0._CUSTOM_REAL
- chi2_t = 0._CUSTOM_REAL
- chi3 = 0._CUSTOM_REAL
- chi4 = 0._CUSTOM_REAL
-
- ! "velocity" potential
- chi1_dot = 0._CUSTOM_REAL
- chi2_t_dot = 0._CUSTOM_REAL
- chi3_dot = 0._CUSTOM_REAL
- chi4_dot = 0._CUSTOM_REAL
-
- ! "acceleration"/pressure potential
- chi1_dot_dot = 0._CUSTOM_REAL
- chi2_t_dot_dot = 0._CUSTOM_REAL
- chi3_dot_dot = 0._CUSTOM_REAL
- chi4_dot_dot = 0._CUSTOM_REAL
- if(FIX_UNDERFLOW_PROBLEM) then
- chi1_dot_dot = VERYSMALLVAL
- chi2_t_dot_dot = VERYSMALLVAL
- chi3_dot_dot = VERYSMALLVAL
- chi4_dot_dot = VERYSMALLVAL
- endif
-
- ! statistics user output
- d = maxval(abs(PML_damping_d(:,:,:,:)))
- if( d > TINYVAL ) then
- sign = maxval(PML_damping_d(:,:,:,:)) / maxval(abs(PML_damping_d(:,:,:,:)))
- else
- sign = 1.0
- endif
- dprime = maxval(abs(PML_damping_dprime(:,:,:,:)))
- call max_all_cr(d,d_glob)
- call max_all_cr(dprime,dprime_glob)
- call sum_all_i(num_PML_ispec,count)
- if( myrank == 0 ) then
- write(IMAIN,*)
- write(IMAIN,*) 'PML region: '
- write(IMAIN,*) ' total spectral elements:',count
- write(IMAIN,*) ' number of layers : ',PML_LAYERS
- write(IMAIN,*) ' dominant wavelength max: ',dominant_wavelength
- write(IMAIN,*) ' width min / max:',PML_width_min,PML_width_max
- write(IMAIN,*) ' reflection coefficient:',PML_damp_R
- write(IMAIN,*) ' maximum d : ',sign*d_glob
- write(IMAIN,*) ' maximum dprime : ',sign*dprime_glob
- write(IMAIN,*)
- endif
-
- ! VTK file output
- call PML_output_VTKs()
-
-end subroutine PML_initialize
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_set_firstlayer()
-
-! sets ispec occurrences for first element layer in PML region based on absorbing boundary elements
-
- use PML_par
- use specfem_par,only: NSPEC_AB,NGLOB_AB, &
- abs_boundary_ispec,abs_boundary_normal,num_abs_boundary_faces,&
- abs_boundary_ijk,ibool,myrank
- use constants,only: NDIM,TINYVAL,NGNOD,NGLLX,NGLLY,NGLLZ,NGLLSQUARE
- implicit none
- ! local parameters
- real(kind=CUSTOM_REAL),dimension(:,:),allocatable:: temp_ispec_pml_normal
- integer,dimension(:),allocatable:: temp_is_pml_elem
- integer:: iface,count,new_elemts,ispec,icorner,igll,iglobf
- integer:: i,j,k,iglobcount,iglobcorners(NGNOD)
- integer,dimension(3,NGNOD),parameter :: ielem_corner_ijk = &
- reshape((/ 1,1,1, 1,NGLLY,1, 1,NGLLY,NGLLZ, 1,1,NGLLZ, &
- NGLLX,1,1, NGLLX,NGLLY,1, NGLLX,NGLLY,NGLLZ, NGLLX,1,NGLLZ /),(/3,NGNOD/))
- ! temporary arrays
- allocate(temp_is_pml_elem(NSPEC_AB))
- allocate(temp_ispec_pml_normal(NDIM,NSPEC_AB))
-
- temp_is_pml_elem(:) = 0
- temp_ispec_pml_normal(:,:) = 0._CUSTOM_REAL
-
- count = 0
- do iface=1,num_abs_boundary_faces
- ! gets spectral elements with boundary face
- ispec = abs_boundary_ispec(iface)
-
- ! counts new PML elements
- if( temp_is_pml_elem(ispec) == 0 ) count = count + 1
-
- ! counts number of occurrences
- ! 1 : element with 1 face to regular one,
- ! 2 : element with 2 faces (elements at edges)
- ! 3 : element with 3 faces (elements at corners)
- temp_is_pml_elem(ispec) = temp_is_pml_elem(ispec) + 1
-
- ! adds contribution to element normal
- temp_ispec_pml_normal(:,ispec) = temp_ispec_pml_normal(:,ispec) + abs_boundary_normal(:,1,iface)
- enddo
- new_elemts = count
-
- ! doubling layers might have elements with only an edge on the absorbing surface
- ! poses problems if not accounted for
- count = 0
- do ispec = 1,NSPEC_AB
- ! only elements not recognized so far
- if( temp_is_pml_elem(ispec) > 0 ) cycle
-
- ! stores global indices of element corners
- do icorner=1,NGNOD
- i = ielem_corner_ijk(1,icorner)
- j = ielem_corner_ijk(2,icorner)
- k = ielem_corner_ijk(3,icorner)
- iglobcorners(icorner) = ibool(i,j,k,ispec)
- enddo
-
- ! checks if element has an edge (two corner points) on a absorbing boundary
- ! (refers mainly to elements in doubling layers)
- do iface=1,num_abs_boundary_faces
- ! checks if already encountered this element
- if( abs_boundary_ispec(iface) == ispec ) exit
-
- ! loops over face points
- iglobcount = 0
- do igll=1,NGLLSQUARE
- i = abs_boundary_ijk(1,igll,iface)
- j = abs_boundary_ijk(2,igll,iface)
- k = abs_boundary_ijk(3,igll,iface)
- iglobf = ibool(i,j,k,abs_boundary_ispec(iface))
- ! checks with corners
- do icorner=1,NGNOD
- if( iglobcorners(icorner) == iglobf ) iglobcount = iglobcount + 1
- enddo
- enddo
-
- ! adds as pml element
- if( iglobcount >= 2 ) then
- ! counter
- if( temp_is_pml_elem(ispec) == 0 ) count = count + 1
- temp_is_pml_elem(ispec) = temp_is_pml_elem(ispec) + 1
- ! updates normal
- temp_ispec_pml_normal(:,ispec) = temp_ispec_pml_normal(:,ispec) &
- + abs_boundary_normal(:,1,iface)
- exit
- endif
- enddo ! iface
-
- enddo
- new_elemts = new_elemts + count
-
- ! stores PML element indices and resulting normal
- call PML_set_elements(temp_is_pml_elem,temp_ispec_pml_normal,new_elemts)
-
- deallocate( temp_is_pml_elem)
- deallocate( temp_ispec_pml_normal)
-
-end subroutine PML_set_firstlayer
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_set_elements(temp_is_pml_elem,temp_ispec_pml_normal,new_elemts)
-
-! adds new elements to PML region
-
- use PML_par
- use specfem_par,only: NSPEC_AB,myrank
- use constants,only: NDIM,TINYVAL
- implicit none
-
- integer:: temp_is_pml_elem(NSPEC_AB)
- real(kind=CUSTOM_REAL):: temp_ispec_pml_normal(NDIM,NSPEC_AB)
- integer:: new_elemts
-
- ! local parameters
- real(kind=CUSTOM_REAL) :: length
- integer :: ispec,ispecPML
-
- ! sets new element type flags
- ispec_is_PML_inum(:) = temp_is_pml_elem(:)
-
- ! sets new number of elements
- num_PML_ispec = new_elemts
-
- ! re-allocates arrays
- if( allocated(PML_normal) ) deallocate(PML_normal)
- if( allocated(PML_ispec) ) deallocate(PML_ispec)
- allocate(PML_ispec(num_PML_ispec))
- allocate(PML_normal(NDIM,num_PML_ispec))
-
- ! stores PML elements flags and normals
- ispecPML = 0
- do ispec=1,NSPEC_AB
- if( ispec_is_PML_inum(ispec) > 0 ) then
- ! stores indices
- ispecPML = ispecPML+1
- PML_ispec(ispecPML) = ispec
-
- ! gets resulting element normal
- PML_normal(:,ispecPML) = temp_ispec_pml_normal(:,ispec)
-
- ! normalizes normal
- length = sqrt( PML_normal(1,ispecPML)**2 &
- + PML_normal(2,ispecPML)**2 &
- + PML_normal(3,ispecPML)**2 )
- if( length < TINYVAL ) then
- print*,'error set elements: normal length:',length
- print*,'elem:',ispec,ispecPML
- print*,'num_pml_ispec:',num_PML_ispec
- call exit_mpi(myrank,'error PML normal length')
- else
- ! normalizes normal
- PML_normal(:,ispecPML) = PML_normal(:,ispecPML)/length
- endif
- endif
- enddo
- if( ispecPML /= num_PML_ispec) call exit_mpi(myrank,'PML add layer count error')
-
-end subroutine PML_set_elements
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_determine_interfacePoints()
-
-! finds global interface points of PML region to "regular" domain
-
- use specfem_par,only: ibool,myrank,NGLOB_AB,NSPEC_AB, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh,NPROC
- use PML_par
- use PML_par_acoustic
- use constants,only: NGLLX,NGLLY,NGLLZ
- use specfem_par_acoustic,only: ispec_is_acoustic,ACOUSTIC_SIMULATION
- implicit none
-
- ! local parameters
- integer,dimension(:),allocatable:: temp_regulardomain
- integer:: i,j,k,ispec,iglob
-
- ! PML interface points array
- iglob_is_PML_interface(:) = 0
-
- ! temporary arrays
- allocate(temp_regulardomain(NGLOB_AB))
- temp_regulardomain(:) = 0
-
- ! global PML points
- iglob_is_PML(:) = 0
-
- ! sets flags on PML and regular domain points
- do ispec=1,NSPEC_AB
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
- ! sets flag for PML/regular domain
- if( ispec_is_PML_inum(ispec) > 0 ) then
- ! global points
- iglob_is_PML(iglob) = iglob_is_PML(iglob) + 1
- else
- ! not a PML point
- temp_regulardomain(iglob) = temp_regulardomain(iglob) + 1
- endif
- enddo
- enddo
- enddo
- enddo
-
- ! assemble on MPI interfaces
- call assemble_MPI_scalar_i_ext_mesh(NPROC,NGLOB_AB,iglob_is_PML, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh)
- call assemble_MPI_scalar_i_ext_mesh(NPROC,NGLOB_AB,temp_regulardomain, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh)
-
- ! stores interface points
- do ispec=1,NSPEC_AB
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
- ! checks if it belongs to both, PML and regular domain
- if( temp_regulardomain(iglob) > 0 .and. iglob_is_PML(iglob) > 0 ) then
- ! increases flag on global point
- iglob_is_PML_interface(iglob) = iglob_is_PML_interface(iglob) + 1
- endif
- enddo
- enddo
- enddo
- enddo
-
- deallocate(temp_regulardomain)
-
-end subroutine PML_determine_interfacePoints
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-
-subroutine PML_get_width()
-
-! calculates PML width for statistics
-
- use specfem_par,only: abs_boundary_ispec,abs_boundary_normal,abs_boundary_ijk,&
- num_abs_boundary_faces,&
- ibool,xstore,ystore,zstore,myrank, &
- NGLOB_AB
- use PML_par
- use constants,only: NGLLSQUARE,TINYVAL,HUGEVAL
- implicit none
-
- ! local parameters
- real(kind=CUSTOM_REAL) :: length,width
- integer:: i,j,k,ispec,iglob,iface,igll,iglobf
-
- ! determines global PML width
- ! loops over domain surface
- width = HUGEVAL
- do iface=1,num_abs_boundary_faces
-
- ispec = abs_boundary_ispec(iface)
-
- ! avoids taking corner or edge elements for width
- if( ispec_is_PML_inum(ispec) > 1 ) cycle
-
- ! determines smallest distance to interface points
- do iglob=1,NGLOB_AB
- if( iglob_is_PML_interface(iglob) > 0 ) then
- ! loops over face points
- do igll=1,NGLLSQUARE
- i = abs_boundary_ijk(1,igll,iface)
- j = abs_boundary_ijk(2,igll,iface)
- k = abs_boundary_ijk(3,igll,iface)
-
- ! takes distance between two points
- iglobf = ibool(i,j,k,ispec)
- length = sqrt((xstore(iglobf)-xstore(iglob))**2 &
- + (ystore(iglobf)-ystore(iglob))**2 &
- + (zstore(iglobf)-zstore(iglob))**2 )
-
- ! checks length
- if( length < TINYVAL ) then
- print*,'PML:',myrank,'length:',length
- print*,' ijk:',i,j,k,ispec,'face:',iface,'iglob:',iglobf
- print*,' ijk xyz:',xstore(iglobf),ystore(iglobf),zstore(iglobf)
- print*,' iglob interface',iglob
- print*,' iglob xyz:',xstore(iglob),ystore(iglob),zstore(iglob)
- call exit_mpi(myrank,'PML length zero error')
- endif
-
- ! updates minimum width
- if( length < width ) width = length
-
- enddo
- endif
- enddo
- enddo
-
- ! determines maximum width on all MPI processes
- ! all process gets overall maximum
- call max_all_all_cr(width,PML_width_max)
- call min_all_all_cr(width,PML_width_min)
-
- ! sets PML width
- if( PML_width_min > TINYVAL ) then
- PML_width = PML_width_min
- else
- PML_width = PML_width_max
- endif
-
- ! checks
- if( PML_width < TINYVAL ) call exit_mpi(myrank,'PML width error: width too small')
-
-end subroutine PML_get_width
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_set_local_dampingcoeff()
-
-! calculates damping profiles on PML points
-
- use specfem_par,only: ibool,xstore,ystore,zstore,myrank, &
- kappastore,mustore,NGLOB_AB,&
- abs_boundary_ispec,abs_boundary_ijk,num_abs_boundary_faces
- use specfem_par_acoustic,only: ACOUSTIC_SIMULATION,rhostore
- use specfem_par_elastic,only: ELASTIC_SIMULATION,rho_vp
- use PML_par
- use constants,only: NGLLX,NGLLY,NGLLZ,HUGEVAL,FOUR_THIRDS,NGLLSQUARE,TINYVAL
- implicit none
-
- ! local parameters
- real(kind=CUSTOM_REAL) :: length
- real(kind=CUSTOM_REAL) :: dist,vp
- real(kind=CUSTOM_REAL) :: d
- real(kind=CUSTOM_REAL) :: width
-
- integer:: i,j,k,ispec,iglob,ispecPML,iglobf
- integer:: ispecB,igll,iface
-
- ! stores damping coefficient
- allocate( PML_damping_d(NGLLX,NGLLY,NGLLZ,num_PML_ispec))
- PML_damping_d(:,:,:,:) = 0._CUSTOM_REAL
-
- ! loops over all PML elements
- do ispecPML=1,num_PML_ispec
-
- ispec = PML_ispec(ispecPML)
-
- ! determines smallest distance to interface points
- ! and determines smallest distance to absorbing boundary points
- ! (note: MPI partitioning not considered here yet; might be a problem)
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- ! global index
- iglobf = ibool(i,j,k,ispec)
-
- ! ensures that PML interface points have zero damping coefficients
- if( iglob_is_PML_interface(iglobf) > 0 ) then
- PML_damping_d(i,j,k,ispecPML) = 0._CUSTOM_REAL
- cycle
- endif
-
- ! distance to PML interface points
- dist = HUGEVAL
- do iglob=1,NGLOB_AB
- if( iglob_is_PML_interface(iglob) > 0 ) then
- ! distance to interface
- length = (xstore(iglobf)-xstore(iglob))**2 &
- + (ystore(iglobf)-ystore(iglob))**2 &
- + (zstore(iglobf)-zstore(iglob))**2
- if( length < dist ) dist = length
- endif
- enddo !iglob
- !dist = distances(i,j,k)
- if( dist >= HUGEVAL ) then
- dist = PML_width_max
- else
- dist = sqrt( dist )
- endif
-
- ! distance to boundary points
- width = HUGEVAL
- do iface=1,num_abs_boundary_faces
- ispecB = abs_boundary_ispec(iface)
- do igll=1,NGLLSQUARE
- iglob = ibool(abs_boundary_ijk(1,igll,iface),&
- abs_boundary_ijk(2,igll,iface),&
- abs_boundary_ijk(3,igll,iface),ispecB)
- ! distance to boundary
- length = (xstore(iglobf)-xstore(iglob))**2 &
- + (ystore(iglobf)-ystore(iglob))**2 &
- + (zstore(iglobf)-zstore(iglob))**2
- if( length < width ) width = length
- enddo
- enddo ! iface
- ! apparent width of PML for this point
- if( width >= HUGEVAL ) then
- width = PML_width_max
- else
- width = sqrt( width ) + dist
- endif
-
- ! checks width
- if( width < TINYVAL ) then
- print*,'error: pml width ',width
- print*,'ijk:',ispec,i,j,k
- print*,'xyz:',xstore(ibool(i,j,k,ispec)),ystore(ibool(i,j,k,ispec)),zstore(ibool(i,j,k,ispec))
- print*,'dist:',dist
- print*,'pml min/max:',PML_width_max,PML_width_min
- call exit_mpi(myrank,'PML error getting width')
- endif
-
- ! P-velocity
- if( ACOUSTIC_SIMULATION ) then
- vp = sqrt( kappastore(i,j,k,ispec)/rhostore(i,j,k,ispec) )
- else if( ELASTIC_SIMULATION ) then
- vp = (FOUR_THIRDS * mustore(i,j,k,ispec) + kappastore(i,j,k,ispec)) &
- / rho_vp(i,j,k,ispec)
- else
- call exit_mpi(myrank,'PML error getting vp')
- endif
-
- ! gets damping coefficient
- call PML_damping_profile_l(d,dist,vp,width)
-
- ! stores d & dprime for this element's GLL points
- PML_damping_d(i,j,k,ispecPML) = d
-
- enddo
- enddo
- enddo
- enddo !ispecPML
-
-end subroutine PML_set_local_dampingcoeff
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_determine_dprime()
-
-! calculates derivatives dprime of damping coefficients on GLL points
-
- use PML_par
- use PML_par_acoustic
- use constants,only: NGLLX,NGLLY,NGLLZ
- use specfem_par,only: xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz,&
- hprime_xx,hprime_yy,hprime_zz
- implicit none
- ! local parameters
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLZ,NGLLZ) :: dprime_elem
- real(kind=CUSTOM_REAL) :: xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl
- real(kind=CUSTOM_REAL) :: nx,ny,nz
- real(kind=CUSTOM_REAL) :: d_dx,d_dy,d_dz,tempd_dx,tempd_dy,tempd_dz
- integer :: ispec,i,j,k,l,ispecPML
-
- ! dprime derivatives
- allocate( PML_damping_dprime(NGLLX,NGLLY,NGLLZ,num_PML_ispec))
- PML_damping_dprime(:,:,:,:) = 0._CUSTOM_REAL
-
- ! loops over all PML elements
- do ispecPML=1,num_PML_ispec
-
- ispec = PML_ispec(ispecPML)
-
- ! PML normal
- nx = PML_normal(1,ispecPML)
- ny = PML_normal(2,ispecPML)
- nz = PML_normal(3,ispecPML)
-
- ! calculates terms:
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- ! derivative along x, y, z
- ! first double loop over GLL points to compute and store gradients
- ! we can merge the loops because NGLLX == NGLLY == NGLLZ
- tempd_dx = 0._CUSTOM_REAL
- tempd_dy = 0._CUSTOM_REAL
- tempd_dz = 0._CUSTOM_REAL
- do l = 1,NGLLX
- tempd_dx = tempd_dx + PML_damping_d(l,j,k,ispecPML)*hprime_xx(i,l)
- tempd_dy = tempd_dy + PML_damping_d(i,l,k,ispecPML)*hprime_yy(j,l)
- tempd_dz = tempd_dz + PML_damping_d(i,j,l,ispecPML)*hprime_zz(k,l)
- enddo
-
- ! get derivatives of potential with respect to x, y and z
- xixl = xix(i,j,k,ispec)
- xiyl = xiy(i,j,k,ispec)
- xizl = xiz(i,j,k,ispec)
- etaxl = etax(i,j,k,ispec)
- etayl = etay(i,j,k,ispec)
- etazl = etaz(i,j,k,ispec)
- gammaxl = gammax(i,j,k,ispec)
- gammayl = gammay(i,j,k,ispec)
- gammazl = gammaz(i,j,k,ispec)
-
- ! derivatives dprime
- d_dx = xixl*tempd_dx + etaxl*tempd_dy + gammaxl*tempd_dz
- d_dy = xiyl*tempd_dx + etayl*tempd_dy + gammayl*tempd_dz
- d_dz = xizl*tempd_dx + etazl*tempd_dy + gammazl*tempd_dz
- dprime_elem(i,j,k) = d_dx*nx + d_dy*ny + d_dz*nz
-
- enddo
- enddo
- enddo
-
- ! stores dprime coefficients
- PML_damping_dprime(:,:,:,ispecPML) = dprime_elem(:,:,:)
-
- enddo
-
-end subroutine PML_determine_dprime
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_add_layer()
-
-! adds an element layer to the PML region
-
- use PML_par
- use specfem_par,only: NSPEC_AB,NGLOB_AB, &
- abs_boundary_ispec,abs_boundary_normal,num_abs_boundary_faces,&
- ibool,myrank,&
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh,NPROC
- use constants,only: NDIM,TINYVAL,NGLLX,NGLLY,NGLLZ,NGNOD2D
- implicit none
-
- ! local parameters
- real(kind=CUSTOM_REAL),dimension(:,:),allocatable:: iglob_pml_normal
- real(kind=CUSTOM_REAL),dimension(:,:),allocatable:: ispec_pml_normal
- integer,dimension(:),allocatable:: is_pml_elem
- integer:: i,j,k,iglob,count,ispecPML,ispec,new_elemts
- integer :: iface,icorner,ipmlcorners
-
- integer,dimension(3,4),parameter :: iface1_corner_ijk = &
- reshape((/ 1,1,1, 1,NGLLY,1, 1,NGLLY,NGLLZ, 1,1,NGLLZ /),(/3,4/)) ! xmin
- integer,dimension(3,4),parameter :: iface2_corner_ijk = &
- reshape((/ NGLLX,1,1, NGLLX,NGLLY,1, NGLLX,NGLLY,NGLLZ, NGLLX,1,NGLLZ /),(/3,4/)) ! xmax
- integer,dimension(3,4),parameter :: iface3_corner_ijk = &
- reshape((/ 1,1,1, 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,1,1 /),(/3,4/)) ! ymin
- integer,dimension(3,4),parameter :: iface4_corner_ijk = &
- reshape((/ 1,NGLLY,1, NGLLX,NGLLY,1, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),(/3,4/)) ! ymax
- integer,dimension(3,4),parameter :: iface5_corner_ijk = &
- reshape((/ 1,1,1, 1,NGLLY,1, NGLLX,NGLLY,1, NGLLX,1,1 /),(/3,4/)) ! bottom
- integer,dimension(3,4),parameter :: iface6_corner_ijk = &
- reshape((/ 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),(/3,4/)) ! top
- integer,dimension(3,4,6),parameter :: iface_all_corner_ijk = &
- reshape((/ iface1_corner_ijk,iface2_corner_ijk, &
- iface3_corner_ijk,iface4_corner_ijk, &
- iface5_corner_ijk,iface6_corner_ijk /),(/3,4,6/)) ! all faces
- ! midpoint indices for each face (xmin,xmax,ymin,ymax,zmin,zmax)
- integer,dimension(3,6),parameter :: iface_all_midpointijk = &
- reshape( (/ 1,2,2, NGLLX,2,2, 2,1,2, 2,NGLLY,2, 2,2,1, 2,2,NGLLZ /),(/3,6/))
- logical :: is_done
-
- ! temporary arrays
- allocate(is_pml_elem(NSPEC_AB))
- allocate(iglob_pml_normal(NDIM,NGLOB_AB))
- allocate(ispec_pml_normal(NDIM,NSPEC_AB))
-
- iglob_pml_normal(:,:) = 0._CUSTOM_REAL
- ispec_pml_normal(:,:) = 0._CUSTOM_REAL
-
- ! sets pml normals on PML interface, global points
- do ispecPML=1,num_PML_ispec
-
- ispec = PML_ispec(ispecPML)
- ! checks
- if( ispec_is_PML_inum(ispec) < 1 ) call exit_mpi(myrank,'PML error add ispec layer')
-
- ! starts from first layer elements
- ! stores normal information on temporary global points
- if( ispec_is_PML_inum(ispec) >= 1 ) then
- ! stores PML normal on interface points
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
- if( iglob_is_PML_interface(iglob) > 0 ) then
- iglob_pml_normal(:,iglob) = iglob_pml_normal(:,iglob) + PML_normal(:,ispecPML)
- endif
- enddo
- enddo
- enddo
- endif
-
- enddo
-
- ! assembles with other MPI processes
- call assemble_MPI_vector_ext_mesh(NPROC,NGLOB_AB,iglob_pml_normal, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh)
-
-
- ! adds new elements sharing PML interface
- count = 0
- is_pml_elem(:) = 0
- do ispec=1,NSPEC_AB
-
- ! checks if we already have this element set as pml element in first layer
- is_done = .false.
- do ispecPML=1,num_PML_ispec
- if( PML_ispec(ispecPML) == ispec ) then
- ! adds as pml element
- if(is_pml_elem(ispec) == 0) count = count + 1
- ! copies normal
- ispec_pml_normal(:,ispec) = PML_normal(:,ispecPML)
- ! copies element type flag
- is_pml_elem(ispec) = ispec_is_PML_inum(ispec)
-
- is_done = .true.
- exit
- endif
- enddo
- if( is_done ) cycle
-
- ! loops over element faces
- do iface=1,6
- ipmlcorners = 0
- do icorner=1,NGNOD2D
- i = iface_all_corner_ijk(1,icorner,iface)
- j = iface_all_corner_ijk(2,icorner,iface)
- k = iface_all_corner_ijk(3,icorner,iface)
- iglob = ibool(i,j,k,ispec)
- if( iglob_is_PML_interface(iglob) > 0 ) ipmlcorners = ipmlcorners + 1
- enddo
-
- ! face is pml interface
- if( ipmlcorners == NGNOD2D ) then
- ! counts new pml elements
- if(is_pml_elem(ispec) == 0) count = count + 1
-
- ! increments flag
- is_pml_elem(ispec) = is_pml_elem(ispec) + 1
-
- ! sets normal
- ! reference midpoint on face
- i = iface_all_midpointijk(1,iface)
- j = iface_all_midpointijk(2,iface)
- k = iface_all_midpointijk(3,iface)
- iglob = ibool(i,j,k,ispec)
- if( iglob_is_PML_interface(iglob) < 1 ) call exit_mpi(myrank,'PML error midpoint interface')
-
- ! checks new normal
- if( sqrt(iglob_pml_normal(1,iglob)**2+iglob_pml_normal(2,iglob)**2 &
- +iglob_pml_normal(3,iglob)**2) < TINYVAL ) then
- print*,'error add layer: normal length zero: iglob',iglob
- print*,'face ',iface,ipmlcorners
- print*,'ijk ispec',i,j,k,ispec
- call exit_mpi(myrank,'PML add layer has new normal length error')
- endif
-
- ! adds contribution to normal
- ispec_pml_normal(:,ispec) = ispec_pml_normal(:,ispec) + iglob_pml_normal(:,iglob)
- endif
-
- enddo ! iface
- enddo ! ispec
- new_elemts = count
-
- ! adds new pml elements to PML region
- call PML_set_elements(is_pml_elem,ispec_pml_normal,new_elemts)
-
-end subroutine PML_add_layer
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_update_normals(ilayer)
-
-! updates normal's directions for elements in PML region
-
- use PML_par
- use specfem_par,only: NSPEC_AB,NGLOB_AB, &
- ibool,myrank,&
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh,NPROC
- use constants,only: NGNOD2D,NGLLX,NGLLY,NGLLZ
- implicit none
- integer :: ilayer
-
- ! local parameters
- integer:: iglob,ispecPML,ispec
- integer :: iface,icorner
- integer :: ipmlcorners,ipmledges,ipmlsngl
- integer :: ipmlcorners_tot,ipmledges_tot,ipmlsngl_tot
-
- integer,dimension(3,4),parameter :: iface1_corner_ijk = &
- reshape((/ 1,1,1, 1,NGLLY,1, 1,NGLLY,NGLLZ, 1,1,NGLLZ /),(/3,4/)) ! xmin
- integer,dimension(3,4),parameter :: iface2_corner_ijk = &
- reshape((/ NGLLX,1,1, NGLLX,NGLLY,1, NGLLX,NGLLY,NGLLZ, NGLLX,1,NGLLZ /),(/3,4/)) ! xmax
- integer,dimension(3,4),parameter :: iface3_corner_ijk = &
- reshape((/ 1,1,1, 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,1,1 /),(/3,4/)) ! ymin
- integer,dimension(3,4),parameter :: iface4_corner_ijk = &
- reshape((/ 1,NGLLY,1, NGLLX,NGLLY,1, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),(/3,4/)) ! ymax
- integer,dimension(3,4),parameter :: iface5_corner_ijk = &
- reshape((/ 1,1,1, 1,NGLLY,1, NGLLX,NGLLY,1, NGLLX,1,1 /),(/3,4/)) ! bottom
- integer,dimension(3,4),parameter :: iface6_corner_ijk = &
- reshape((/ 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),(/3,4/)) ! top
- integer,dimension(3,4,6),parameter :: iface_all_corner_ijk = &
- reshape((/ iface1_corner_ijk,iface2_corner_ijk, &
- iface3_corner_ijk,iface4_corner_ijk, &
- iface5_corner_ijk,iface6_corner_ijk /),(/3,4,6/)) ! all faces
- integer:: ispecngb,iadj,ipmlinterface
- integer :: ispecPMLngb_corner,ispecPMLngb_edge,ispecPMLngb_sngl
- integer,dimension(:),allocatable :: iglob_nadj,ispec_is_PML_inum_org
- integer,dimension(:,:,:),allocatable :: iglob_adj
-
-
- ! checks normals for elements adjacent to edge/corner elements
- ! assigns element information to each global point
- ! (note: mpi partitioning/interface between elements not considered yet)
- allocate(iglob_nadj(NGLOB_AB),iglob_adj(2,32,NGLOB_AB))
- iglob_nadj(:) = 0
- iglob_adj(:,:,:) = 0
- do ispecPML=1,num_PML_ispec
- ispec = PML_ispec(ispecPML)
- ! sets element corners
- do iface=1,2
- do icorner=1,NGNOD2D
- iglob = ibool(iface_all_corner_ijk(1,icorner,iface),&
- iface_all_corner_ijk(2,icorner,iface),&
- iface_all_corner_ijk(3,icorner,iface),ispec)
- ! number of occurrences
- iglob_nadj(iglob) = iglob_nadj(iglob) + 1
- ! first parameter is assigned element id ispec
- iglob_adj(1,iglob_nadj(iglob),iglob) = ispec
- ! second parameter is corresponding pml element id ispecPML
- iglob_adj(2,iglob_nadj(iglob),iglob) = ispecPML
- enddo
- enddo
- enddo
- if( maxval(iglob_nadj(:)) > 32 ) then
- print*,'info neighbors:',myrank
- print*,'max number of adjacents:',maxval(iglob_nadj(:)),maxloc(iglob_nadj(:))
- call exit_mpi(myrank,'error iglob number of adj')
- endif
-
- ! finds neighbors based on common nodes and changes type and normal accordingly
- ! for edges and corners
- allocate(ispec_is_PML_inum_org(NSPEC_AB))
- ispec_is_PML_inum_org(:) = ispec_is_PML_inum(:)
- do ispecPML=1,num_PML_ispec
- ispec = PML_ispec(ispecPML)
-
- ! only non-corner elements
- if( ispec_is_PML_inum_org(ispec) <= 2 ) then
- ipmlsngl_tot = 0
- ipmlcorners_tot = 0
- ipmledges_tot = 0
- ipmlinterface = 0
- ! loops over element corners
- do iface=1,2
- ! checks corner neighbors
- do icorner=1,NGNOD2D
- iglob = ibool(iface_all_corner_ijk(1,icorner,iface),&
- iface_all_corner_ijk(2,icorner,iface),&
- iface_all_corner_ijk(3,icorner,iface),ispec)
- ! adjacent elements
- ipmlsngl = 0
- ipmlcorners = 0
- ipmledges = 0
- do iadj=1,iglob_nadj(iglob)
- ispecngb = iglob_adj(1,iadj,iglob)
- if( ispecngb /= ispec ) then
- ! counts single normal neighbors
- if( ispec_is_PML_inum_org(ispecngb) == 1 ) then
- ipmlsngl = ipmlsngl + 1
- ispecPMLngb_sngl = iglob_adj(2,iadj,iglob)
- endif
- ! counts corner neighbors
- if( ispec_is_PML_inum_org(ispecngb) == 3 ) then
- ipmlcorners = ipmlcorners + 1
- ispecPMLngb_corner = iglob_adj(2,iadj,iglob)
- endif
- ! counts edge neighbors
- if( ispec_is_PML_inum_org(ispecngb) == 2 ) then
- ipmledges = ipmledges + 1
- ispecPMLngb_edge = iglob_adj(2,iadj,iglob)
- endif
- endif
- enddo
- if( ipmlsngl > 0 ) ipmlsngl_tot = ipmlsngl_tot + 1
- if( ipmlcorners > 0 ) ipmlcorners_tot = ipmlcorners_tot + 1
- if( ipmledges > 0 ) ipmledges_tot = ipmledges_tot + 1
-
- ! interface points
- if( iglob_is_PML_interface(iglob) > 0 ) ipmlinterface = ipmlinterface + 1
-
- enddo !icorner
- enddo
-
- ! elements inside PML
- if( ipmlinterface < 4 ) then
-
- ! shares two faces with edge elements, so it becomes an edge element too
- if( ispec_is_PML_inum_org(ispec) == 1 ) then
- if( ipmledges_tot >= 6 ) then
- ispec_is_PML_inum(ispec) = 2
- PML_normal(:,ispecPML) = PML_normal(:,ispecPMLngb_edge)
- endif
- if( ipmlcorners_tot >= 5 ) then
- ispec_is_PML_inum(ispec) = 3
- PML_normal(:,ispecPML) = PML_normal(:,ispecPMLngb_corner)
- endif
- else if( ispec_is_PML_inum_org(ispec) == 2 ) then
-
- ! shares at least a face and a face edge with a corner element,
- ! so it becomes a corner element too
- if( ipmlcorners_tot >= 5 ) then
- ispec_is_PML_inum(ispec) = 3
- PML_normal(:,ispecPML) = PML_normal(:,ispecPMLngb_corner)
- endif
- endif
- endif
- ! avoid elements between two edges and next to corner to become edge elements
- if( ispec_is_PML_inum(ispec) == 2 .and. ilayer > 1 ) then
- if( ipmlsngl_tot == 8 .and. ipmlcorners_tot == 2 ) then
- ispec_is_PML_inum(ispec) = 1
- PML_normal(:,ispecPML) = PML_normal(:,ispecPMLngb_sngl)
- endif
- endif
-
- endif
- enddo
- deallocate(iglob_adj,iglob_nadj)
- deallocate(ispec_is_PML_inum_org)
-
-end subroutine PML_update_normals
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_output_VTKs()
-
-! outputs informations about PML elements
-
- use PML_par
- use specfem_par,only: NGLOB_AB,NSPEC_AB,myrank, &
- prname,ibool,xstore,ystore,zstore
- use constants,only: NGLLX,NGLLY,NGLLZ,IMAIN
- implicit none
- ! local parameters
- real(kind=CUSTOM_REAL),dimension(:,:),allocatable:: ispec_normal
- real(kind=CUSTOM_REAL),dimension(:,:,:,:),allocatable:: temp_gllvalues
- integer,dimension(:),allocatable :: temp_iglob
- integer :: count,iglob,ispecPML,ispec
- character(len=256) :: vtkfilename
-
- ! element type flags
- if( .false. ) then
- vtkfilename = prname(1:len_trim(prname))//'PML_ispec_inum'
- call write_VTK_data_elem_i(NSPEC_AB,NGLOB_AB,xstore,ystore,zstore,ibool,&
- ispec_is_PML_inum,vtkfilename)
- endif
-
- ! interface points
- if( .false. ) then
- ! puts global points in a temporary array for plotting
- count = 0
- do iglob=1,NGLOB_AB
- if( iglob_is_PML_interface(iglob) > 0 ) then
- count = count+1
- endif
- enddo
- allocate(temp_iglob(count))
- count = 0
- do iglob=1,NGLOB_AB
- if( iglob_is_PML_interface(iglob) > 0 ) then
- count = count+1
- temp_iglob(count) = iglob
- endif
- enddo
- vtkfilename = prname(1:len_trim(prname))//'PML_interface_points'
- call write_VTK_data_points(NGLOB_AB,xstore,ystore,zstore, &
- temp_iglob,count,vtkfilename)
- deallocate(temp_iglob)
- endif
-
- ! pml normals
- if( .false. ) then
- allocate(ispec_normal(3,NSPEC_AB) )
- ispec_normal(:,:) = 0._CUSTOM_REAL
- do ispecPML=1,num_PML_ispec
- ispec = PML_ispec(ispecPML)
- ispec_normal(:,ispec) = PML_normal(:,ispecPML)
- enddo
- vtkfilename = prname(1:len_trim(prname))//'PML_normals'
- call write_VTK_data_elem_vectors(NSPEC_AB,NGLOB_AB,xstore,ystore,zstore,ibool, &
- ispec_normal,vtkfilename)
- deallocate(ispec_normal)
- endif
-
- ! pml damping coefficients
- if( .false. ) then
- allocate(temp_gllvalues(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- temp_gllvalues = 0._CUSTOM_REAL
- do ispecPML=1,num_PML_ispec
- ispec = PML_ispec(ispecPML)
- temp_gllvalues(:,:,:,ispec) = PML_damping_d(:,:,:,ispecPML)
- enddo
- vtkfilename = prname(1:len_trim(prname))//'PML_damping_d'
- call write_VTK_data_gll_cr(NSPEC_AB,NGLOB_AB, &
- xstore,ystore,zstore,ibool, &
- temp_gllvalues,vtkfilename)
- deallocate(temp_gllvalues)
- endif ! VTK file output
-
- if(myrank == 0) write(IMAIN,*)
-
-end subroutine PML_output_VTKs
\ No newline at end of file
Copied: seismo/3D/SPECFEM3D/trunk/README (from rev 17270, seismo/3D/SPECFEM3D/trunk/README_SPECFEM3D)
===================================================================
--- seismo/3D/SPECFEM3D/trunk/README (rev 0)
+++ seismo/3D/SPECFEM3D/trunk/README 2010-10-20 12:16:18 UTC (rev 17293)
@@ -0,0 +1,398 @@
+!=====================================================================
+!
+! S p e c f e m 3 D V e r s i o n 1 . 4
+! ---------------------------------------
+!
+! Dimitri Komatitsch and Jeroen Tromp
+! Seismological Laboratory - California Institute of Technology
+! (c) California Institute of Technology September 2006
+!
+! 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.
+!
+!=====================================================================
+!
+!=============================================================================!
+! !
+! specfem3D is a 3-D spectral-element solver for a local or regional model. !
+! It uses a mesh generated by program generate_databases !
+! !
+!=============================================================================!
+
+Instructions on how to install and use SPECFEM3D are
+available in the manual located in directory doc/USER_MANUAL
+and in file INSTALL.
+
+Main developers: Dimitri Komatitsch and Jeroen Tromp
+
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++++ NOTES ON USING THE SPECFEM3D PACKAGE +++++++++++
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+! If you use this code for your own research, please cite at least one article
+! written by the developers of the package, for instance:
+!
+! @ARTICLE{TrKoLi08,
+! author = {Jeroen Tromp and Dimitri Komatitsch and Qinya Liu},
+! title = {Spectral-Element and Adjoint Methods in Seismology},
+! journal = {Communications in Computational Physics},
+! year = {2008},
+! volume = {3},
+! pages = {1-32},
+! number = {1}}
+!
+! or
+!
+! @ARTICLE{LiPoKoTr04,
+! author = {Qinya Liu and Jascha Polet and Dimitri Komatitsch and Jeroen Tromp},
+! title = {Spectral-element moment tensor inversions for earthquakes in {S}outhern {C}alifornia},
+! journal={Bull. Seismol. Soc. Am.},
+! year = {2004},
+! volume = {94},
+! pages = {1748-1761},
+! number = {5},
+! doi = {10.1785/012004038}}
+!
+! @INCOLLECTION{ChKoViCaVaFe07,
+! author = {Emmanuel Chaljub and Dimitri Komatitsch and Jean-Pierre Vilotte and
+! Yann Capdeville and Bernard Valette and Gaetano Festa},
+! title = {Spectral Element Analysis in Seismology},
+! booktitle = {Advances in Wave Propagation in Heterogeneous Media},
+! publisher = {Elsevier - Academic Press},
+! year = {2007},
+! editor = {Ru-Shan Wu and Val\'erie Maupin},
+! volume = {48},
+! series = {Advances in Geophysics},
+! pages = {365-419}}
+!
+! @ARTICLE{KoVi98,
+! author={D. Komatitsch and J. P. Vilotte},
+! title={The spectral-element method: an efficient tool to simulate the seismic response of 2{D} and 3{D} geological structures},
+! journal={Bull. Seismol. Soc. Am.},
+! year=1998,
+! volume=88,
+! number=2,
+! pages={368-392}}
+!
+! @ARTICLE{KoTr99,
+! author={D. Komatitsch and J. Tromp},
+! year=1999,
+! title={Introduction to the spectral-element method for 3-{D} seismic wave propagation},
+! journal={Geophys. J. Int.},
+! volume=139,
+! number=3,
+! pages={806-822},
+! doi={10.1046/j.1365-246x.1999.00967.x}}
+!
+! @ARTICLE{KoLiTrSuStSh04,
+! author={Dimitri Komatitsch and Qinya Liu and Jeroen Tromp and Peter S\"{u}ss
+! and Christiane Stidham and John H. Shaw},
+! year=2004,
+! title={Simulations of Ground Motion in the {L}os {A}ngeles {B}asin
+! based upon the Spectral-Element Method},
+! journal={Bull. Seism. Soc. Am.},
+! volume=94,
+! number=1,
+! pages={187-206}}
+!
+! and/or another article from http://web.univ-pau.fr/~dkomati1/publications.html
+!
+!
+! If you use the kernel capabilities of the code, please cite at least one article
+! written by the developers of the package, for instance:
+!
+! @ARTICLE{TrKoLi08,
+! author = {Jeroen Tromp and Dimitri Komatitsch and Qinya Liu},
+! title = {Spectral-Element and Adjoint Methods in Seismology},
+! journal = {Communications in Computational Physics},
+! year = {2008},
+! volume = {3},
+! pages = {1-32},
+! number = {1}}
+!
+! or
+!
+! @ARTICLE{LiTr06,
+! author={Qinya Liu and Jeroen Tromp},
+! title={Finite-frequency kernels based on adjoint methods},
+! journal={Bull. Seismol. Soc. Am.},
+! year=2006,
+! volume=96,
+! number=6,
+! pages={2383-2397},
+! doi={10.1785/0120060041}}
+!
+!
+! Reference frame - convention:
+! ----------------------------
+!
+! The code uses the following convention for the reference frame:
+!
+! - X axis is East
+! - Y axis is North
+! - Z axis is up
+!
+! Note that this convention is different from both the Aki-Richards convention
+! and the Harvard CMT convention.
+!
+! Let us recall that the Aki-Richards convention is:
+!
+! - X axis is North
+! - Y axis is East
+! - Z axis is down
+!
+! and that the Harvard CMT convention is:
+!
+! - X axis is South
+! - Y axis is East
+! - Z axis is up
+!
+! To report bugs or suggest improvements to the code, please send an email
+! to Jeroen Tromp <jtromp AT princeton.edu> and/or use our online
+! bug tracking system at http://www.geodynamics.org/roundup .
+!
+
+PARAMETERS TO CHANGE ON DIFFERENT MACHINES:
+
+- Use the appropriate compiler flags in the Makefile.
+ Set F90, MPIF90, FLAGS_NO_CHECK, FLAGS_CHECK and MPI_FLAGS.
+ Also set C_PREPROCESSOR to activate C preprocessing
+ in your Fortran compiler (see the manual of your Fortran compiler for the right syntax)
+- In constants.h set LOCAL_PATH_IS_ALSO_GLOBAL flag.
+ On clusters (e.g., Beowulfs), set this option to .false. in almost all cases.
+- In constants.h set FIX_UNDERFLOW_PROBLEM flag
+ (need to fix underflow trapping on some machines, e.g., Pentium processors)
+- In Par_file set LOCAL_PATH (this is where databases are written and read)
+- In precision.h choose single versus double precision (double precision
+ doubles the memory requirements for the solver but may be faster)
+- Also, in constants.h choose the CUSTOM_REAL size depending on
+ single or double precision
+- When running on an SGI, add "setenv TRAP_FPE OFF" to your .cshrc file
+ before compiling, in order to turn underflow trapping off
+
+SCRIPTS:
+
+- go_mesher runs the mesher
+ (need to set the correct mpirun command at the end of the script)
+- go_solver runs the solver
+ (need to set the correct mpirun command at the end of the script)
+- runall compiles and runs both mesher and solver
+
+MESH GENERATION
+
+** With an external mesh generation tool such as CUBIT :
+
+- Create the mesh of your model.
+
+- Export the mesh in the following format (for CUBIT, we provide Python scripts to facilitate this step) :
+
+ nodes_coords_file : this contains the number of nodes on the first line, followed by the (x,y,z) coordinates for each node in meters.
+ number of nodes
+ id_node x_coordinate y_coordinate z_coordinate
+ .....
+
+ mesh_file : contains the number of elements on the first line, followed by the list of nodes (8 per element) that compose those elements.
+ format :
+ number of elements
+ id_elements id_node1 id_node2 id_node3 id_node4 id_node5 id_node6 id_node7 id_node8
+ .....
+
+ materials_file : associates an element with its material (an integer).
+ format :
+ id_element flag
+ ....
+
+ nummaterial_velocity_file : table of the material properties
+ flag rho vp vs 0 0 #full definition of the properties, flag > 0
+ .....
+ flag 'tomography' file_name #for interpolation with tomography
+ .....
+ flag 'interface' file_name flag_for_the_gll_below_the_interface flag_for_the_gll_above_the_interface #for
+ interpolation with interface
+ ....
+
+ absorbing_surface_file_xmin : contains all the face in the absorbing boundary defined by x=Xmin
+ format:
+ number of faces
+ id_(element containg the face) id_node1_face id_node2_face id_node3_face id_node4_face
+ ....
+
+ with the same format :
+ absorbing_surface_file_xmax : contains all the face in the absorbing boundary defined by x=Xmax
+ absorbing_surface_file_ymin : contains all the face in the absorbing boundary defined by y=Ymin
+ absorbing_surface_file_ymax : contains all the face in the absorbing boundary defined by y=Ymax
+ absorbing_surface_file_bottom : contains all the face in the absorbing boundary defined by z=bottom
+
+ free_surface_file = file with the hex on the free surface (usually the topography)
+ format:
+ number of faces
+ id_(element containg the face) id_node1_face id_node2_face id_node3_face id_node4_face
+ .....
+
+- Partition the mesh with the standalone program decompose_mesh_SCOTCH that calls the Scotch library.
+ It writes files named after the rank of the MPI process that will process this part
+
+** With meshfem3D:
+
+- The mesher generate_databases needs NPROC processors.
+- Note that NPROC = 1 is valid (in case you have a
+ machine with a small number of processors). Therefore the code can
+ if needed run serially on one processor only (in such a case,
+ still link with MPI, and use "mpirun -np 1")
+- In the Par_file, define the type of the mesh. The mesher and the solver
+ can use UTM coordinates internally, therefore you also need to define
+ the zone number for the UTM projection (e.g., zone 11 for Los Angeles).
+ Use decimal values for latitude and longitude (no minutes/seconds).
+ These values are approximate, the mesher will round them off to define
+ a square mesh in UTM coordinates.
+
+ UTM_PROJECTION_ZONE ! zone of the UTM projection (e.g. 11 for Los Angeles)
+
+CHECKING THE MESH (optional, after running the mesher):
+
+- Use the serial code check_mesh_quality_AVS_DX
+ ("make check_mesh_quality_AVS_DX" and then "xcheck_mesh_quality_AVS_DX")
+ to generate an AVS output file ("AVSmeshquality.inp" in AVS UCD format)
+ or an OpenDX output file ("DXmeshquality.dx")
+ that can be used to investigate mesh quality, e.g., skewness of elements,
+ and a Gnuplot histogram ("mesh_quality_histogram.txt") that can
+ be plotted with gnuplot ("gnuplot plot_mesh_quality_histogram.gnu")
+
+- Use the serial code combine_AVS_DX
+ ("make combine_AVS_DX" and then "xcombine_AVS_DX")
+ to generate AVS output files (in AVS UCD format) or OpenDX output files
+ showing the mesh, the MPI partition (slices), the source and receiver
+ location etc. Use the AVS UCD file AVS_coastline_freeways_LA.inp
+ or the OpenDX file DX_coastline_freeways_LA.dx for reference
+ in the Los Angeles area.
+
+DATABASES GENERATOR (generate_databases):
+
+- set all the parameters in DATA/Par_file, in particular the following:
+
+ OCEANS ! to incorporate the effects of the oceans (cheap)
+ ATTENUATION ! to include attenuation (fairly expensive)
+ ABSORBING_CONDITIONS ! absorbing boundary conditions (cheap)
+ SAVE_AVS_DX_MESH_FILES ! save mesh files for AVS users, www.avs.com,
+ or OpenDX users, www.opendx.org). Do not use if you do not have AVS
+ or OpenDX, because this option creates large files.
+
+- Compile the databases generator ("make generate_databases") and run it
+ for instance with the go_mesher script
+- Mesher output is provided in the OUTPUT_FILES directory in output_generate_databases.txt
+ (output can be directed to the screen instead by uncommenting two lines
+ in constants.h:
+ ! uncomment this to write messages to the screen
+ ! integer, parameter :: IMAIN = ISTANDARD_OUTPUT )
+- For a given model and set of processors, one only needs to run the databases_generator
+ once and for all
+- The databases generator filters the list of stations in file DATA/STATIONS to exclude
+ the stations that are not located within the region given in the Par_file
+ (between LATITUDE_MIN and LATITUDE_MAX, and between LONGITUDE_MIN and LONGITUDE_MAX).
+ The filtered file is called DATA/STATIONS_FILTERED
+- When running benchmarks on rectangular models, one can turn the UTM projection
+ off by using flag SUPPRESS_UTM_PROJECTION, in which case all "longitude"
+ parameters simply refer to the X axis, and all "latitude" parameters
+ simply refer to the Y axis.
+
+SOLVER (specfem3D):
+
+- For reasons of speed, the solver uses static memory allocation. Therefore it
+ needs to be recompiled every time one reruns the mesher. The mesher uses
+ dynamic allocation only, and does not need to be recompiled.
+- The solver needs NPROC processors (same as the mesher)
+- The solver needs the DATA/CMTSOLUTION file for the source and the
+ DATA/STATIONS file for the list of stations
+- Set the "time shift" in the CMTSOLUTION file to 0.0
+ (the solver will not run otherwise)
+- To simulate a delta source-time function, set "half duration" in
+ the CMTSOLUTION file to 0.0. If "half duration" is not zero,
+ the code will use a Gaussian (not too different from triangular)
+ source-time function with half-width "half duration". We prefer to run
+ the solver with "half duration" set to zero and convolve after the fact,
+ because this way it's easy to use a variety of source-time functions.
+ Use the serial code convolve_source_timefunction.f90 and the script
+ convolve_source_timefunction.csh for this purpose. (Set the parameter "hdur"
+ in convolve_source_timefunction.csh to the desired half-duration.)
+ (type "make convolve_source_timefunction" to compile the code).
+- To simulate multiple events, set the parameter NSOURCES in the DATA/Par_file
+ to the desired number. Provide a CMTSOLUTION file that has NSOURCES entries,
+ one for each CMT solution (i.e., concatenate NSOURCES CMTSOLUTION files
+ to a single CMTSOLUTION file). At least one entry should have a zero "time shift",
+ and all the other entries should have non-negative "time shift". Each event
+ can have its own half duration, latitude, longitude, depth and moment tensor.
+ This feature can also be used to mimic the directivity associated with a
+ finite source.
+- Solver output is provided in the OUTPUT_FILES directory in output_solver.txt
+ (output can be directed to the screen instead by uncommenting two lines
+ in constants.h:
+ ! uncomment this to write messages to the screen
+ ! integer, parameter :: IMAIN = ISTANDARD_OUTPUT )
+- If you have a fast machine, set NTSTEP_BETWEEN_OUTPUT_INFO
+ to a relatively high value (e.g. at least 100, or even 1000 or more)
+ to avoid writing to the output text files too often. Same thing
+ with NTSTEP_BETWEEN_OUTPUT_SEISMOS.
+- On clusters (e.g., Beowulfs) the seismogram files are distributed on the
+ local disks (option LOCAL_PATH_IS_ALSO_GLOBAL turned off) and need to be
+ gathered at the end of the simulation
+- For the same model, rerun the solver for different events by changing the
+ CMTSOLUTION file, or for different stations by changing the STATIONS file.
+ There is no need to rerun the mesher. It is best to include as many stations
+ as possible, since this does not add to the cost of the simulation.
+
+MOVIE OF THE RESULTS:
+
+- Use create_movie_AVS_DX.f90 ("make create_movie_AVS_DX") to create
+ a movie of surface displacement (vertical component) or of the entire
+ 3D wave field. The movie can be saved in OpenDX, AVS or GMT format.
+ Set parameters MOVIE_SURFACE, MOVIE_VOLUME, and NTSTEP_BETWEEN_FRAMES
+ in the Par_file. Remember to use a DATA/CMTSOLUTION source file
+ with a half-duration hdur > 0, otherwise you will get a movie
+ corresponding to a Heaviside source, with a lot of high-frequency noise.
+ Note that this option creates large files!
+ Also set CREATE_SHAKEMAP is you want to create a ShakeMap at the end
+ of the simulation.
+
+SERIAL RUNS (WITHOUT MPI):
+
+On a large serial machine, one may want to run a serial version of the code without MPI.
+To do this, one needs to:
+
+- set NPROC = 1 in DATA/Par_file
+- type "make generate_databases_serial" and "make specfem3D_serial" instead of
+ "make generate_databases" and "make specfem3D"
+- run the code serially with "./xgenerate_databases" and "./xspecfem3D"
+
+BUG REPORTS:
+
+To report bugs or suggest improvements to the code, please send an email
+to Jeroen Tromp <jtromp AT princeton.edu> and/or use our online
+bug tracking system at http://www.geodynamics.org/roundup .
+
+Note: The Gauss-Lobatto subroutines in gll_library.f90 are based in part on
+ software libraries from M.I.T., Department of Mechanical Engineering.
+
+Note: The non-structured global numbering software was provided by Paul F. Fischer.
+
+Note: Subroutines from "Numerical Recipes: The Art of Scientific Computing"
+ by W. H. Press et al., Cambridge University Press, are used in
+ numerical_recipes.f90. The user must acquire an official
+ Numerical Recipes license to run them.
+
+Note: Subroutine utm_geo.f90 contains UTM (Universal Transverse Mercator)
+ projection software from the USGS.
+
+Note: AVS is a trademark of Advanced Visualization Systems, www.avs.com
+ OpenDX is based on IBM Data Explorer, www.opendx.org
+
Deleted: seismo/3D/SPECFEM3D/trunk/README_SPECFEM3D
===================================================================
--- seismo/3D/SPECFEM3D/trunk/README_SPECFEM3D 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/README_SPECFEM3D 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,361 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-!
-!=============================================================================!
-! !
-! specfem3D is a 3-D spectral-element solver for a local or regional model. !
-! It uses a mesh generated by program generate_databases !
-! !
-!=============================================================================!
-
-Instructions on how to install and use SPECFEM3D are
-available in the manual located in directory USER_MANUAL.
-
-Main developers: Dimitri Komatitsch and Jeroen Tromp
-
-Additional contributions by:
-
-Qinya Liu
-Min Chen
-
-
-++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-+++++++++ NOTES ON USING THE SPECFEM3D PACKAGE +++++++++++
-++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-! If you use this code for your own research, please cite at least one article
-! written by the developers of the package, for instance:
-!
-! @ARTICLE{TrKoLi08,
-! author = {Jeroen Tromp and Dimitri Komatitsch and Qinya Liu},
-! title = {Spectral-Element and Adjoint Methods in Seismology},
-! journal = {Communications in Computational Physics},
-! year = {2008},
-! volume = {3},
-! pages = {1-32},
-! number = {1}}
-!
-! or
-!
-! @ARTICLE{LiPoKoTr04,
-! author = {Qinya Liu and Jascha Polet and Dimitri Komatitsch and Jeroen Tromp},
-! title = {Spectral-element moment tensor inversions for earthquakes in {S}outhern {C}alifornia},
-! journal={Bull. Seismol. Soc. Am.},
-! year = {2004},
-! volume = {94},
-! pages = {1748-1761},
-! number = {5},
-! doi = {10.1785/012004038}}
-!
-! @INCOLLECTION{ChKoViCaVaFe07,
-! author = {Emmanuel Chaljub and Dimitri Komatitsch and Jean-Pierre Vilotte and
-! Yann Capdeville and Bernard Valette and Gaetano Festa},
-! title = {Spectral Element Analysis in Seismology},
-! booktitle = {Advances in Wave Propagation in Heterogeneous Media},
-! publisher = {Elsevier - Academic Press},
-! year = {2007},
-! editor = {Ru-Shan Wu and Val\'erie Maupin},
-! volume = {48},
-! series = {Advances in Geophysics},
-! pages = {365-419}}
-!
-! @ARTICLE{KoVi98,
-! author={D. Komatitsch and J. P. Vilotte},
-! title={The spectral-element method: an efficient tool to simulate the seismic response of 2{D} and 3{D} geological structures},
-! journal={Bull. Seismol. Soc. Am.},
-! year=1998,
-! volume=88,
-! number=2,
-! pages={368-392}}
-!
-! @ARTICLE{KoTr99,
-! author={D. Komatitsch and J. Tromp},
-! year=1999,
-! title={Introduction to the spectral-element method for 3-{D} seismic wave propagation},
-! journal={Geophys. J. Int.},
-! volume=139,
-! number=3,
-! pages={806-822},
-! doi={10.1046/j.1365-246x.1999.00967.x}}
-!
-! @ARTICLE{KoLiTrSuStSh04,
-! author={Dimitri Komatitsch and Qinya Liu and Jeroen Tromp and Peter S\"{u}ss
-! and Christiane Stidham and John H. Shaw},
-! year=2004,
-! title={Simulations of Ground Motion in the {L}os {A}ngeles {B}asin
-! based upon the Spectral-Element Method},
-! journal={Bull. Seism. Soc. Am.},
-! volume=94,
-! number=1,
-! pages={187-206}}
-!
-! and/or another article from http://web.univ-pau.fr/~dkomati1/publications.html
-!
-!
-! If you use the kernel capabilities of the code, please cite at least one article
-! written by the developers of the package, for instance:
-!
-! @ARTICLE{TrKoLi08,
-! author = {Jeroen Tromp and Dimitri Komatitsch and Qinya Liu},
-! title = {Spectral-Element and Adjoint Methods in Seismology},
-! journal = {Communications in Computational Physics},
-! year = {2008},
-! volume = {3},
-! pages = {1-32},
-! number = {1}}
-!
-! or
-!
-! @ARTICLE{LiTr06,
-! author={Qinya Liu and Jeroen Tromp},
-! title={Finite-frequency kernels based on adjoint methods},
-! journal={Bull. Seismol. Soc. Am.},
-! year=2006,
-! volume=96,
-! number=6,
-! pages={2383-2397},
-! doi={10.1785/0120060041}}
-!
-!
-! Reference frame - convention:
-! ----------------------------
-!
-! The code uses the following convention for the reference frame:
-!
-! - X axis is East
-! - Y axis is North
-! - Z axis is up
-!
-! Note that this convention is different from both the Aki-Richards convention
-! and the Harvard CMT convention.
-!
-! Let us recall that the Aki-Richards convention is:
-!
-! - X axis is North
-! - Y axis is East
-! - Z axis is down
-!
-! and that the Harvard CMT convention is:
-!
-! - X axis is South
-! - Y axis is East
-! - Z axis is up
-!
-! To report bugs or suggest improvements to the code, please send an email
-! to Jeroen Tromp <jtromp AT princeton.edu> and/or use our online
-! bug tracking system at http://www.geodynamics.org/roundup .
-!
-
-PARAMETERS TO CHANGE ON DIFFERENT MACHINES:
-
-- Use the appropriate compiler flags in the Makefile.
- Set F90, MPIF90, FLAGS_NO_CHECK, FLAGS_CHECK and MPI_FLAGS.
- Also set C_PREPROCESSOR to activate C preprocessing
- in your Fortran compiler (see the manual of your Fortran compiler for the right syntax)
-- In constants.h set LOCAL_PATH_IS_ALSO_GLOBAL flag.
- On clusters (e.g., Beowulfs), set this option to .false. in almost all cases.
-- In constants.h set FIX_UNDERFLOW_PROBLEM flag
- (need to fix underflow trapping on some machines, e.g., Pentium processors)
-- In Par_file set LOCAL_PATH (this is where databases are written and read)
-- In precision.h choose single versus double precision (double precision
- doubles the memory requirements for the solver but may be faster)
-- Also, in constants.h choose the CUSTOM_REAL size depending on
- single or double precision
-- When running on an SGI, add "setenv TRAP_FPE OFF" to your .cshrc file
- before compiling, in order to turn underflow trapping off
-
-DIRECTORIES:
-
-- make subdirectories obj and OUTPUT_FILES in the directory
- with the source code (also done automatically by the go_mesher script below)
-
-SCRIPTS:
-
-- go_mesher runs the mesher
- (need to set the correct mpirun command at the end of the script)
-- go_solver runs the solver
- (need to set the correct mpirun command at the end of the script)
-- runall compiles and runs both mesher and solver
-
-MESHER (generate_databases):
-
-- The mesher generate_databases needs NPROC processors.
-- Note that NPROC = 1 is valid (in case you have a
- machine with a small number of processors). Therefore the code can
- if needed run serially on one processor only (in such a case,
- still link with MPI, and use "mpirun -np 1")
-- In the Par_file, define the type of the mesh. The mesher and the solver
- can use UTM coordinates internally, therefore you also need to define
- the zone number for the UTM projection (e.g., zone 11 for Los Angeles).
- Use decimal values for latitude and longitude (no minutes/seconds).
- These values are approximate, the mesher will round them off to define
- a square mesh in UTM coordinates.
-
- UTM_PROJECTION_ZONE ! zone of the UTM projection (e.g. 11 for Los Angeles)
-
-- set all the parameters in DATA/Par_file, in particular the following:
-
- MODEL ! Earth model to use
-
- OCEANS ! to incorporate the effects of the oceans (cheap)
- ATTENUATION ! to include attenuation (fairly expensive)
- USE_OLSEN_ATTENUATION ! to use Kim Olsen's scaling instead of constant Q
-
- ABSORBING_CONDITIONS ! absorbing boundary conditions (cheap)
-
- SAVE_AVS_DX_MESH_FILES ! save mesh files for AVS users, www.avs.com,
- or OpenDX users, www.opendx.org). Do not use if you do not have AVS
- or OpenDX, because this option creates large files.
-
-- Compile the mesher ("make generate_databases") and run it with the go_mesher script
-- Mesher output is provided in the OUTPUT_FILES directory in output_mesher.txt
- (output can be directed to the screen instead by uncommenting two lines
- in constants.h:
- ! uncomment this to write messages to the screen
- ! integer, parameter :: IMAIN = ISTANDARD_OUTPUT )
-- For a given model and set of processors, one only needs to run the mesher
- once and for all
-- The mesher filters the list of stations in file DATA/STATIONS to exclude
- the stations that are not located within the region given in the Par_file
- (between LATITUDE_MIN and LATITUDE_MAX, and between LONGITUDE_MIN and LONGITUDE_MAX).
- The filtered file is called DATA/STATIONS_FILTERED
-- When running benchmarks on rectangular models, one can turn the UTM projection
- off by using flag SUPPRESS_UTM_PROJECTION, in which case all "longitude"
- parameters simply refer to the X axis, and all "latitude" parameters
- simply refer to the Y axis.
-
-CHECKING THE MPI BUFFERS (optional, after running the mesher):
-
-- Use the serial code check_buffers_2D to check all the MPI buffers
- generated by the mesher ("make check_buffers_2D" and then "xcheck_buffers_2D")
-
-CHECKING THE MESH (optional, after running the mesher):
-
-- Use the serial code check_mesh_quality_AVS_DX
- ("make check_mesh_quality_AVS_DX" and then "xcheck_mesh_quality_AVS_DX")
- to generate an AVS output file ("AVSmeshquality.inp" in AVS UCD format)
- or an OpenDX output file ("DXmeshquality.dx")
- that can be used to investigate mesh quality, e.g., skewness of elements,
- and a Gnuplot histogram ("mesh_quality_histogram.txt") that can
- be plotted with gnuplot ("gnuplot plot_mesh_quality_histogram.gnu")
-
-- Use the serial code combine_AVS_DX
- ("make combine_AVS_DX" and then "xcombine_AVS_DX")
- to generate AVS output files (in AVS UCD format) or OpenDX output files
- showing the mesh, the MPI partition (slices), the source and receiver
- location etc. Use the AVS UCD file AVS_coastline_freeways_LA.inp
- or the OpenDX file DX_coastline_freeways_LA.dx for reference
- in the Los Angeles area.
-
-SOLVER (specfem3D):
-
-- For reasons of speed, the solver uses static memory allocation. Therefore it
- needs to be recompiled every time one reruns the mesher. The mesher uses
- dynamic allocation only, and does not need to be recompiled.
-- The solver needs NPROC processors (same as the mesher)
-- The solver needs the DATA/CMTSOLUTION file for the source and the
- DATA/STATIONS file for the list of stations
-- Set the "time shift" in the CMTSOLUTION file to 0.0
- (the solver will not run otherwise)
-- To simulate a delta source-time function, set "half duration" in
- the CMTSOLUTION file to 0.0. If "half duration" is not zero,
- the code will use a Gaussian (not too different from triangular)
- source-time function with half-width "half duration". We prefer to run
- the solver with "half duration" set to zero and convolve after the fact,
- because this way it's easy to use a variety of source-time functions.
- Use the serial code convolve_source_timefunction.f90 and the script
- convolve_source_timefunction.csh for this purpose. (Set the parameter "hdur"
- in convolve_source_timefunction.csh to the desired half-duration.)
- (type "make convolve_source_timefunction" to compile the code).
-- To simulate multiple events, set the parameter NSOURCES in the DATA/Par_file
- to the desired number. Provide a CMTSOLUTION file that has NSOURCES entries,
- one for each CMT solution (i.e., concatenate NSOURCES CMTSOLUTION files
- to a single CMTSOLUTION file). At least one entry should have a zero "time shift",
- and all the other entries should have non-negative "time shift". Each event
- can have its own half duration, latitude, longitude, depth and moment tensor.
- This feature can also be used to mimic the directivity associated with a
- finite source.
-- Solver output is provided in the OUTPUT_FILES directory in output_solver.txt
- (output can be directed to the screen instead by uncommenting two lines
- in constants.h:
- ! uncomment this to write messages to the screen
- ! integer, parameter :: IMAIN = ISTANDARD_OUTPUT )
-- If you have a fast machine, set NTSTEP_BETWEEN_OUTPUT_INFO
- to a relatively high value (e.g. at least 100, or even 1000 or more)
- to avoid writing to the output text files too often. Same thing
- with NTSTEP_BETWEEN_OUTPUT_SEISMOS.
-- On clusters (e.g., Beowulfs) the seismogram files are distributed on the
- local disks (option LOCAL_PATH_IS_ALSO_GLOBAL turned off) and need to be
- gathered at the end of the simulation
-- For the same model, rerun the solver for different events by changing the
- CMTSOLUTION file, or for different stations by changing the STATIONS file.
- There is no need to rerun the mesher. It is best to include as many stations
- as possible, since this does not add to the cost of the simulation.
-
-MOVIE OF THE RESULTS:
-
-- Use create_movie_AVS_DX.f90 ("make create_movie_AVS_DX") to create
- a movie of surface displacement (vertical component) or of the entire
- 3D wave field. The movie can be saved in OpenDX, AVS or GMT format.
- Set parameters MOVIE_SURFACE, MOVIE_VOLUME, and NTSTEP_BETWEEN_FRAMES
- in the Par_file. Remember to use a DATA/CMTSOLUTION source file
- with a half-duration hdur > 0, otherwise you will get a movie
- corresponding to a Heaviside source, with a lot of high-frequency noise.
- Note that this option creates large files!
- Also set CREATE_SHAKEMAP is you want to create a ShakeMap at the end
- of the simulation.
-
-SERIAL RUNS (WITHOUT MPI):
-
-On a large serial machine, one may want to run a serial version of the code without MPI.
-To do this, one needs to:
-
-- set NPROC = 1 in DATA/Par_file
-- type "make generate_databases_serial" and "make specfem3D_serial" instead of
- "make generate_databases" and "make specfem3D"
-- run the code serially with "./xgenerate_databases" and "./xspecfem3D"
-
-BUG REPORTS:
-
-To report bugs or suggest improvements to the code, please send an email
-to Jeroen Tromp <jtromp AT princeton.edu> and/or use our online
-bug tracking system at http://www.geodynamics.org/roundup .
-
-Note: The Gauss-Lobatto subroutines in gll_library.f90 are based in part on
- software libraries from M.I.T., Department of Mechanical Engineering.
-
-Note: The non-structured global numbering software was provided by Paul F. Fischer.
-
-Note: Subroutines from "Numerical Recipes: The Art of Scientific Computing"
- by W. H. Press et al., Cambridge University Press, are used in
- numerical_recipes.f90. The user must acquire an official
- Numerical Recipes license to run them.
-
-Note: Subroutine utm_geo.f90 contains UTM (Universal Transverse Mercator)
- projection software from the USGS.
-
-Note: AVS is a trademark of Advanced Visualization Systems, www.avs.com
- OpenDX is based on IBM Data Explorer, www.opendx.org
-
Deleted: seismo/3D/SPECFEM3D/trunk/aniso_model.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/aniso_model.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/aniso_model.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,300 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-!=====================================================================
-! 07/09/04 Last changed by Min Chen
-! Users need to modify this subroutine to implement their own
-! anisotropic models.
-!=====================================================================
-
- subroutine aniso_model(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"
-
-! see for example:
-!
-! M. Chen & J. Tromp, 2006. Theoretical & numerical investigations
-! of global and regional seismic wave propagation in weakly anisotropic earth models,
-! GJI, 168, 1130-1152.
-
-!------------------------------------------------------------------------------
-! for anisotropy simulations in a halfspace model
-
-! only related to body waves
-! one-zeta term
- real(kind=CUSTOM_REAL), parameter :: FACTOR_CS1p_A = 0.2_CUSTOM_REAL
- real(kind=CUSTOM_REAL), parameter :: FACTOR_CS1sv_A = 0._CUSTOM_REAL
- real(kind=CUSTOM_REAL), parameter :: FACTOR_CS1sh_N = 0._CUSTOM_REAL
-! three-zeta term
- real(kind=CUSTOM_REAL), parameter :: FACTOR_CS3_L = 0._CUSTOM_REAL
-
-! Relative to Love wave
-! four-zeta term
- real(kind=CUSTOM_REAL), parameter :: FACTOR_N = 0._CUSTOM_REAL
- real(kind=CUSTOM_REAL), parameter :: FACTOR_E_N = 0._CUSTOM_REAL
-
-! Relative to Rayleigh wave
-! two-zeta term
- real(kind=CUSTOM_REAL), parameter :: FACTOR_A = 0._CUSTOM_REAL
- real(kind=CUSTOM_REAL), parameter :: FACTOR_C = 0._CUSTOM_REAL
- real(kind=CUSTOM_REAL), parameter :: FACTOR_F = 0._CUSTOM_REAL
- real(kind=CUSTOM_REAL), parameter :: FACTOR_H_F = 0._CUSTOM_REAL
- real(kind=CUSTOM_REAL), parameter :: FACTOR_B_A = 0._CUSTOM_REAL
-
-! Relative to both Love wave and Rayleigh wave
-! two-zeta term
- real(kind=CUSTOM_REAL), parameter :: FACTOR_L = 0._CUSTOM_REAL
- real(kind=CUSTOM_REAL), parameter :: FACTOR_G_L = 0._CUSTOM_REAL
-
-!------------------------------------------------------------------------------
-
- !integer idoubling
- integer iflag_aniso
-
- !real(kind=CUSTOM_REAL) zmesh
- real(kind=CUSTOM_REAL) rho,vp,vs
- 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
-
-! local parameters
- real(kind=CUSTOM_REAL) vpv,vph,vsv,vsh,eta_aniso
- real(kind=CUSTOM_REAL) aa,cc,nn,ll,ff
- real(kind=CUSTOM_REAL) A,C,F,AL,AN,Bc,Bs,Gc,Gs,Hc,Hs,Ec,Es,C1p,C1sv,C1sh,C3,S1p,S1sv,S1sh,S3
- real(kind=CUSTOM_REAL) d11,d12,d13,d14,d15,d16,d22,d23,d24,d25,d26,d33,d34,d35,d36, &
- d44,d45,d46,d55,d56,d66
-
-! assumes vp,vs given in m/s, rho in kg/m**3
- vph = vp
- vpv = vp
- vsh = vs
- vsv = vs
- eta_aniso = 1.0_CUSTOM_REAL
-
-
-! for definition, see for example:
-!
-! Dziewonski & Anderson, 1981. Preliminary reference earth model, PEPI, 25, 297-356.
-! page 305:
- aa = rho*vph*vph
- cc = rho*vpv*vpv
- nn = rho*vsh*vsh
- ll = rho*vsv*vsv
- ff = eta_aniso*(aa - 2.*ll)
-
-! Add anisotropic perturbation
-
-! notation: see Chen & Tromp, 2006, appendix A, page 1151
-!
-! zeta-independant terms:
-! A = \delta A
-! C = \delta C
-! AN = \delta N
-! AL = \delta L
-! F = \delta F
-!
-! zeta-dependant terms:
-! C1p = J_c
-! C1sv = K_c
-! C1sh = M_c
-! S1p = J_s
-! S1sv = K_s
-! S1sh = M_s
-!
-! two-zeta dependant terms:
-! Gc = G_c
-! Gs = G_s
-! Bc = B_c
-! Bs = B_s
-! Hc = H_c
-! Hs = H_s
-!
-! three-zeta dependant terms:
-! C3 = D_c
-! S3 = D_s
-!
-! four-zeta dependant terms:
-! Ec = E_c
-! Es = E_s
-
-! no anisotropic perturbation
- if( iflag_aniso <= 0 ) then
- ! zeta-independant
- A = aa
- C = cc
- AN = nn
- AL = ll
- F = ff
-
- ! zeta-dependant terms
- C1p = 0._CUSTOM_REAL
- C1sv = 0._CUSTOM_REAL
- C1sh = 0._CUSTOM_REAL
- S1p = 0._CUSTOM_REAL
- S1sv = 0._CUSTOM_REAL
- S1sh = 0._CUSTOM_REAL
-
- ! two-zeta dependant terms
- Gc = 0._CUSTOM_REAL
- Gs = 0._CUSTOM_REAL
-
- Bc = 0._CUSTOM_REAL
- Bs = 0._CUSTOM_REAL
-
- Hc = 0._CUSTOM_REAL
- Hs = 0._CUSTOM_REAL
-
- ! three-zeta dependant terms
- C3 = 0._CUSTOM_REAL
- S3 = 0._CUSTOM_REAL
-
- ! four-zeta dependant terms
- Ec = 0._CUSTOM_REAL
- Es = 0._CUSTOM_REAL
- endif
-
-! perturbation model 1
- if( iflag_aniso == IANISOTROPY_MODEL1 ) then
- ! zeta-independant
- A = aa*(1.0_CUSTOM_REAL + FACTOR_A)
- C = cc*(1.0_CUSTOM_REAL + FACTOR_C)
- AN = nn*(1.0_CUSTOM_REAL + FACTOR_N)
- AL = ll*(1.0_CUSTOM_REAL + FACTOR_L)
- F = ff*(1.0_CUSTOM_REAL + FACTOR_F)
-
- ! zeta-dependant terms
- C1p = FACTOR_CS1p_A*aa
- C1sv = FACTOR_CS1sv_A*aa
- C1sh = FACTOR_CS1sh_N*nn
- S1p = 0._CUSTOM_REAL
- S1sv = 0._CUSTOM_REAL
- S1sh = 0._CUSTOM_REAL
-
- ! two-zeta dependant terms
- Gc = FACTOR_G_L*ll
- Bc = FACTOR_B_A*aa
- Hc = FACTOR_H_F*ff
- Gs = 0._CUSTOM_REAL
- Bs = 0._CUSTOM_REAL
- Hs = 0._CUSTOM_REAL
-
- ! three-zeta dependant terms
- C3 = FACTOR_CS3_L*ll
- S3 = 0._CUSTOM_REAL
-
- ! four-zeta dependant terms
- Ec = FACTOR_E_N*nn
- Es = 0._CUSTOM_REAL
- endif
-
-! perturbation model 2
- if( iflag_aniso == IANISOTROPY_MODEL2 ) then
- ! zeta-independant
- A = aa*(1.0_CUSTOM_REAL + FACTOR_A + 0.1)
- C = cc*(1.0_CUSTOM_REAL + FACTOR_C + 0.1)
- AN = nn*(1.0_CUSTOM_REAL + FACTOR_N + 0.1)
- AL = ll*(1.0_CUSTOM_REAL + FACTOR_L + 0.1)
- F = ff*(1.0_CUSTOM_REAL + FACTOR_F + 0.1)
-
- ! zeta-dependant terms
- C1p = FACTOR_CS1p_A*aa
- C1sv = FACTOR_CS1sv_A*aa
- C1sh = FACTOR_CS1sh_N*nn
- S1p = 0._CUSTOM_REAL
- S1sv = 0._CUSTOM_REAL
- S1sh = 0._CUSTOM_REAL
-
- ! two-zeta dependant terms
- Gc = FACTOR_G_L*ll
- Bc = FACTOR_B_A*aa
- Hc = FACTOR_H_F*ff
- Gs = 0._CUSTOM_REAL
- Bs = 0._CUSTOM_REAL
- Hs = 0._CUSTOM_REAL
-
- ! three-zeta dependant terms
- C3 = FACTOR_CS3_L*ll
- S3 = 0._CUSTOM_REAL
-
- ! four-zeta dependant terms
- Ec = FACTOR_E_N*nn
- Es = 0._CUSTOM_REAL
- endif
-
-
-! The mapping from the elastic coefficients to the elastic tensor elements
-! in the local Cartesian coordinate system (classical geographic) used in the
-! global code (1---South, 2---East, 3---up)
-! Always keep the following part when you modify this subroutine
- d11 = A + Ec + Bc
- d12 = A - 2.*AN - Ec
- d13 = F + Hc
- d14 = S3 + 2.*S1sh + 2.*S1p
- d15 = 2.*C1p + C3
- d16 = -Bs/2. - Es
- d22 = A + Ec - Bc
- d23 = F - Hc
- d24 = 2.*S1p - S3
- d25 = 2.*C1p - 2.*C1sh - C3
- d26 = -Bs/2. + Es
- d33 = C
- d34 = 2.*(S1p - S1sv)
- d35 = 2.*(C1p - C1sv)
- d36 = -Hs
- d44 = AL - Gc
- d45 = -Gs
- d46 = C1sh - C3
- d55 = AL + Gc
- d56 = S3 - S1sh
- d66 = AN - Ec
-
-! The mapping to the global Cartesian coordinate system used in the code
-! (1---East, 2---North, 3---up)
- c11 = d22
- c12 = d12
- c13 = d23
- c14 = - d25
- c15 = d24
- c16 = - d26
- c22 = d11
- c23 = d13
- c24 = - d15
- c25 = d14
- c26 = - d16
- c33 = d33
- c34 = - d35
- c35 = d34
- c36 = - d36
- c44 = d55
- c45 = - d45
- c46 = d56
- c55 = d44
- c56 = - d46
- c66 = d66
-
- end subroutine aniso_model
-
Deleted: seismo/3D/SPECFEM3D/trunk/ascii_2_sep.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/ascii_2_sep.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/ascii_2_sep.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,41 +0,0 @@
-
- program ascii_2_sep
-
-! to convert ASCII seismograms to SEP binary format
-
- implicit none
-
-! Parameters to be defined to set the dimension of the arrays:
-! - nr = maximum number of receivers.
-! - ntime = maximum number of points of each seismogram.
- integer, parameter :: nr = 101
- integer, parameter :: ntime = 512
-
- real(kind=4), dimension(ntime,nr) :: sy
-
- integer :: it,ir,i
-
-! read seismogram component in ASCII text format
- print *,'Reading seismograms in text format'
-
- open(unit=11,file='U_file.txt',status='unknown')
- do ir=1,nr
- do it=1,ntime
- read(11,*) sy(it,ir)
-
-! invert sign of vertical component if needed depending on the reference frame convention
-! sy(it,ir) = - sy(it,ir)
-
- enddo
- enddo
- close(11)
-
-! write seismogram component in binary SEP format
- print *,'Saving seismograms in SEP format'
-
- open(unit=11,file='U_file.sep',status='unknown',access='direct',recl=ntime*nr*4)
- write(11,rec=1) (sy(i,1),i=1,ntime*nr)
- close(11)
-
- end program ascii_2_sep
-
Deleted: seismo/3D/SPECFEM3D/trunk/assemble_MPI_scalar.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/assemble_MPI_scalar.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/assemble_MPI_scalar.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,340 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-!----
-!---- assemble the contributions between slices using non-blocking MPI
-!----
-
- subroutine assemble_MPI_scalar_ext_mesh(NPROC,NGLOB_AB,array_val, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh)
-
-! subroutine assemble_MPI_scalar_ext_mesh(NPROC,NGLOB_AB,array_val, &
-! buffer_send_scalar_ext_mesh,buffer_recv_scalar_ext_mesh, &
-! num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
-! nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
-! my_neighbours_ext_mesh, &
-! request_send_scalar_ext_mesh,request_recv_scalar_ext_mesh)
-
- implicit none
-
- include "constants.h"
-
-! array to assemble
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: array_val
-
- integer :: NPROC
- integer :: NGLOB_AB
-
-
- integer :: num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: nibool_interfaces_ext_mesh,my_neighbours_ext_mesh
- integer, dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: ibool_interfaces_ext_mesh
-
-! real(kind=CUSTOM_REAL), dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: &
-! buffer_send_scalar_ext_mesh,buffer_recv_scalar_ext_mesh
-! integer, dimension(num_interfaces_ext_mesh) :: request_send_scalar_ext_mesh,request_recv_scalar_ext_mesh
-
- real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: buffer_send_scalar_ext_mesh
- real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: buffer_recv_scalar_ext_mesh
- integer, dimension(:), allocatable :: request_send_scalar_ext_mesh
- integer, dimension(:), allocatable :: request_recv_scalar_ext_mesh
-
-
- integer ipoin,iinterface
-
-! here we have to assemble all the contributions between partitions using MPI
-
-! assemble only if more than one partition
- if(NPROC > 1) then
-
- allocate(buffer_send_scalar_ext_mesh(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh))
- allocate(buffer_recv_scalar_ext_mesh(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh))
- allocate(request_send_scalar_ext_mesh(num_interfaces_ext_mesh))
- allocate(request_recv_scalar_ext_mesh(num_interfaces_ext_mesh))
-
- ! partition border copy into the buffer
- do iinterface = 1, num_interfaces_ext_mesh
- do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
- buffer_send_scalar_ext_mesh(ipoin,iinterface) = array_val(ibool_interfaces_ext_mesh(ipoin,iinterface))
- enddo
- enddo
-
- ! send messages
- do iinterface = 1, num_interfaces_ext_mesh
- call issend_cr(buffer_send_scalar_ext_mesh(1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
- nibool_interfaces_ext_mesh(iinterface), &
- my_neighbours_ext_mesh(iinterface), &
- itag, &
- request_send_scalar_ext_mesh(iinterface) &
- )
- call irecv_cr(buffer_recv_scalar_ext_mesh(1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
- nibool_interfaces_ext_mesh(iinterface), &
- my_neighbours_ext_mesh(iinterface), &
- itag, &
- request_recv_scalar_ext_mesh(iinterface) &
- )
- enddo
-
- ! wait for communications completion
- do iinterface = 1, num_interfaces_ext_mesh
- call wait_req(request_recv_scalar_ext_mesh(iinterface))
- enddo
-
- ! adding contributions of neighbours
- do iinterface = 1, num_interfaces_ext_mesh
- do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
- array_val(ibool_interfaces_ext_mesh(ipoin,iinterface)) = &
- array_val(ibool_interfaces_ext_mesh(ipoin,iinterface)) + buffer_recv_scalar_ext_mesh(ipoin,iinterface)
- enddo
- enddo
-
- ! wait for communications completion (send)
- do iinterface = 1, num_interfaces_ext_mesh
- call wait_req(request_send_scalar_ext_mesh(iinterface))
- enddo
-
- deallocate(buffer_send_scalar_ext_mesh)
- deallocate(buffer_recv_scalar_ext_mesh)
- deallocate(request_send_scalar_ext_mesh)
- deallocate(request_recv_scalar_ext_mesh)
-
- endif
-
- end subroutine assemble_MPI_scalar_ext_mesh
-
-!
-!----
-!
-
- subroutine assemble_MPI_scalar_i_ext_mesh(NPROC,NGLOB_AB,array_val, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh)
-
- implicit none
-
- include "constants.h"
-
-! array to assemble
- integer, dimension(NGLOB_AB) :: array_val
-
- integer :: NPROC
- integer :: NGLOB_AB
-
- integer :: num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: nibool_interfaces_ext_mesh,my_neighbours_ext_mesh
- integer, dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: ibool_interfaces_ext_mesh
-
- integer, dimension(:,:), allocatable :: buffer_send_scalar_ext_mesh
- integer, dimension(:,:), allocatable :: buffer_recv_scalar_ext_mesh
- integer, dimension(:), allocatable :: request_send_scalar_ext_mesh
- integer, dimension(:), allocatable :: request_recv_scalar_ext_mesh
-
- integer :: ipoin,iinterface
-
-! here we have to assemble all the contributions between partitions using MPI
-
-! assemble only if more than one partition
- if(NPROC > 1) then
-
- allocate(buffer_send_scalar_ext_mesh(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh))
- allocate(buffer_recv_scalar_ext_mesh(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh))
- allocate(request_send_scalar_ext_mesh(num_interfaces_ext_mesh))
- allocate(request_recv_scalar_ext_mesh(num_interfaces_ext_mesh))
-
- ! partition border copy into the buffer
- do iinterface = 1, num_interfaces_ext_mesh
- do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
- buffer_send_scalar_ext_mesh(ipoin,iinterface) = array_val(ibool_interfaces_ext_mesh(ipoin,iinterface))
- enddo
- enddo
-
- ! send messages
- do iinterface = 1, num_interfaces_ext_mesh
- call issend_i(buffer_send_scalar_ext_mesh(1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
- nibool_interfaces_ext_mesh(iinterface), &
- my_neighbours_ext_mesh(iinterface), &
- itag, &
- request_send_scalar_ext_mesh(iinterface) &
- )
- call irecv_i(buffer_recv_scalar_ext_mesh(1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
- nibool_interfaces_ext_mesh(iinterface), &
- my_neighbours_ext_mesh(iinterface), &
- itag, &
- request_recv_scalar_ext_mesh(iinterface) &
- )
- enddo
-
- ! wait for communications completion
- do iinterface = 1, num_interfaces_ext_mesh
- call wait_req(request_recv_scalar_ext_mesh(iinterface))
- enddo
-
- ! adding contributions of neighbours
- do iinterface = 1, num_interfaces_ext_mesh
- do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
- array_val(ibool_interfaces_ext_mesh(ipoin,iinterface)) = &
- array_val(ibool_interfaces_ext_mesh(ipoin,iinterface)) + buffer_recv_scalar_ext_mesh(ipoin,iinterface)
- enddo
- enddo
-
- ! wait for communications completion (send)
- do iinterface = 1, num_interfaces_ext_mesh
- call wait_req(request_send_scalar_ext_mesh(iinterface))
- enddo
-
- deallocate(buffer_send_scalar_ext_mesh)
- deallocate(buffer_recv_scalar_ext_mesh)
- deallocate(request_send_scalar_ext_mesh)
- deallocate(request_recv_scalar_ext_mesh)
-
- endif
-
- end subroutine assemble_MPI_scalar_i_ext_mesh
-
-!
-!----
-!
-
- subroutine assemble_MPI_scalar_ext_mesh_s(NPROC,NGLOB_AB,array_val, &
- buffer_send_scalar_ext_mesh,buffer_recv_scalar_ext_mesh, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh, &
- request_send_scalar_ext_mesh,request_recv_scalar_ext_mesh)
-
-! non-blocking MPI send
-
- implicit none
-
- include "constants.h"
-
-! array to send
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: array_val
-
- integer :: NPROC
- integer :: NGLOB_AB
-
- real(kind=CUSTOM_REAL), dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: &
- buffer_send_scalar_ext_mesh,buffer_recv_scalar_ext_mesh
-
- integer :: num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: nibool_interfaces_ext_mesh,my_neighbours_ext_mesh
- integer, dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: ibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: request_send_scalar_ext_mesh,request_recv_scalar_ext_mesh
-
- integer ipoin,iinterface
-
-! sends only if more than one partition
- if(NPROC > 1) then
-
- ! partition border copy into the buffer
- do iinterface = 1, num_interfaces_ext_mesh
- do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
- buffer_send_scalar_ext_mesh(ipoin,iinterface) = array_val(ibool_interfaces_ext_mesh(ipoin,iinterface))
- enddo
- enddo
-
- ! send messages
- do iinterface = 1, num_interfaces_ext_mesh
- call issend_cr(buffer_send_scalar_ext_mesh(1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
- nibool_interfaces_ext_mesh(iinterface), &
- my_neighbours_ext_mesh(iinterface), &
- itag, &
- request_send_scalar_ext_mesh(iinterface) &
- )
- call irecv_cr(buffer_recv_scalar_ext_mesh(1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
- nibool_interfaces_ext_mesh(iinterface), &
- my_neighbours_ext_mesh(iinterface), &
- itag, &
- request_recv_scalar_ext_mesh(iinterface) &
- )
-
- enddo
-
- endif
-
- end subroutine assemble_MPI_scalar_ext_mesh_s
-
-!
-!----
-!
-
- subroutine assemble_MPI_scalar_ext_mesh_w(NPROC,NGLOB_AB,array_val, &
- buffer_recv_scalar_ext_mesh,num_interfaces_ext_mesh, &
- max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- request_send_scalar_ext_mesh,request_recv_scalar_ext_mesh)
-
-! waits for send/receiver to be completed and assembles contributions
-
- implicit none
-
- include "constants.h"
-
-! array to assemble
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: array_val
-
- integer :: NPROC
- integer :: NGLOB_AB
-
- real(kind=CUSTOM_REAL), dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: &
- buffer_recv_scalar_ext_mesh
-
- integer :: num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: nibool_interfaces_ext_mesh
- integer, dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: ibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: request_send_scalar_ext_mesh,request_recv_scalar_ext_mesh
-
- integer ipoin,iinterface
-
-! assemble only if more than one partition
- if(NPROC > 1) then
-
- ! wait for communications completion
- do iinterface = 1, num_interfaces_ext_mesh
- call wait_req(request_recv_scalar_ext_mesh(iinterface))
- enddo
-
- ! adding contributions of neighbours
- do iinterface = 1, num_interfaces_ext_mesh
- do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
- array_val(ibool_interfaces_ext_mesh(ipoin,iinterface)) = &
- array_val(ibool_interfaces_ext_mesh(ipoin,iinterface)) + buffer_recv_scalar_ext_mesh(ipoin,iinterface)
- enddo
- enddo
-
- ! wait for communications completion (send)
- do iinterface = 1, num_interfaces_ext_mesh
- call wait_req(request_send_scalar_ext_mesh(iinterface))
- enddo
-
- endif
-
- end subroutine assemble_MPI_scalar_ext_mesh_w
-
-
Deleted: seismo/3D/SPECFEM3D/trunk/assemble_MPI_vector.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/assemble_MPI_vector.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/assemble_MPI_vector.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,246 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-!----
-!---- assemble the contributions between slices using non-blocking MPI
-!----
-
- subroutine assemble_MPI_vector_ext_mesh(NPROC,NGLOB_AB,array_val, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh)
-
- implicit none
-
- include "constants.h"
-
-! array to assemble
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: array_val
-
- integer :: NPROC
- integer :: NGLOB_AB
-
- integer :: num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: nibool_interfaces_ext_mesh,my_neighbours_ext_mesh
- integer, dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: ibool_interfaces_ext_mesh
-
- ! local parameters
-
- ! send/receive temporary buffers
- !real(kind=CUSTOM_REAL), dimension(NDIM,max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: &
- ! buffer_send_vector_ext_mesh,buffer_recv_vector_ext_mesh
- real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: buffer_send_vector_ext_mesh
- real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: buffer_recv_vector_ext_mesh
-
- ! requests
- !integer, dimension(num_interfaces_ext_mesh) :: request_send_vector_ext_mesh,request_recv_vector_ext_mesh
- integer, dimension(:), allocatable :: request_send_vector_ext_mesh
- integer, dimension(:), allocatable :: request_recv_vector_ext_mesh
-
- integer ipoin,iinterface
-
-
-! here we have to assemble all the contributions between partitions using MPI
-
-! assemble only if more than one partition
- if(NPROC > 1) then
-
- allocate(buffer_send_vector_ext_mesh(NDIM,max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh))
- allocate(buffer_recv_vector_ext_mesh(NDIM,max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh))
- allocate(request_send_vector_ext_mesh(num_interfaces_ext_mesh))
- allocate(request_recv_vector_ext_mesh(num_interfaces_ext_mesh))
-
- ! partition border copy into the buffer
- do iinterface = 1, num_interfaces_ext_mesh
- do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
- buffer_send_vector_ext_mesh(:,ipoin,iinterface) = array_val(:,ibool_interfaces_ext_mesh(ipoin,iinterface))
- enddo
- enddo
-
- ! send messages
- do iinterface = 1, num_interfaces_ext_mesh
- call issend_cr(buffer_send_vector_ext_mesh(1,1,iinterface), &
- NDIM*nibool_interfaces_ext_mesh(iinterface), &
- my_neighbours_ext_mesh(iinterface), &
- itag, &
- request_send_vector_ext_mesh(iinterface) &
- )
- call irecv_cr(buffer_recv_vector_ext_mesh(1,1,iinterface), &
- NDIM*nibool_interfaces_ext_mesh(iinterface), &
- my_neighbours_ext_mesh(iinterface), &
- itag, &
- request_recv_vector_ext_mesh(iinterface) &
- )
- enddo
-
- ! wait for communications completion (recv)
- do iinterface = 1, num_interfaces_ext_mesh
- call wait_req(request_recv_vector_ext_mesh(iinterface))
- enddo
-
- ! adding contributions of neighbours
- do iinterface = 1, num_interfaces_ext_mesh
- do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
- array_val(:,ibool_interfaces_ext_mesh(ipoin,iinterface)) = &
- array_val(:,ibool_interfaces_ext_mesh(ipoin,iinterface)) + buffer_recv_vector_ext_mesh(:,ipoin,iinterface)
- enddo
- enddo
-
- ! wait for communications completion (send)
- do iinterface = 1, num_interfaces_ext_mesh
- call wait_req(request_send_vector_ext_mesh(iinterface))
- enddo
-
- deallocate(buffer_send_vector_ext_mesh)
- deallocate(buffer_recv_vector_ext_mesh)
- deallocate(request_send_vector_ext_mesh)
- deallocate(request_recv_vector_ext_mesh)
-
- endif
-
- end subroutine assemble_MPI_vector_ext_mesh
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine assemble_MPI_vector_ext_mesh_s(NPROC,NGLOB_AB,array_val, &
- buffer_send_vector_ext_mesh,buffer_recv_vector_ext_mesh, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,my_neighbours_ext_mesh, &
- request_send_vector_ext_mesh,request_recv_vector_ext_mesh &
- )
-
-! sends data
-
- implicit none
-
- include "constants.h"
-
-! array to assemble
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: array_val
-
- integer :: NPROC
- integer :: NGLOB_AB
-
- real(kind=CUSTOM_REAL), dimension(NDIM,max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: &
- buffer_send_vector_ext_mesh,buffer_recv_vector_ext_mesh
-
- integer :: num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: nibool_interfaces_ext_mesh,my_neighbours_ext_mesh
- integer, dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: ibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: request_send_vector_ext_mesh,request_recv_vector_ext_mesh
-
- integer ipoin,iinterface
-
-! here we have to assemble all the contributions between partitions using MPI
-
-! assemble only if more than one partition
- if(NPROC > 1) then
-
-! partition border copy into the buffer
- do iinterface = 1, num_interfaces_ext_mesh
- do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
- buffer_send_vector_ext_mesh(:,ipoin,iinterface) = array_val(:,ibool_interfaces_ext_mesh(ipoin,iinterface))
- enddo
- enddo
-
-! send messages
- do iinterface = 1, num_interfaces_ext_mesh
- call issend_cr(buffer_send_vector_ext_mesh(1,1,iinterface), &
- NDIM*nibool_interfaces_ext_mesh(iinterface), &
- my_neighbours_ext_mesh(iinterface), &
- itag, &
- request_send_vector_ext_mesh(iinterface) &
- )
- call irecv_cr(buffer_recv_vector_ext_mesh(1,1,iinterface), &
- NDIM*nibool_interfaces_ext_mesh(iinterface), &
- my_neighbours_ext_mesh(iinterface), &
- itag, &
- request_recv_vector_ext_mesh(iinterface) &
- )
- enddo
-
- endif
-
- end subroutine assemble_MPI_vector_ext_mesh_s
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine assemble_MPI_vector_ext_mesh_w(NPROC,NGLOB_AB,array_val, &
- buffer_recv_vector_ext_mesh,num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- request_send_vector_ext_mesh,request_recv_vector_ext_mesh)
-
-! waits for data to receive and assembles
-
- implicit none
-
- include "constants.h"
-
-! array to assemble
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: array_val
-
- integer :: NPROC
- integer :: NGLOB_AB
-
- real(kind=CUSTOM_REAL), dimension(NDIM,max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: &
- buffer_recv_vector_ext_mesh
-
- integer :: num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: nibool_interfaces_ext_mesh
- integer, dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: ibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: request_send_vector_ext_mesh,request_recv_vector_ext_mesh
-
- integer ipoin,iinterface
-
-! here we have to assemble all the contributions between partitions using MPI
-
-! assemble only if more than one partition
- if(NPROC > 1) then
-
-! wait for communications completion (recv)
- do iinterface = 1, num_interfaces_ext_mesh
- call wait_req(request_recv_vector_ext_mesh(iinterface))
- enddo
-
-! adding contributions of neighbours
- do iinterface = 1, num_interfaces_ext_mesh
- do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
- array_val(:,ibool_interfaces_ext_mesh(ipoin,iinterface)) = &
- array_val(:,ibool_interfaces_ext_mesh(ipoin,iinterface)) + buffer_recv_vector_ext_mesh(:,ipoin,iinterface)
- enddo
- enddo
-
-! wait for communications completion (send)
- do iinterface = 1, num_interfaces_ext_mesh
- call wait_req(request_send_vector_ext_mesh(iinterface))
- enddo
-
- endif
-
- end subroutine assemble_MPI_vector_ext_mesh_w
Deleted: seismo/3D/SPECFEM3D/trunk/calc_jacobian.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/calc_jacobian.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/calc_jacobian.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,363 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine calc_jacobian(myrank,xixstore,xiystore,xizstore, &
- etaxstore,etaystore,etazstore, &
- gammaxstore,gammaystore,gammazstore,jacobianstore, &
- xstore,ystore,zstore, &
- xelm,yelm,zelm,shape3D,dershape3D,ispec,nspec)
-
- implicit none
-
- include "constants.h"
-
- integer ispec,nspec,myrank
-
- double precision shape3D(NGNOD,NGLLX,NGLLY,NGLLZ)
- double precision dershape3D(NDIM,NGNOD,NGLLX,NGLLY,NGLLZ)
-
- double precision, dimension(NGNOD) :: xelm,yelm,zelm
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,nspec) :: &
- xixstore,xiystore,xizstore,etaxstore,etaystore,etazstore, &
- gammaxstore,gammaystore,gammazstore,jacobianstore
-
- double precision, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: xstore,ystore,zstore
-
- integer i,j,k,ia
- double precision xxi,xeta,xgamma,yxi,yeta,ygamma,zxi,zeta,zgamma
- double precision xmesh,ymesh,zmesh
- double precision xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz
- double precision jacobian
-
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
-
- xxi = ZERO
- xeta = ZERO
- xgamma = ZERO
- yxi = ZERO
- yeta = ZERO
- ygamma = ZERO
- zxi = ZERO
- zeta = ZERO
- zgamma = ZERO
- xmesh = ZERO
- ymesh = ZERO
- zmesh = ZERO
-
- do ia=1,NGNOD
- xxi = xxi + dershape3D(1,ia,i,j,k)*xelm(ia)
- xeta = xeta + dershape3D(2,ia,i,j,k)*xelm(ia)
- xgamma = xgamma + dershape3D(3,ia,i,j,k)*xelm(ia)
- yxi = yxi + dershape3D(1,ia,i,j,k)*yelm(ia)
- yeta = yeta + dershape3D(2,ia,i,j,k)*yelm(ia)
- ygamma = ygamma + dershape3D(3,ia,i,j,k)*yelm(ia)
- zxi = zxi + dershape3D(1,ia,i,j,k)*zelm(ia)
- zeta = zeta + dershape3D(2,ia,i,j,k)*zelm(ia)
- zgamma = zgamma + dershape3D(3,ia,i,j,k)*zelm(ia)
- xmesh = xmesh + shape3D(ia,i,j,k)*xelm(ia)
- ymesh = ymesh + shape3D(ia,i,j,k)*yelm(ia)
- zmesh = zmesh + shape3D(ia,i,j,k)*zelm(ia)
- enddo
-
- jacobian = xxi*(yeta*zgamma-ygamma*zeta) - &
- xeta*(yxi*zgamma-ygamma*zxi) + &
- xgamma*(yxi*zeta-yeta*zxi)
-
-! can ignore negative jacobian in mesher if needed when debugging code
- if(jacobian <= ZERO) call exit_MPI(myrank,'3D Jacobian undefined')
-
-! invert the relation (Fletcher p. 50 vol. 2)
- xix = (yeta*zgamma-ygamma*zeta) / jacobian
- xiy = (xgamma*zeta-xeta*zgamma) / jacobian
- xiz = (xeta*ygamma-xgamma*yeta) / jacobian
- etax = (ygamma*zxi-yxi*zgamma) / jacobian
- etay = (xxi*zgamma-xgamma*zxi) / jacobian
- etaz = (xgamma*yxi-xxi*ygamma) / jacobian
- gammax = (yxi*zeta-yeta*zxi) / jacobian
- gammay = (xeta*zxi-xxi*zeta) / jacobian
- gammaz = (xxi*yeta-xeta*yxi) / jacobian
-
-! compute and store the jacobian for the solver
- jacobian = 1. / (xix*(etay*gammaz-etaz*gammay) &
- -xiy*(etax*gammaz-etaz*gammax) &
- +xiz*(etax*gammay-etay*gammax))
-
-! save the derivatives and the jacobian
-
-! distinguish between single and double precision for reals
- if(CUSTOM_REAL == SIZE_REAL) then
- xixstore(i,j,k,ispec) = sngl(xix)
- xiystore(i,j,k,ispec) = sngl(xiy)
- xizstore(i,j,k,ispec) = sngl(xiz)
- etaxstore(i,j,k,ispec) = sngl(etax)
- etaystore(i,j,k,ispec) = sngl(etay)
- etazstore(i,j,k,ispec) = sngl(etaz)
- gammaxstore(i,j,k,ispec) = sngl(gammax)
- gammaystore(i,j,k,ispec) = sngl(gammay)
- gammazstore(i,j,k,ispec) = sngl(gammaz)
- jacobianstore(i,j,k,ispec) = sngl(jacobian)
- else
- xixstore(i,j,k,ispec) = xix
- xiystore(i,j,k,ispec) = xiy
- xizstore(i,j,k,ispec) = xiz
- etaxstore(i,j,k,ispec) = etax
- etaystore(i,j,k,ispec) = etay
- etazstore(i,j,k,ispec) = etaz
- gammaxstore(i,j,k,ispec) = gammax
- gammaystore(i,j,k,ispec) = gammay
- gammazstore(i,j,k,ispec) = gammaz
- jacobianstore(i,j,k,ispec) = jacobian
- endif
-
- xstore(i,j,k,ispec) = xmesh
- ystore(i,j,k,ispec) = ymesh
- zstore(i,j,k,ispec) = zmesh
-
- enddo
- enddo
- enddo
-
- end subroutine calc_jacobian
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-! This subroutine recomputes the 3D jacobian for one element
-! based upon all GLL points
-! Hejun Zhu OCT16,2009
-
-! input: myrank,
-! xstore,ystore,zstore ----- input position
-! xigll,yigll,zigll ----- gll points position
-! ispec,nspec ----- element number
-! ACTUALLY_STORE_ARRAYS ------ save array or not
-
-! output: xixstore,xiystore,xizstore,
-! etaxstore,etaystore,etazstore,
-! gammaxstore,gammaystore,gammazstore ------ parameters used for calculating jacobian
-!
-!
-! subroutine recalc_jacobian_gll3D(myrank,xixstore,xiystore,xizstore, &
-! etaxstore,etaystore,etazstore, &
-! gammaxstore,gammaystore,gammazstore,jacobianstore, &
-! xstore,ystore,zstore, &
-! ispec,nspec, &
-! xigll,yigll,zigll, &
-! ACTUALLY_STORE_ARRAYS)
-!
-! implicit none
-!
-! include "constants.h"
-!
-! ! input parameter
-! integer::myrank,ispec,nspec
-! double precision, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: xstore,ystore,zstore
-! double precision, dimension(NGLLX):: xigll
-! double precision, dimension(NGLLY):: yigll
-! double precision, dimension(NGLLZ):: zigll
-! logical::ACTUALLY_STORE_ARRAYS
-!
-!
-! ! output results
-! real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,nspec) :: &
-! xixstore,xiystore,xizstore,&
-! etaxstore,etaystore,etazstore,&
-! gammaxstore,gammaystore,gammazstore,&
-! jacobianstore
-!
-!
-! ! other parameters for this subroutine
-! integer:: i,j,k,i1,j1,k1
-! double precision:: xxi,xeta,xgamma,yxi,yeta,ygamma,zxi,zeta,zgamma
-! double precision:: xi,eta,gamma
-! double precision,dimension(NGLLX):: hxir,hpxir
-! double precision,dimension(NGLLY):: hetar,hpetar
-! double precision,dimension(NGLLZ):: hgammar,hpgammar
-! double precision:: hlagrange,hlagrange_xi,hlagrange_eta,hlagrange_gamma
-! double precision:: jacobian
-! double precision:: xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz
-!
-!
-!
-! ! test parameters which can be deleted
-! double precision:: xmesh,ymesh,zmesh
-! double precision:: sumshape,sumdershapexi,sumdershapeeta,sumdershapegamma
-!
-! ! first go over all 125 gll points
-! do k=1,NGLLZ
-! do j=1,NGLLY
-! do i=1,NGLLX
-!
-! xxi = 0.0
-! xeta = 0.0
-! xgamma = 0.0
-! yxi = 0.0
-! yeta = 0.0
-! ygamma = 0.0
-! zxi = 0.0
-! zeta = 0.0
-! zgamma = 0.0
-!
-! xi = xigll(i)
-! eta = yigll(j)
-! gamma = zigll(k)
-!
-! ! calculate lagrange polynomial and its derivative
-! call lagrange_any(xi,NGLLX,xigll,hxir,hpxir)
-! call lagrange_any(eta,NGLLY,yigll,hetar,hpetar)
-! call lagrange_any(gamma,NGLLZ,zigll,hgammar,hpgammar)
-!
-! ! test parameters
-! sumshape = 0.0
-! sumdershapexi = 0.0
-! sumdershapeeta = 0.0
-! sumdershapegamma = 0.0
-! xmesh = 0.0
-! ymesh = 0.0
-! zmesh = 0.0
-!
-!
-! do k1 = 1,NGLLZ
-! do j1 = 1,NGLLY
-! do i1 = 1,NGLLX
-! hlagrange = hxir(i1)*hetar(j1)*hgammar(k1)
-! hlagrange_xi = hpxir(i1)*hetar(j1)*hgammar(k1)
-! hlagrange_eta = hxir(i1)*hpetar(j1)*hgammar(k1)
-! hlagrange_gamma = hxir(i1)*hetar(j1)*hpgammar(k1)
-!
-!
-! xxi = xxi + xstore(i1,j1,k1,ispec)*hlagrange_xi
-! xeta = xeta + xstore(i1,j1,k1,ispec)*hlagrange_eta
-! xgamma = xgamma + xstore(i1,j1,k1,ispec)*hlagrange_gamma
-!
-! yxi = yxi + ystore(i1,j1,k1,ispec)*hlagrange_xi
-! yeta = yeta + ystore(i1,j1,k1,ispec)*hlagrange_eta
-! ygamma = ygamma + ystore(i1,j1,k1,ispec)*hlagrange_gamma
-!
-! zxi = zxi + zstore(i1,j1,k1,ispec)*hlagrange_xi
-! zeta = zeta + zstore(i1,j1,k1,ispec)*hlagrange_eta
-! zgamma = zgamma + zstore(i1,j1,k1,ispec)*hlagrange_gamma
-!
-! ! test the lagrange polynomial and its derivate
-! xmesh = xmesh + xstore(i1,j1,k1,ispec)*hlagrange
-! ymesh = ymesh + ystore(i1,j1,k1,ispec)*hlagrange
-! zmesh = zmesh + zstore(i1,j1,k1,ispec)*hlagrange
-! sumshape = sumshape + hlagrange
-! sumdershapexi = sumdershapexi + hlagrange_xi
-! sumdershapeeta = sumdershapeeta + hlagrange_eta
-! sumdershapegamma = sumdershapegamma + hlagrange_gamma
-!
-! end do
-! end do
-! end do
-!
-! ! Check the lagrange polynomial and its derivative
-! if (xmesh /=xstore(i,j,k,ispec).or.ymesh/=ystore(i,j,k,ispec).or.zmesh/=zstore(i,j,k,ispec)) then
-! call exit_MPI(myrank,'new mesh positions are wrong in recalc_jacobian_gall3D.f90')
-! end if
-! if(abs(sumshape-one) > TINYVAL) then
-! call exit_MPI(myrank,'error shape functions in recalc_jacobian_gll3D.f90')
-! end if
-! if(abs(sumdershapexi) > TINYVAL) then
-! call exit_MPI(myrank,'error derivative xi shape functions in recalc_jacobian_gll3D.f90')
-! end if
-! if(abs(sumdershapeeta) > TINYVAL) then
-! call exit_MPI(myrank,'error derivative eta shape functions in recalc_jacobian_gll3D.f90')
-! end if
-! if(abs(sumdershapegamma) > TINYVAL) then
-! call exit_MPI(myrank,'error derivative gamma shape functions in recalc_jacobian_gll3D.f90')
-! end if
-!
-!
-! jacobian = xxi*(yeta*zgamma-ygamma*zeta) - &
-! xeta*(yxi*zgamma-ygamma*zxi) + &
-! xgamma*(yxi*zeta-yeta*zxi)
-!
-! ! Check the jacobian
-! if(jacobian <= ZERO) then
-! call exit_MPI(myrank,'3D Jacobian undefined in recalc_jacobian_gll3D.f90')
-! end if
-!
-! ! invert the relation (Fletcher p. 50 vol. 2)
-! xix = (yeta*zgamma-ygamma*zeta) / jacobian
-! xiy = (xgamma*zeta-xeta*zgamma) / jacobian
-! xiz = (xeta*ygamma-xgamma*yeta) / jacobian
-! etax = (ygamma*zxi-yxi*zgamma) / jacobian
-! etay = (xxi*zgamma-xgamma*zxi) / jacobian
-! etaz = (xgamma*yxi-xxi*ygamma) / jacobian
-! gammax = (yxi*zeta-yeta*zxi) / jacobian
-! gammay = (xeta*zxi-xxi*zeta) / jacobian
-! gammaz = (xxi*yeta-xeta*yxi) / jacobian
-!
-!
-! ! compute and store the jacobian for the solver
-! jacobian = 1. / (xix*(etay*gammaz-etaz*gammay) &
-! -xiy*(etax*gammaz-etaz*gammax) &
-! +xiz*(etax*gammay-etay*gammax))
-!
-! ! resave the derivatives and the jacobian
-! ! distinguish between single and double precision for reals
-! if (ACTUALLY_STORE_ARRAYS) then
-!
-! if (myrank == 0) then
-! print*,'xix before',xixstore(i,j,k,ispec),'after',xix
-! print*,'etax before',etaxstore(i,j,k,ispec),'after',etax
-! print*,'gammax before',gammaxstore(i,j,k,ispec),'after',gammax
-! end if
-!
-! if(CUSTOM_REAL == SIZE_REAL) then
-! xixstore(i,j,k,ispec) = sngl(xix)
-! xiystore(i,j,k,ispec) = sngl(xiy)
-! xizstore(i,j,k,ispec) = sngl(xiz)
-! etaxstore(i,j,k,ispec) = sngl(etax)
-! etaystore(i,j,k,ispec) = sngl(etay)
-! etazstore(i,j,k,ispec) = sngl(etaz)
-! gammaxstore(i,j,k,ispec) = sngl(gammax)
-! gammaystore(i,j,k,ispec) = sngl(gammay)
-! gammazstore(i,j,k,ispec) = sngl(gammaz)
-! jacobianstore(i,j,k,ispec) = sngl(jacobian)
-! else
-! xixstore(i,j,k,ispec) = xix
-! xiystore(i,j,k,ispec) = xiy
-! xizstore(i,j,k,ispec) = xiz
-! etaxstore(i,j,k,ispec) = etax
-! etaystore(i,j,k,ispec) = etay
-! etazstore(i,j,k,ispec) = etaz
-! gammaxstore(i,j,k,ispec) = gammax
-! gammaystore(i,j,k,ispec) = gammay
-! gammazstore(i,j,k,ispec) = gammaz
-! jacobianstore(i,j,k,ispec) = jacobian
-! endif
-! end if
-! enddo
-! enddo
-! enddo
-!
-! end subroutine recalc_jacobian_gll3D
-!
Deleted: seismo/3D/SPECFEM3D/trunk/change_simulation_type.pl
===================================================================
--- seismo/3D/SPECFEM3D/trunk/change_simulation_type.pl 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/change_simulation_type.pl 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,61 +0,0 @@
-#!/usr/bin/perl
-
-use Time::Local;
-use Getopt::Std;
-use POSIX;
-
-sub Usage{
-print STDERR <<END;
-
-Usage: change_simulation_type.pl [-a|-f|-b|-F]
- Changes SIMULATION_TYPE in DATA/Par_file
- -a -- change type to run adjoint calculation(2)
- -f -- change type to run forward calculation(1)
- -b -- change type to run both simultaneously(3)
- -F -- change type to run forward calculation(1) with save_forward = .true.
-END
-exit(1);
-}
-
- at ARGV == 1 or Usage();
-if(!getopts('abfF')) {die("check input arguments\n");}
-
-open(IN,"DATA/Par_file");
- at file_to_modify=<IN>;
-close(IN);
-
-foreach $file_to_modify (@file_to_modify){
- if($file_to_modify=~/SIMULATION_TYPE/){
- if(${opt_a}){
- print "Changed simulation_type to 2 in Par_file \n";
- $file_to_modify=~s/= 1/= 2/;
- $file_to_modify=~s/= 3/= 2/;
- }
- elsif(${opt_f}){
- print "Changed simulation_type to 1 in Par_file \n";
- $file_to_modify=~s/= 2/= 1/;
- $file_to_modify=~s/= 3/= 1/;
- }
- elsif(${opt_b}){
- print "Changed simulation_type to 3 in Par_file \n";
- $file_to_modify=~s/= 1/= 3/;
- $file_to_modify=~s/= 2/= 3/;
- }
- elsif(${opt_F}){
- print "Changed simulation_type to 1 and save_forward = .true. in Par_file \n";
- $file_to_modify=~s/= 2/= 1/;
- $file_to_modify=~s/= 3/= 1/;
- }
- }
- if ($file_to_modify=~/SAVE_FORWARD/) {
- if ($opt_F) { $file_to_modify=~s/= .*/= .true./; }
- else {$file_to_modify=~s/= .*/= .false./;}
-
- }
-}
-
-open(OUT,">DATA/Par_file") || die("No DATA/Par_file\n");
-foreach $file_to_modify (@file_to_modify){
- print OUT "$file_to_modify";
-}
-close(OUT);
Deleted: seismo/3D/SPECFEM3D/trunk/check_mesh_resolution.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/check_mesh_resolution.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/check_mesh_resolution.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,300 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-
- subroutine check_mesh_resolution(myrank,NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore, &
- kappastore,mustore,rho_vp,rho_vs, &
- DT, model_speed_max )
-
-! check the mesh, stability and resolved period
-!
-! returns: maximum velocity in model ( model_speed_max )
-
- implicit none
-
- include "constants.h"
-
- integer :: NSPEC_AB,NGLOB_AB
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: kappastore,mustore,rho_vp,rho_vs
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: xstore,ystore,zstore
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
- double precision :: DT
- real(kind=CUSTOM_REAL) :: model_speed_max
-
- ! local parameters
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ):: vp_elem,vs_elem
- real(kind=CUSTOM_REAL), dimension(1) :: val_min,val_max
- real(kind=CUSTOM_REAL) :: vpmin,vpmax,vsmin,vsmax,vpmin_glob,vpmax_glob,vsmin_glob,vsmax_glob
- real(kind=CUSTOM_REAL) :: distance_min,distance_max,distance_min_glob,distance_max_glob,dx !,dy,dz
- real(kind=CUSTOM_REAL) :: cmax,cmax_glob,pmax,pmax_glob
- real(kind=CUSTOM_REAL) :: dt_suggested,dt_suggested_glob
-
- logical:: DT_PRESENT
-
- integer :: myrank
- integer :: NSPEC_AB_global_min,NSPEC_AB_global_max,NSPEC_AB_global_sum
- integer :: NGLOB_AB_global_min,NGLOB_AB_global_max,NGLOB_AB_global_sum
- integer :: i,j,k,ii,jj,kk,ispec,iglob_a,iglob_b,sizeprocs
-
-! estimation of time step and period resolved
- real(kind=CUSTOM_REAL),parameter :: COURANT_SUGGESTED = 0.3
- real(kind=CUSTOM_REAL),parameter :: NELEM_PER_WAVELENGTH = 1.5
- logical :: has_vs_zero
-
-! initializations
- if( DT <= 0.0d0) then
- DT_PRESENT = .false.
- else
- DT_PRESENT = .true.
- endif
-
- vpmin_glob = HUGEVAL
- vpmax_glob = -HUGEVAL
-
- vsmin_glob = HUGEVAL
- vsmax_glob = -HUGEVAL
-
- distance_min_glob = HUGEVAL
- distance_max_glob = -HUGEVAL
-
- cmax_glob = -HUGEVAL
- pmax_glob = -HUGEVAL
-
- dt_suggested_glob = HUGEVAL
-
- has_vs_zero = .false.
-
-! checks courant number & minimum resolved period for each grid cell
- do ispec=1,NSPEC_AB
-
-! determines minimum/maximum velocities within this element
- vpmin = HUGEVAL
- vpmax = -HUGEVAL
- vsmin = HUGEVAL
- vsmax = -HUGEVAL
- ! vp
- where( rho_vp(:,:,:,ispec) > TINYVAL )
- vp_elem(:,:,:) = (FOUR_THIRDS * mustore(:,:,:,ispec) + kappastore(:,:,:,ispec)) / rho_vp(:,:,:,ispec)
- elsewhere
- vp_elem(:,:,:) = 0.0
- endwhere
- ! vs
- where( rho_vs(:,:,:,ispec) > TINYVAL )
- vs_elem(:,:,:) = mustore(:,:,:,ispec) / rho_vs(:,:,:,ispec)
- elsewhere
- vs_elem(:,:,:) = 0.0
- endwhere
-
- val_min = minval(vp_elem(:,:,:))
- val_max = maxval(vp_elem(:,:,:))
-
- vpmin = min(vpmin,val_min(1))
- vpmax = max(vpmax,val_max(1))
-
- val_min = minval(vs_elem(:,:,:))
- val_max = maxval(vs_elem(:,:,:))
-
- ! ignore fluid regions with Vs = 0
- if( val_min(1) > 0.0001 ) then
- vsmin = min(vsmin,val_min(1))
- else
- has_vs_zero = .true.
- endif
- vsmax = max(vsmax,val_max(1))
-
- ! min/max for whole cpu partition
- vpmin_glob = min ( vpmin_glob, vpmin)
- vpmax_glob = max ( vpmax_glob, vpmax)
-
- vsmin_glob = min ( vsmin_glob, vsmin)
- vsmax_glob = max ( vsmax_glob, vsmax)
-
-! compute minimum and maximum distance of GLL points in this grid cell
- distance_min = HUGEVAL
- distance_max = -HUGEVAL
-
- ! loops over all GLL points
- do k=1,NGLLZ-1
- do j=1,NGLLY-1
- do i=1,NGLLX-1
- iglob_a = ibool(i,j,k,ispec)
-
- ! loops over nearest neighbor points
- ! maybe a faster method could be found...
- do kk=k-1,k+1
- do jj=j-1,j+1
- do ii=i-1,i+1
- if( ii < 1 .or. jj < 1 .or. kk < 1 ) cycle
- ! distances between points
- iglob_b = ibool(ii,jj,kk,ispec)
- if( iglob_a /= iglob_b) then
- dx = sqrt( ( xstore(iglob_a) - xstore(iglob_b) )**2 &
- + ( ystore(iglob_a) - ystore(iglob_b) )**2 &
- + ( zstore(iglob_a) - zstore(iglob_b) )**2 )
- if( dx < distance_min) distance_min = dx
- if( dx > distance_max) distance_max = dx
- endif
- enddo
- enddo
- enddo
-
- enddo
- enddo
- enddo
-
- distance_min_glob = min( distance_min_glob, distance_min)
- distance_max_glob = max( distance_max_glob, distance_max)
-
- ! courant number
- if( DT_PRESENT ) then
- cmax = max( vpmax,vsmax ) * DT / distance_min
- cmax_glob = max(cmax_glob,cmax)
- endif
-
- ! suggested timestep
- dt_suggested = COURANT_SUGGESTED * distance_min / max( vpmax,vsmax )
- dt_suggested_glob = min( dt_suggested_glob, dt_suggested)
-
- ! estimation of minimum period resolved
- pmax = distance_max / min( vpmin,vsmin ) * NELEM_PER_WAVELENGTH
- pmax_glob = max(pmax_glob,pmax)
-
- enddo
-
-! determines global min/max values from all cpu partitions
- if( DT_PRESENT ) then
- cmax = cmax_glob
- call max_all_cr(cmax,cmax_glob)
- endif
-
- pmax = pmax_glob
- call min_all_cr(pmax,pmax_glob)
-
- dt_suggested = dt_suggested_glob
- call min_all_cr(dt_suggested,dt_suggested_glob)
-
- vpmin = vpmin_glob
- vpmax = vpmax_glob
- call min_all_cr(vpmin,vpmin_glob)
- call max_all_cr(vpmax,vpmax_glob)
-
- vsmin = vsmin_glob
- if( has_vs_zero ) vsmin = 0.0
-
- vsmax = vsmax_glob
- call min_all_cr(vsmin,vsmin_glob)
- call max_all_cr(vsmax,vsmax_glob)
-
- distance_min = distance_min_glob
- distance_max = distance_max_glob
- call min_all_cr(distance_min,distance_min_glob)
- call max_all_cr(distance_max,distance_max_glob)
-
-
-! checks mesh
- if( distance_min_glob <= 0.0_CUSTOM_REAL ) then
- call exit_mpi(myrank,"error: GLL points minimum distance")
- endif
- if( distance_max_glob >= HUGEVAL ) then
- call exit_mpi(myrank,"error: GLL points maximum distance")
- endif
- if( vpmin_glob <= 0.0_CUSTOM_REAL ) then
- call exit_mpi(myrank,"error: vp minimum velocity")
- endif
- if( vpmax_glob >= HUGEVAL ) then
- call exit_mpi(myrank,"error: vp maximum velocity")
- endif
- if( vsmin_glob < 0.0_CUSTOM_REAL ) then
- call exit_mpi(myrank,"error: vs minimum velocity")
- endif
- if( vsmax_glob >= HUGEVAL ) then
- call exit_mpi(myrank,"error: vs maximum velocity")
- endif
-
-
-!! DK DK May 2009: added this to print the minimum and maximum number of elements
-!! DK DK May 2009: and points in the CUBIT + SCOTCH mesh
- call min_all_i(NSPEC_AB,NSPEC_AB_global_min)
- call max_all_i(NSPEC_AB,NSPEC_AB_global_max)
- call sum_all_i(NSPEC_AB,NSPEC_AB_global_sum)
-
- call min_all_i(NGLOB_AB,NGLOB_AB_global_min)
- call max_all_i(NGLOB_AB,NGLOB_AB_global_max)
- call sum_all_i(NGLOB_AB,NGLOB_AB_global_sum)
-
- call world_size(sizeprocs)
-
-! outputs infos
- if ( myrank == 0 ) then
- write(IMAIN,*)
- write(IMAIN,*) '********'
- write(IMAIN,*) 'minimum and maximum number of elements'
- write(IMAIN,*) 'and points in the CUBIT + SCOTCH mesh:'
- write(IMAIN,*)
- write(IMAIN,*) 'NSPEC_AB_global_min = ',NSPEC_AB_global_min
- write(IMAIN,*) 'NSPEC_AB_global_max = ',NSPEC_AB_global_max
- !write(IMAIN,*) 'NSPEC_AB_global_mean = ',NSPEC_AB_global_sum / float(sizeprocs)
- write(IMAIN,*) 'NSPEC_AB_global_sum = ',NSPEC_AB_global_sum
- write(IMAIN,*)
- write(IMAIN,*) 'NGLOB_AB_global_min = ',NGLOB_AB_global_min
- write(IMAIN,*) 'NGLOB_AB_global_max = ',NGLOB_AB_global_max
- write(IMAIN,*) 'NGLOB_AB_global_sum = ',NGLOB_AB_global_sum
- write(IMAIN,*)
- write(IMAIN,*) '********'
- write(IMAIN,*) 'Model: P velocity min,max = ',vpmin_glob,vpmax_glob
- write(IMAIN,*) 'Model: S velocity min,max = ',vsmin_glob,vsmax_glob
- write(IMAIN,*) '********'
- write(IMAIN,*)
- write(IMAIN,*) '*********************************************'
- write(IMAIN,*) '*** Verification of simulation parameters ***'
- write(IMAIN,*) '*********************************************'
- write(IMAIN,*)
- write(IMAIN,*) '*** Max GLL point distance = ',distance_max_glob
- write(IMAIN,*) '*** Min GLL point distance = ',distance_min_glob
- write(IMAIN,*) '*** Max/min ratio = ',distance_max_glob/distance_min_glob
- write(IMAIN,*)
- write(IMAIN,*) '*** Minimum period resolved = ',pmax_glob
- write(IMAIN,*) '*** Maximum suggested time step = ',dt_suggested_glob
- write(IMAIN,*)
- if( DT_PRESENT ) then
- write(IMAIN,*) '*** for DT : ',DT
- write(IMAIN,*) '*** Max stability for wave velocities = ',cmax_glob
- write(IMAIN,*)
- endif
- endif
-
- ! returns the maximum velocity
- if( myrank == 0 ) then
- if( vpmax_glob > vsmax_glob ) then
- model_speed_max = vpmax_glob
- else
- model_speed_max = vsmax_glob
- endif
- endif
- call bcast_all_cr(model_speed_max,1)
-
-
- end subroutine
-
\ No newline at end of file
Deleted: seismo/3D/SPECFEM3D/trunk/combine_AVS_DX.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/combine_AVS_DX.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/combine_AVS_DX.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,722 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-! combine AVS or DX global data files to check the mesh
-! this is done in postprocessing after running the mesh generator
-! can combine full mesh, edges only or faces only
-
- program combine_AVS_DX
-
- implicit none
-
- include "constants.h"
-
- integer iproc,nspec,npoin
- integer ispec
- integer iglob1,iglob2,iglob3,iglob4
- integer ipoin,numpoin,iglobpointoffset,ntotpoin,ntotspec
- integer numelem,iglobelemoffset,idoubling,maxdoubling,iformat,ivalue,icolor
- integer imaterial,imatprop
- integer nrec,ir
- integer ntotpoinAVS_DX,ntotspecAVS_DX
-
- real random_val
- integer ival_color
- integer, dimension(:), allocatable :: random_colors
-
- double precision xval,yval,zval
- double precision val_color
-
-! for source location
- integer yr,jda,ho,mi
- double precision x_target_source,y_target_source,z_target_source
- double precision x_source_quad1,y_source_quad1,z_source_quad1
- double precision x_source_quad2,y_source_quad2,z_source_quad2
- double precision x_source_quad3,y_source_quad3,z_source_quad3
- double precision x_source_quad4,y_source_quad4,z_source_quad4
- double precision sec
-
- double precision, dimension(:), allocatable :: hdur,t_cmt,lat,long,depth
- double precision, dimension(:,:), allocatable :: moment_tensor
-
- logical USE_OPENDX
-
-! for receiver location
- integer irec,ios
- double precision, allocatable, dimension(:) :: stlat,stlon,stele,stbur
- character(len=MAX_LENGTH_STATION_NAME), allocatable, dimension(:) :: station_name
- character(len=MAX_LENGTH_NETWORK_NAME), allocatable, dimension(:) :: network_name
- character(len=256) dummystring
-
- double precision, allocatable, dimension(:) :: x_target,y_target,z_target
-
-! processor identification
- character(len=256) prname
-
-! small offset for source and receiver line in AVS_DX
-! (small compared to normalized radius of the Earth)
-
-! offset to represent source and receivers for model
- double precision, parameter :: small_offset = 2000.d0
-
-! parameters read from parameter file
- integer NER_SEDIM,NER_BASEMENT_SEDIM,NER_16_BASEMENT, &
- NER_MOHO_16,NER_BOTTOM_MOHO,NEX_XI,NEX_ETA, &
- NPROC_XI,NPROC_ETA,NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,UTM_PROJECTION_ZONE,SIMULATION_TYPE
- integer NSOURCES,NTSTEP_BETWEEN_READ_ADJSRC
-
- double precision UTM_X_MIN,UTM_X_MAX,UTM_Y_MIN,UTM_Y_MAX,Z_DEPTH_BLOCK
- double precision DT,LATITUDE_MIN,LATITUDE_MAX,LONGITUDE_MIN,LONGITUDE_MAX,HDUR_MOVIE
- double precision THICKNESS_TAPER_BLOCK_HR,THICKNESS_TAPER_BLOCK_MR,VP_MIN_GOCAD,VP_VS_RATIO_GOCAD_TOP,VP_VS_RATIO_GOCAD_BOTTOM
-
- logical HARVARD_3D_GOCAD_MODEL,ATTENUATION,USE_OLSEN_ATTENUATION, &
- OCEANS,IMPOSE_MINIMUM_VP_GOCAD,HAUKSSON_REGIONAL_MODEL, &
- BASEMENT_MAP,MOHO_MAP_LUPEI,ABSORBING_CONDITIONS,SAVE_FORWARD
- logical ANISOTROPY,SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION
- logical MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
- USE_HIGHRES_FOR_MOVIES,SUPPRESS_UTM_PROJECTION,USE_REGULAR_MESH
- integer NTSTEP_BETWEEN_FRAMES,NTSTEP_BETWEEN_OUTPUT_INFO
-
- double precision zscaling
-
- character(len=256) OUTPUT_FILES,LOCAL_PATH,MODEL,filtered_rec_filename
-
-! parameters deduced from parameters read from file
- integer NPROC,NEX_PER_PROC_XI,NEX_PER_PROC_ETA
- integer NER
-
- integer 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
-
- integer proc_p1,proc_p2
-
-! ************** PROGRAM STARTS HERE **************
-
-! only for old regular meshes!
-
- print *
- print *,'Recombining all AVS or DX files for slices'
- print *
-
- print *
- print *,'reading parameter file'
- print *
-
-! read the parameter file
- call read_parameter_file(LATITUDE_MIN,LATITUDE_MAX,LONGITUDE_MIN,LONGITUDE_MAX, &
- UTM_X_MIN,UTM_X_MAX,UTM_Y_MIN,UTM_Y_MAX,Z_DEPTH_BLOCK, &
- NER_SEDIM,NER_BASEMENT_SEDIM,NER_16_BASEMENT,NER_MOHO_16,NER_BOTTOM_MOHO, &
- NEX_XI,NEX_ETA,NPROC_XI,NPROC_ETA,NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,UTM_PROJECTION_ZONE,DT, &
- ATTENUATION,USE_OLSEN_ATTENUATION,HARVARD_3D_GOCAD_MODEL,LOCAL_PATH,NSOURCES, &
- THICKNESS_TAPER_BLOCK_HR,THICKNESS_TAPER_BLOCK_MR,VP_MIN_GOCAD,VP_VS_RATIO_GOCAD_TOP,VP_VS_RATIO_GOCAD_BOTTOM, &
- OCEANS,IMPOSE_MINIMUM_VP_GOCAD,HAUKSSON_REGIONAL_MODEL,ANISOTROPY, &
- BASEMENT_MAP,MOHO_MAP_LUPEI,ABSORBING_CONDITIONS, &
- MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
- NTSTEP_BETWEEN_FRAMES,USE_HIGHRES_FOR_MOVIES,HDUR_MOVIE, &
- SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION, &
- NTSTEP_BETWEEN_OUTPUT_INFO,SUPPRESS_UTM_PROJECTION,MODEL,USE_REGULAR_MESH,SIMULATION_TYPE,SAVE_FORWARD, &
- NTSTEP_BETWEEN_READ_ADJSRC)
-
- if(.not. SAVE_MESH_FILES) stop 'AVS or DX files were not saved by the mesher'
-
-! get the base pathname for output files
- call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
-
- allocate(hdur(NSOURCES))
- allocate(t_cmt(NSOURCES))
- allocate(lat(NSOURCES))
- allocate(long(NSOURCES))
- allocate(depth(NSOURCES))
- allocate(moment_tensor(6,NSOURCES))
-
- print *,'1 = create files in OpenDX format'
- print *,'2 = create files in AVS UCD format'
- print *,'any other value = exit'
- print *
- print *,'enter value:'
- read(5,*) iformat
- if(iformat<1 .or. iformat>2) stop 'exiting...'
- if(iformat == 1) then
- USE_OPENDX = .true.
- else
- USE_OPENDX = .false.
- endif
-
- print *
- print *,'1 = edges of all the slices only'
- print *,'2 = surface of the model only'
- print *,'any other value = exit'
- print *
- print *,'enter value:'
- read(5,*) ivalue
- if(ivalue<1 .or. ivalue>2) stop 'exiting...'
-
-! apply scaling to topography if needed
- if(ivalue == 2) then
- print *
- print *,'scaling to apply to Z to amplify topography (1. to do nothing, 0. to get flat surface):'
- read(5,*) zscaling
- else
- zscaling = 1.d0
- endif
-
- print *
- print *,'1 = color by doubling flag'
- print *,'2 = by slice number'
- print *,'3 = by elevation of topography (for surface of model only)'
- print *,'4 = random color to show MPI slices'
- print *,'any other value=exit'
- print *
- print *,'enter value:'
- read(5,*) icolor
- if(icolor<1 .or. icolor >4) stop 'exiting...'
- if(icolor == 3 .and. ivalue /= 2) stop 'color by elevation of topography is for surface of model only'
-
- print *
- print *,'1 = material property by doubling flag'
- print *,'2 = by slice number'
- print *,'any other value=exit'
- print *
- print *,'enter value:'
- read(5,*) imaterial
- if(imaterial < 1 .or. imaterial > 2) stop 'exiting...'
-
-! compute other parameters based upon values read
- call compute_parameters(NER,NEX_XI,NEX_ETA,NPROC_XI,NPROC_ETA, &
- NPROC,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
- NER_BOTTOM_MOHO,NER_MOHO_16,NER_16_BASEMENT,NER_BASEMENT_SEDIM,NER_SEDIM, &
- 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)
-
- print *
- print *,'There are ',NPROC,' slices numbered from 0 to ',NPROC-1
- print *
-
-! user can specify a range of processors here, enter 0 and -1 for all procs
- print *
- print *,'enter first proc (proc numbers start at 0) = '
- read(5,*) proc_p1
- if(proc_p1 < 0) proc_p1 = 0
- if(proc_p1 > NPROC-1) proc_p1 = NPROC-1
-
- print *,'enter last proc (enter -1 for all procs) = '
- read(5,*) proc_p2
- if(proc_p2 == -1) proc_p2 = NPROC-1
- if(proc_p2 < 0) proc_p2 = 0
- if(proc_p2 > NPROC-1) proc_p2 = NPROC-1
-
-! set interval to maximum if user input is not correct
- if(proc_p1 <= 0) proc_p1 = 0
- if(proc_p2 < 0) proc_p2 = NPROC - 1
-
-! set total number of points and elements to zero
- ntotpoin = 0
- ntotspec = 0
-
-! initialize random colors
- allocate(random_colors(0:NPROC-1))
- do iproc=0,NPROC-1
- call random_number(random_val)
- ival_color = nint(random_val*NPROC)
- if(ival_color < 0) ival_color = 0
- if(ival_color > NPROC-1) ival_color = NPROC-1
- random_colors(iproc) = ival_color
- enddo
-
-! loop on the selected range of processors
- do iproc = proc_p1,proc_p2
-
- print *,'Reading slice ',iproc
-
-! create the name for the database of the current slide
- call create_serial_name_database(prname,iproc,LOCAL_PATH,NPROC,OUTPUT_FILES)
-
- if(ivalue == 1) then
- open(unit=10,file=prname(1:len_trim(prname))//'AVS_DXpointsfaces.txt',status='old',action='read')
- else if(ivalue == 2) then
- open(unit=10,file=prname(1:len_trim(prname))//'AVS_DXpointssurface.txt',status='old',action='read')
- endif
-
- read(10,*) npoin
- print *,'There are ',npoin,' global AVS or DX points in the slice'
- ntotpoin = ntotpoin + npoin
- close(10)
-
- if(ivalue == 1) then
- open(unit=10,file=prname(1:len_trim(prname))//'AVS_DXelementsfaces.txt',status='old',action='read')
- else if(ivalue == 2) then
- open(unit=10,file=prname(1:len_trim(prname))//'AVS_DXelementssurface.txt',status='old',action='read')
- endif
-
- read(10,*) nspec
- print *,'There are ',nspec,' AVS or DX elements in the slice'
- ntotspec = ntotspec + nspec
- close(10)
-
- enddo
-
- print *
- print *,'There is a total of ',ntotspec,' elements in all the slices'
- print *,'There is a total of ',ntotpoin,' points in all the slices'
- print *
-
- ntotpoinAVS_DX = ntotpoin
- ntotspecAVS_DX = ntotspec
-
-! use different name for surface and for slices
- if(USE_OPENDX) then
- open(unit=11,file=trim(OUTPUT_FILES)//'/DX_fullmesh.dx',status='unknown')
- write(11,*) 'object 1 class array type float rank 1 shape 3 items ',ntotpoinAVS_DX,' data follows'
- else
- open(unit=11,file=trim(OUTPUT_FILES)//'/AVS_fullmesh.inp',status='unknown')
- endif
-
-! write AVS or DX header with element data or point data
- if(.not. USE_OPENDX) then
- if(ivalue == 2 .and. icolor == 3) then
- write(11,*) ntotpoinAVS_DX,' ',ntotspecAVS_DX,' 1 0 0'
- else
- write(11,*) ntotpoinAVS_DX,' ',ntotspecAVS_DX,' 0 1 0'
- endif
- endif
-
-! ************* generate points ******************
-
-! set global point offset to zero
- iglobpointoffset = 0
-
-! loop on the selected range of processors
- do iproc=proc_p1,proc_p2
-
- print *,'Reading slice ',iproc
-
-! create the name for the database of the current slide
- call create_serial_name_database(prname,iproc,LOCAL_PATH,NPROC,OUTPUT_FILES)
-
- if(ivalue == 1) then
- open(unit=10,file=prname(1:len_trim(prname))//'AVS_DXpointsfaces.txt',status='old',action='read')
- else if(ivalue == 2) then
- open(unit=10,file=prname(1:len_trim(prname))//'AVS_DXpointssurface.txt',status='old',action='read')
- endif
-
- read(10,*) npoin
- print *,'There are ',npoin,' global AVS or DX points in the slice'
-
-! read local points in this slice and output global AVS or DX points
- do ipoin=1,npoin
- read(10,*) numpoin,xval,yval,zval
- if(numpoin /= ipoin) stop 'incorrect point number'
-! write to AVS or DX global file with correct offset
- if(USE_OPENDX) then
- write(11,*) sngl(xval),' ',sngl(yval),' ',sngl(zval*zscaling)
- else
-!! write(11,*) numpoin + iglobpointoffset,' ',sngl(xval),' ',sngl(yval),' ',sngl(zval*zscaling)
-!! XXX
- if(zval < 0.) then
- write(11,*) numpoin + iglobpointoffset,' ',sngl(xval),' ',sngl(yval),' ',sngl(zval*zscaling)
-else
- write(11,*) numpoin + iglobpointoffset,' ',sngl(xval),' ',sngl(yval),' ',' 0'
-endif
- endif
-
- enddo
-
- iglobpointoffset = iglobpointoffset + npoin
-
- close(10)
-
- enddo
-
-! ************* generate elements ******************
-
-! get source information for frequency for number of points per lambda
- print *,'reading source duration from the CMTSOLUTION file'
- call get_cmt(yr,jda,ho,mi,sec,t_cmt,hdur,lat,long,depth,moment_tensor,NSOURCES)
-
-! set global element and point offsets to zero
- iglobpointoffset = 0
- iglobelemoffset = 0
- maxdoubling = -1
-
- if(USE_OPENDX) &
- write(11,*) 'object 2 class array type int rank 1 shape 4 items ',ntotspecAVS_DX,' data follows'
-
-! loop on the selected range of processors
- do iproc=proc_p1,proc_p2
-
- print *,'Reading slice ',iproc
-
-! create the name for the database of the current slide
- call create_serial_name_database(prname,iproc,LOCAL_PATH,NPROC,OUTPUT_FILES)
-
- if(ivalue == 1) then
- open(unit=10,file=prname(1:len_trim(prname))//'AVS_DXelementsfaces.txt',status='old',action='read')
- open(unit=12,file=prname(1:len_trim(prname))//'AVS_DXpointsfaces.txt',status='old',action='read')
- else if(ivalue == 2) then
- open(unit=10,file=prname(1:len_trim(prname))//'AVS_DXelementssurface.txt',status='old',action='read')
- open(unit=12,file=prname(1:len_trim(prname))//'AVS_DXpointssurface.txt',status='old',action='read')
- endif
-
- read(10,*) nspec
- print *,'There are ',nspec,' AVS or DX elements in the slice'
-
- read(12,*) npoin
- print *,'There are ',npoin,' global AVS or DX points in the slice'
-
-! read local elements in this slice and output global AVS or DX elements
- do ispec=1,nspec
- read(10,*) numelem,idoubling,iglob1,iglob2,iglob3,iglob4
- if(numelem /= ispec) stop 'incorrect element number'
-! compute max of the doubling flag
- maxdoubling = max(maxdoubling,idoubling)
-
-! assign material property (which can be filtered later in AVS_DX)
- if(imaterial == 1) then
- imatprop = idoubling
- else if(imaterial == 2) then
- imatprop = iproc
- else
- stop 'invalid code for material property'
- endif
-
-! write to AVS or DX global file with correct offset
-
-! quadrangles (2-D)
- iglob1 = iglob1 + iglobpointoffset
- iglob2 = iglob2 + iglobpointoffset
- iglob3 = iglob3 + iglobpointoffset
- iglob4 = iglob4 + iglobpointoffset
-
-! in the case of OpenDX, node numbers start at zero
-! in the case of AVS, node numbers start at one
-! point order in OpenDX is 1,4,2,3 *not* 1,2,3,4 as in AVS
- if(USE_OPENDX) then
- write(11,"(i6,1x,i6,1x,i6,1x,i6)") iglob1-1,iglob4-1,iglob2-1,iglob3-1
- else
- write(11,"(i6,1x,i3,' quad ',i6,1x,i6,1x,i6,1x,i6)") numelem + iglobelemoffset,imatprop,iglob1,iglob2,iglob3,iglob4
- endif
-
- enddo
-
- iglobelemoffset = iglobelemoffset + nspec
- iglobpointoffset = iglobpointoffset + npoin
-
- close(10)
- close(12)
-
- enddo
-
-! ************* generate data values ******************
-
-! output AVS or DX header for data
- if(USE_OPENDX) then
- write(11,*) 'attribute "element type" string "quads"'
- write(11,*) 'attribute "ref" string "positions"'
- if(ivalue == 2 .and. icolor == 3) then
- write(11,*) 'object 3 class array type float rank 0 items ',ntotpoinAVS_DX,' data follows'
- else
- write(11,*) 'object 3 class array type float rank 0 items ',ntotspecAVS_DX,' data follows'
- endif
- else
- write(11,*) '1 1'
- write(11,*) 'Zcoord, meters'
- endif
-
-!!!!
-!!!! ###### element data in most cases
-!!!!
- if(ivalue /= 2 .or. icolor /= 3) then
-
-! set global element and point offsets to zero
- iglobelemoffset = 0
-
-! loop on the selected range of processors
- do iproc=proc_p1,proc_p2
-
- print *,'Reading slice ',iproc
-
-! create the name for the database of the current slide
- call create_serial_name_database(prname,iproc,LOCAL_PATH,NPROC,OUTPUT_FILES)
-
- if(ivalue == 1) then
- open(unit=10,file=prname(1:len_trim(prname))//'AVS_DXelementsfaces.txt',status='old',action='read')
- else if(ivalue == 2) then
- open(unit=10,file=prname(1:len_trim(prname))//'AVS_DXelementssurface.txt',status='old',action='read')
- endif
-
- read(10,*) nspec
- print *,'There are ',nspec,' AVS or DX elements in the slice'
-
-! read local elements in this slice and output global AVS or DX elements
- do ispec=1,nspec
- read(10,*) numelem,idoubling,iglob1,iglob2,iglob3,iglob4
- if(numelem /= ispec) stop 'incorrect element number'
-
-! data is either the slice number or the mesh doubling region flag
- if(icolor == 1) then
- val_color = dble(idoubling)
- else if(icolor == 2) then
- val_color = dble(iproc)
- else if(icolor == 4) then
- val_color = dble(random_colors(iproc))
- else
- stop 'incorrect coloring code'
- endif
-
-! write to AVS or DX global file with correct offset
- if(USE_OPENDX) then
- write(11,*) sngl(val_color)
- else
- write(11,*) numelem + iglobelemoffset,' ',sngl(val_color)
- endif
- enddo
-
- iglobelemoffset = iglobelemoffset + nspec
-
- close(10)
-
- enddo
-
-!!!!
-!!!! ###### point data if surface colored according to topography
-!!!!
- else
-
-! set global point offset to zero
- iglobpointoffset = 0
-
-! loop on the selected range of processors
- do iproc=proc_p1,proc_p2
-
- print *,'Reading slice ',iproc
-
-! create the name for the database of the current slide
- call create_serial_name_database(prname,iproc,LOCAL_PATH,NPROC,OUTPUT_FILES)
-
- open(unit=10,file=prname(1:len_trim(prname))//'AVS_DXpointssurface.txt',status='old',action='read')
-
- read(10,*) npoin
- print *,'There are ',npoin,' global AVS or DX points in the slice'
-
-! read local points in this slice and output global AVS or DX points
- do ipoin=1,npoin
- read(10,*) numpoin,xval,yval,zval
- if(numpoin /= ipoin) stop 'incorrect point number'
-! write to AVS or DX global file with correct offset
- if(USE_OPENDX) then
- write(11,*) sngl(zval)
- else
- write(11,*) numpoin + iglobpointoffset,' ',sngl(zval)
- endif
-
- enddo
-
- iglobpointoffset = iglobpointoffset + npoin
-
- close(10)
-
- enddo
-
- endif ! end test if element data or point data
-
-! define OpenDX field
- if(USE_OPENDX) then
- if(ivalue == 2 .and. icolor == 3) then
- write(11,*) 'attribute "dep" string "positions"'
- else
- write(11,*) 'attribute "dep" string "connections"'
- endif
- write(11,*) 'object "irregular positions irregular connections" class field'
- write(11,*) 'component "positions" value 1'
- write(11,*) 'component "connections" value 2'
- write(11,*) 'component "data" value 3'
- write(11,*) 'end'
- endif
-
- close(11)
-
- print *
- print *,'maximum value of doubling flag in all slices = ',maxdoubling
- print *
-
-!
-! create an AVS or DX file with the source and the receivers as well
-!
-
- if(USE_OPENDX) then
-
- print *
- print *,'support for source and station file in OpenDX not added yet'
- print *
- stop 'warning: only partial support for OpenDX in current version (mesh ok, but no source)'
-
- else
-
-! get source information
- print *,'reading position of the source from the CMTSOLUTION file'
- call get_cmt(yr,jda,ho,mi,sec,t_cmt,hdur,lat,long,depth,moment_tensor,NSOURCES)
-
-! the point for the source is put at the surface for clarity (depth ignored)
-! even slightly above to superimpose to real surface
-! also save quadrangle for AVS or DX representation of epicenter
-
- z_target_source = 2000.
- z_source_quad1 = 2000.
- z_source_quad2 = 2000.
- z_source_quad3 = 2000.
- z_source_quad4 = 2000.
-
- call utm_geo(long,lat,x_target_source,y_target_source,UTM_PROJECTION_ZONE,ILONGLAT2UTM,SUPPRESS_UTM_PROJECTION)
-
- x_source_quad1 = x_target_source
- y_source_quad1 = y_target_source
-
- x_source_quad2 = x_target_source + small_offset
- y_source_quad2 = y_target_source
-
- x_source_quad3 = x_target_source + small_offset
- y_source_quad3 = y_target_source + small_offset
-
- x_source_quad4 = x_target_source
- y_source_quad4 = y_target_source + small_offset
-
- ntotpoinAVS_DX = 2
- ntotspecAVS_DX = 1
-
- print *
- print *,'reading position of the receivers from DATA/STATIONS_FILTERED file'
- call get_value_string(filtered_rec_filename, 'solver.STATIONS_FILTERED', 'DATA/STATIONS_FILTERED')
-
-! get number of stations from receiver file
- open(unit=11,file=filtered_rec_filename,iostat=ios,status='old',action='read')
- nrec = 0
- do while(ios == 0)
- read(11,"(a)",iostat=ios) dummystring
- if(ios == 0) nrec = nrec + 1
- enddo
- close(11)
-
- print *,'There are ',nrec,' three-component stations'
- print *
- if(nrec < 1) stop 'incorrect number of stations read - need at least one'
-
- allocate(station_name(nrec))
- allocate(network_name(nrec))
- allocate(stlat(nrec))
- allocate(stlon(nrec))
- allocate(stele(nrec))
- allocate(stbur(nrec))
-
- allocate(x_target(nrec))
- allocate(y_target(nrec))
- allocate(z_target(nrec))
-
-! loop on all the stations
- open(unit=11,file=filtered_rec_filename,status='old',action='read')
- do irec=1,nrec
- read(11,*) station_name(irec),network_name(irec),stlat(irec),stlon(irec),stele(irec),stbur(irec)
-
-! points for the receivers are put at the surface for clarity (depth ignored)
- call utm_geo(stlon(irec),stlat(irec),x_target(irec),y_target(irec),UTM_PROJECTION_ZONE,ILONGLAT2UTM,SUPPRESS_UTM_PROJECTION)
-
- z_target(irec) = 2000.
-
- enddo
-
- close(11)
-
-! duplicate source to have right color normalization in AVS_DX
- ntotpoinAVS_DX = ntotpoinAVS_DX + 2*nrec + 1
- ntotspecAVS_DX = ntotspecAVS_DX + nrec + 1
-
- open(unit=11,file=trim(OUTPUT_FILES)//'/AVS_source_receivers.inp',status='unknown')
-
-! write AVS or DX header with element data
- write(11,*) ntotpoinAVS_DX,' ',ntotspecAVS_DX,' 0 1 0'
-
-! add source and receivers (small AVS or DX lines)
- write(11,*) '1 ',sngl(x_target_source),' ',sngl(y_target_source),' ',sngl(z_target_source)
- write(11,*) '2 ',sngl(x_target_source+small_offset),' ', &
- sngl(y_target_source+small_offset),' ',sngl(z_target_source+small_offset)
- write(11,*) '3 ',sngl(x_target_source+small_offset),' ', &
- sngl(y_target_source+small_offset),' ',sngl(z_target_source+small_offset)
- do ir=1,nrec
- write(11,*) 4+2*(ir-1),' ',sngl(x_target(ir)),' ',sngl(y_target(ir)),' ',sngl(z_target(ir))
- write(11,*) 4+2*(ir-1)+1,' ',sngl(x_target(ir)+small_offset),' ', &
- sngl(y_target(ir)+small_offset),' ',sngl(z_target(ir)+small_offset)
- enddo
-
-! add source and receivers (small AVS or DX lines)
- write(11,*) '1 1 line 1 2'
- do ir=1,nrec
- write(11,*) ir+1,' 1 line ',4+2*(ir-1),' ',4+2*(ir-1)+1
- enddo
-! duplicate source to have right color normalization in AVS_DX
- write(11,*) ir+1,' 1 line 1 3'
-
-! output AVS or DX header for data
- write(11,*) '1 1'
- write(11,*) 'Zcoord, meters'
-
-! add source and receiver data
- write(11,*) '1 1.'
- do ir=1,nrec
- write(11,*) ir+1,' 255.'
- enddo
-! duplicate source to have right color normalization in AVS_DX
- write(11,*) ir+1,' 120.'
-
- close(11)
-
-! create a file with the epicenter only, represented as a quadrangle
-
- open(unit=11,file=trim(OUTPUT_FILES)//'/AVS_epicenter.inp',status='unknown')
-
-! write AVS or DX header with element data
- write(11,*) '4 1 0 1 0'
-
-! add source and receivers (small AVS or DX lines)
- write(11,*) '1 ',sngl(x_source_quad1),' ',sngl(y_source_quad1),' ',sngl(z_source_quad1)
- write(11,*) '2 ',sngl(x_source_quad2),' ',sngl(y_source_quad2),' ',sngl(z_source_quad2)
- write(11,*) '3 ',sngl(x_source_quad3),' ',sngl(y_source_quad3),' ',sngl(z_source_quad3)
- write(11,*) '4 ',sngl(x_source_quad4),' ',sngl(y_source_quad4),' ',sngl(z_source_quad4)
-
-! create a element for the source, some labels and element data
- write(11,*) '1 1 quad 1 2 3 4'
- write(11,*) '1 1'
- write(11,*) 'Zcoord, meters'
- write(11,*) '1 1.'
-
- close(11)
-
- endif
-
- end program combine_AVS_DX
-
Deleted: seismo/3D/SPECFEM3D/trunk/combine_surf_data.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/combine_surf_data.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/combine_surf_data.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,408 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-program combine_surf_data
-
- ! puts the output of SPECFEM3D in ParaView format.
- ! see http://www.paraview.org for details
-
- ! combines the database files on several slices.
- ! the local database file needs to have been collected onto the frontend (copy_local_database.pl)
-
- implicit none
-
- include 'constants.h'
-! include 'OUTPUT_FILES/values_from_mesher.h'
-
- integer i,j,k,ispec, ios, it
- integer iproc, proc1, proc2, num_node, node_list(300), nspec, nglob
- integer np, ne, npp, nee, npoint, nelement, njunk, n1, n2, n3, n4
- integer numpoin, iglob1, iglob2, iglob3, iglob4, iglob
- real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: data_3D
- real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: data_2D
-! integer ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB)
-! logical mask_ibool(NGLOB_AB)
-! real(kind=CUSTOM_REAL),dimension(NGLOB_AB) :: xstore, ystore, zstore
- ! mesh coordinates
- real(kind=CUSTOM_REAL),dimension(:),allocatable :: xstore, ystore, zstore
- integer, dimension(:,:,:,:),allocatable :: ibool
- logical, dimension(:),allocatable :: mask_ibool
- integer :: NSPEC_AB,NGLOB_AB
-
- real x, y, z
- real, dimension(:,:,:,:), allocatable :: dat3D
- real, dimension(:,:,:), allocatable :: dat2D
- character(len=256) :: sline, arg(8), filename, indir, outdir, prname, surfname
- character(len=256) :: mesh_file, local_file, local_data_file, local_ibool_file
- character(len=256) :: local_ibool_surf_file
-
-! integer :: num_ibool(NGLOB_AB)
- integer,dimension(:),allocatable :: num_ibool
-
- logical :: HIGH_RESOLUTION_MESH, FILE_ARRAY_IS_3D
- integer :: ires, nspec_surf, npoint1, npoint2, ispec_surf, inx, iny, idim
- integer,dimension(:), allocatable :: ibelm_surf
-
-
- do i = 1, 8
- call getarg(i,arg(i))
- if (i < 6 .and. trim(arg(i)) == '') then
- print *, 'Usage: xcombine_surface start_slice end_slice filename surfacename input_dir output_dir high/low-resolution 3D/2D'
- print *, ' or xcombine_surface slice_list filename surfacename input_dir output_dir high/low-resolution 3D/2D'
- print *, ' possible filenames are kappastore(NGLLX,NGLLY,NGLLZ,nspec), alpha_kernel(NGLLX,NGLLY,nspec_surf)'
- print *, ' possible surface name: moho as in ibelm_moho.bin'
- print *, ' files have been collected in input_dir, output mesh file goes to output_dir '
- print *, ' give 0 for low resolution and 1 for high resolution'
- print *, ' give 0 for 2D and 1 for 3D filenames'
- stop ' Reenter command line options'
- endif
- enddo
-
- ! get slice list
- if (trim(arg(8)) == '') then
- num_node = 0
- open(unit = 20, file = trim(arg(1)), status = 'unknown',iostat = ios)
- if (ios /= 0) then
- print *,'Error opening ',trim(arg(1))
- stop
- endif
- do while ( 1 == 1)
- read(20,'(a)',iostat=ios) sline
- if (ios /= 0) exit
- read(sline,*,iostat=ios) njunk
- if (ios /= 0) exit
- num_node = num_node + 1
- node_list(num_node) = njunk
- enddo
- close(20)
- filename = arg(2)
- surfname = arg(3)
- indir= arg(4)
- outdir = arg(5)
- read(arg(6),*) ires
- read(arg(7),*) idim
- else
- read(arg(1),*) proc1
- read(arg(2),*) proc2
- do iproc = proc1, proc2
- node_list(iproc - proc1 + 1) = iproc
- enddo
- num_node = proc2 - proc1 + 1
- filename = arg(3)
- surfname = arg(4)
- indir = arg(5)
- outdir = arg(6)
- read(arg(7),*) ires
- read(arg(8),*) idim
- endif
-
- if (ires == 0) then
- HIGH_RESOLUTION_MESH = .false.
- inx = NGLLX-1
- iny = NGLLY-1
- else
- HIGH_RESOLUTION_MESH = .true.
- inx = 1
- iny = 1
- endif
-
- if (idim == 0) then
- FILE_ARRAY_IS_3D = .false.
- else
- FILE_ARRAY_IS_3D = .true.
- endif
-
- print *, 'Slice list: '
- print *, node_list(1:num_node)
-
- ! open paraview output mesh file
- mesh_file = trim(outdir) // '/' // trim(filename)//'.surf'
- call open_file(trim(mesh_file)//char(0))
-
-! nspec = NSPEC_AB
-! nglob = NGLOB_AB
-
- np = 0
-
- ! ======= loop over all slices, write point and scalar information ======
-
- do it = 1, num_node
-
- iproc = node_list(it)
-
- print *, ' '
- print *, 'Reading slice ', iproc
- write(prname,'(a,i6.6,a)') trim(indir)//'/proc',iproc,'_'
-
- ! gets number of elements and global points for this partition
- open(unit=27,file=prname(1:len_trim(prname))//'external_mesh.bin',&
- status='old',action='read',form='unformatted',iostat=ios)
- read(27) NSPEC_AB
- read(27) NGLOB_AB
- close(27)
- nspec = NSPEC_AB
- nglob = NGLOB_AB
-
- ! allocates arrays
- allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- allocate(mask_ibool(NGLOB_AB))
- allocate(num_ibool(NGLOB_AB))
- allocate(xstore(NGLOB_AB),ystore(NGLOB_AB),zstore(NGLOB_AB))
-
- ! surface file
- local_ibool_surf_file = trim(prname) // 'ibelm_' //trim(surfname)// '.bin'
- open(unit = 28,file = trim(local_ibool_surf_file),status='old', iostat = ios, form='unformatted')
- if (ios /= 0) then
- print *,'Error opening ',trim(local_ibool_surf_file)
- stop
- endif
- read(28) nspec_surf
- read(28) npoint1
- read(28) npoint2
-
- if (it == 1) allocate(ibelm_surf(nspec_surf))
- read(28) ibelm_surf
- close(28)
- print *, trim(local_ibool_surf_file)
-
- if (it == 1) then
- if (FILE_ARRAY_IS_3D) then
- allocate(data_3D(NGLLX,NGLLY,NGLLZ,NSPEC_AB),dat3D(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- else
- allocate(data_2D(NGLLX,NGLLY,nspec_surf),dat2D(NGLLX,NGLLY,nspec_surf))
- endif
- endif
-
- ! data file
- local_data_file = trim(prname) // trim(filename) // '.bin'
- open(unit = 27,file = trim(local_data_file),status='old', iostat = ios,form ='unformatted')
- if (ios /= 0) then
- print *,'Error opening ',trim(local_data_file)
- stop
- endif
- if (FILE_ARRAY_IS_3D) then
- read(27) data_3D
- dat3D = data_3D
- else
- read(27) data_2D
- dat2D = data_2D
- endif
- close(27)
- print *, trim(local_data_file)
-
- ! ibool file
- local_ibool_file = trim(prname) // 'ibool' // '.bin'
- open(unit = 28,file = trim(local_ibool_file),status='old', iostat = ios, form='unformatted')
- if (ios /= 0) then
- print *,'Error opening ',trim(local_data_file)
- stop
- endif
- read(28) ibool
- close(28)
- print *, trim(local_ibool_file)
-
-
- mask_ibool(:) = .false.
- numpoin = 0
-
- if (it == 1) then
- if (HIGH_RESOLUTION_MESH) then
- npoint = npoint2
- else
- npoint = npoint1
- endif
- npp = npoint * num_node
- call write_integer(npp)
- endif
-
- local_file = trim(prname)//'x.bin'
- open(unit = 27,file = trim(prname)//'x.bin',status='old', iostat = ios,form ='unformatted')
- if (ios /= 0) then
- print *,'Error opening ',trim(local_file)
- stop
- endif
- read(27) xstore
- close(27)
- local_file = trim(prname)//'y.bin'
- open(unit = 27,file = trim(prname)//'y.bin',status='old', iostat = ios,form ='unformatted')
- if (ios /= 0) then
- print *,'Error opening ',trim(local_file)
- stop
- endif
- read(27) ystore
- close(27)
- local_file = trim(prname)//'z.bin'
- open(unit = 27,file = trim(prname)//'z.bin',status='old', iostat = ios,form ='unformatted')
- if (ios /= 0) then
- print *,'Error opening ',trim(local_file)
- stop
- endif
- read(27) zstore
- close(27)
-
- do ispec_surf=1,nspec_surf
- ispec = ibelm_surf(ispec_surf)
- k = 1
- do j = 1, NGLLY, iny
- do i = 1, NGLLX, inx
- iglob = ibool(i,j,k,ispec)
- if(.not. mask_ibool(iglob)) then
- numpoin = numpoin + 1
- x = xstore(iglob)
- y = ystore(iglob)
- z = zstore(iglob)
- call write_real(x)
- call write_real(y)
- call write_real(z)
- if (FILE_ARRAY_IS_3D) then
- call write_real(dat3D(i,j,k,ispec))
- else
- call write_real(dat2D(i,j,ispec_surf))
- endif
- mask_ibool(iglob) = .true.
- endif
- enddo ! i
- enddo ! j
- enddo !ispec
-
- if (numpoin /= npoint) stop 'Error: number of points are not consistent'
- np = np + npoint
-
- ! frees arrays
- deallocate(ibool,mask_ibool,num_ibool,xstore,ystore,zstore)
-
- enddo ! all slices for points
-
- if (np /= npp) stop 'Error: Number of total points are not consistent'
- print *, 'Total number of points: ', np
- print *, ' '
-
-
- ne = 0
- ! ============ write element information =====================
- do it = 1, num_node
-
- iproc = node_list(it)
-
- print *, 'Reading slice ', iproc
- write(prname,'(a,i6.6,a)') trim(indir)//'/proc',iproc,'_'
-
- ! gets number of elements and global points for this partition
- open(unit=27,file=prname(1:len_trim(prname))//'external_mesh.bin',&
- status='old',action='read',form='unformatted',iostat=ios)
- read(27) NSPEC_AB
- read(27) NGLOB_AB
- close(27)
- nspec = NSPEC_AB
- nglob = NGLOB_AB
-
- ! allocates arrays
- allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- allocate(mask_ibool(NGLOB_AB))
- allocate(num_ibool(NGLOB_AB))
-
-
- np = npoint * (it-1)
-
-! surface file
- local_ibool_surf_file = trim(prname) // 'ibelm_' //trim(surfname)// '.bin'
- open(unit = 28,file = trim(local_ibool_surf_file),status='old', iostat = ios, form='unformatted')
- read(28) nspec_surf
- read(28) njunk
- read(28) njunk
- read(28) ibelm_surf
- close(28)
-
-! ibool file
- local_ibool_file = trim(prname) // 'ibool' // '.bin'
- open(unit = 28,file = trim(local_ibool_file),status='old', iostat = ios, form='unformatted')
- read(28) ibool
- close(28)
-
- if (it == 1) then
- if (HIGH_RESOLUTION_MESH) then
- nelement = nspec_surf * (NGLLX-1) * (NGLLY-1)
- else
- nelement = nspec_surf
- endif
- nee = nelement * num_node
- call write_integer(nee)
- endif
-
- numpoin = 0
- mask_ibool = .false.
- do ispec_surf=1,nspec_surf
- ispec = ibelm_surf(ispec_surf)
- k = 1
- do j = 1, NGLLY, iny
- do i = 1, NGLLX, inx
- iglob = ibool(i,j,k,ispec)
- if(.not. mask_ibool(iglob)) then
- numpoin = numpoin + 1
- num_ibool(iglob) = numpoin
- mask_ibool(iglob) = .true.
- endif
- enddo ! i
- enddo ! j
- enddo !ispec
-
- do ispec_surf = 1, nspec_surf
- ispec = ibelm_surf(ispec_surf)
- k = 1
- do j = 1, NGLLY-1, iny
- do i = 1, NGLLX-1, inx
- iglob1 = ibool(i,j,k,ispec)
- iglob2 = ibool(i+inx,j,k,ispec)
- iglob3 = ibool(i+inx,j+iny,k,ispec)
- iglob4 = ibool(i,j+iny,k,ispec)
-
- n1 = num_ibool(iglob1)+np-1
- n2 = num_ibool(iglob2)+np-1
- n3 = num_ibool(iglob3)+np-1
- n4 = num_ibool(iglob4)+np-1
-
- call write_integer(n1)
- call write_integer(n2)
- call write_integer(n3)
- call write_integer(n4)
-
- enddo
- enddo
- enddo
- ne = ne + nelement
-
- ! frees arrays
- deallocate(ibool,mask_ibool,num_ibool)
-
- enddo ! num_node
- if (ne /= nee) stop 'Number of total elements are not consistent'
- print *, 'Total number of elements: ', ne
-
- call close_file()
-
- print *, 'Done writing '//trim(mesh_file)
-
-end program combine_surf_data
-
Deleted: seismo/3D/SPECFEM3D/trunk/combine_vol_data.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/combine_vol_data.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/combine_vol_data.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,802 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- program combine_paraview_data_ext_mesh
-
-! puts the output of SPECFEM3D into '***.mesh' format,
-! which can be converted via mesh2vtu into ParaView format.
-!
-! for Paraview, see http://www.paraview.org for details
-!
-! combines the database files on several slices.
-! the local database file needs to have been collected onto the frontend (copy_local_database.pl)
-!
-! works for external, unregular meshes
-
- implicit none
-
- include 'constants.h'
-
- ! data must be of dimension: (NGLLX,NGLLY,NGLLZ,NSPEC_AB)
- double precision,dimension(:,:,:,:),allocatable :: data
- ! real array for data
- real,dimension(:,:,:,:),allocatable :: dat
-
- ! mesh coordinates
- real(kind=CUSTOM_REAL),dimension(:),allocatable :: xstore, ystore, zstore
- integer, dimension(:,:,:,:),allocatable :: ibool
-
- integer :: NSPEC_AB, NGLOB_AB
- integer :: numpoin
- integer :: i, ios, it
- integer :: iproc, proc1, proc2, num_node, node_list(300)
- integer :: np, ne, npp, nee, nelement, njunk
-
- character(len=256) :: sline, arg(6), filename, indir, outdir
- character(len=256) :: prname, prname_lp
- character(len=256) :: mesh_file,local_data_file
- logical :: HIGH_RESOLUTION_MESH
- integer :: ires
-
- ! for read_parameter_files
- double precision :: DT
- double precision :: HDUR_MOVIE
- integer :: NPROC,NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP, &
- UTM_PROJECTION_ZONE,SIMULATION_TYPE
- integer :: NSOURCES,NTSTEP_BETWEEN_READ_ADJSRC
- integer :: NTSTEP_BETWEEN_FRAMES,NTSTEP_BETWEEN_OUTPUT_INFO
- logical :: MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
- USE_HIGHRES_FOR_MOVIES,SUPPRESS_UTM_PROJECTION
- logical :: ATTENUATION,USE_OLSEN_ATTENUATION, &
- OCEANS
- logical :: ABSORBING_CONDITIONS,SAVE_FORWARD
- logical :: ANISOTROPY,SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION
- character(len=256) LOCAL_PATH
-
-! checks given arguments
- print *
- print *,'Recombining ParaView data for slices'
- print *
-
- do i = 1, 6
- call getarg(i,arg(i))
- if (i < 6 .and. trim(arg(i)) == '') then
- print *, 'Usage: '
- print *, ' xcombine_data start_slice end_slice filename input_dir output_dir high/low-resolution'
- print *, ' or '
- print *, ' xcombine_data slice_list filename input_dir output_dir high/low-resolution'
- print *
- print *, ' possible filenames are '
- print *, ' rho_vp, rho_vs, kappastore, mustore, alpha_kernel, etc'
- print *
- print *, ' that are stored in the local directory as real(kind=CUSTOM_REAL) filename(NGLLX,NGLLY,NGLLZ,NSPEC_AB) '
- print *, ' in filename.bin'
- print *
- print *, ' files have been collected in input_dir, output mesh file goes to output_dir '
- print *, ' give 0 for low resolution and 1 for high resolution'
- print *
- stop ' Reenter command line options'
- endif
- enddo
-
-! get slice list
- if (trim(arg(6)) == '') then
- num_node = 0
- open(unit = 20, file = trim(arg(1)), status = 'unknown',iostat = ios)
- if (ios /= 0) then
- print *,'Error opening ',trim(arg(1))
- stop
- endif
- do while ( 1 == 1)
- read(20,'(a)',iostat=ios) sline
- if (ios /= 0) exit
- read(sline,*,iostat=ios) njunk
- if (ios /= 0) exit
- num_node = num_node + 1
- node_list(num_node) = njunk
- enddo
- close(20)
- filename = arg(2)
- indir= arg(3)
- outdir = arg(4)
- read(arg(5),*) ires
- else
- read(arg(1),*) proc1
- read(arg(2),*) proc2
- do iproc = proc1, proc2
- node_list(iproc - proc1 + 1) = iproc
- enddo
- num_node = proc2 - proc1 + 1
- filename = arg(3)
- indir = arg(4)
- outdir = arg(5)
- read(arg(6),*) ires
- endif
-
- if (ires == 0) then
- HIGH_RESOLUTION_MESH = .false.
- else
- HIGH_RESOLUTION_MESH = .true.
- endif
-
- ! needs local_path for mesh files
- call read_parameter_file( NPROC,NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,DT, &
- UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION, &
- ATTENUATION,USE_OLSEN_ATTENUATION,LOCAL_PATH,NSOURCES, &
- OCEANS,ANISOTROPY,ABSORBING_CONDITIONS, &
- MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
- 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)
-
- print *, 'Slice list: '
- print *, node_list(1:num_node)
-
- ! open paraview output mesh file
- mesh_file = trim(outdir) // '/' // trim(filename)//'.mesh'
- call open_file(trim(mesh_file)//char(0))
-
- ! counts total number of points (all slices)
- npp = 0
- nee = 0
- call cvd_count_totals_ext_mesh(num_node,node_list,LOCAL_PATH,&
- npp,nee,HIGH_RESOLUTION_MESH)
-
-
- ! writes point and scalar information
- ! loops over slices (process partitions)
- np = 0
- do it = 1, num_node
-
- iproc = node_list(it)
-
- print *, ' '
- print *, 'Reading slice ', iproc
-
- ! gets number of elements and global points for this partition
- write(prname_lp,'(a,i6.6,a)') trim(LOCAL_PATH)//'/proc',iproc,'_'
- open(unit=27,file=prname_lp(1:len_trim(prname_lp))//'external_mesh.bin',&
- status='old',action='read',form='unformatted',iostat=ios)
- read(27) NSPEC_AB
- read(27) NGLOB_AB
-
- ! ibool file
- allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- read(27) ibool
-
- ! global point arrays
- allocate(xstore(NGLOB_AB),ystore(NGLOB_AB),zstore(NGLOB_AB))
- read(27) xstore
- read(27) ystore
- read(27) zstore
- close(27)
-
-
- ! data file
- write(prname,'(a,i6.6,a)') trim(indir)//'proc',iproc,'_'
- local_data_file = trim(prname) // trim(filename) // '.bin'
- open(unit = 28,file = trim(local_data_file),status='old',&
- action='read',form ='unformatted',iostat=ios)
- if (ios /= 0) then
- print *,'Error opening ',trim(local_data_file)
- stop
- endif
-
- allocate(dat(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ios)
- if( ios /= 0 ) stop 'error allocating dat array'
-
- ! uses conversion to real values
- if( CUSTOM_REAL == SIZE_DOUBLE ) then
- allocate(data(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ios)
- if( ios /= 0 ) stop 'error allocating data array'
- read(28) data
- dat = sngl(data)
- deallocate(data)
- else
- read(28) dat
- endif
- close(28)
- print *, trim(local_data_file)
-
- ! writes point coordinates and scalar value to mesh file
- if (.not. HIGH_RESOLUTION_MESH) then
- ! writes out element corners only
- call cvd_write_corners(NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore,dat, &
- it,npp,numpoin)
- else
- ! high resolution, all GLL points
- call cvd_write_GLL_points(NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore,dat,&
- it,npp,numpoin)
- endif
-
- print*,' points:',np,numpoin
-
- ! stores total number of points written
- np = np + numpoin
-
- ! cleans up memory allocations
- deallocate(ibool,dat,xstore,ystore,zstore)
-
- enddo ! all slices for points
-
- if (np /= npp) stop 'Error: Number of total points are not consistent'
- print *, 'Total number of points: ', np
- print *, ' '
-
-
-! writes element information
- ne = 0
- np = 0
- do it = 1, num_node
-
- iproc = node_list(it)
-
- print *, 'Reading slice ', iproc
- write(prname_lp,'(a,i6.6,a)') trim(LOCAL_PATH)//'/proc',iproc,'_'
-
- ! gets number of elements and global points for this partition
- open(unit=27,file=prname_lp(1:len_trim(prname_lp))//'external_mesh.bin',&
- status='old',action='read',form='unformatted')
- read(27) NSPEC_AB
- read(27) NGLOB_AB
-
- ! ibool file
- allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- read(27) ibool
- close(27)
-
- ! writes out element corner indices
- if (.not. HIGH_RESOLUTION_MESH) then
- ! spectral elements
- call cvd_write_corner_elements(NSPEC_AB,NGLOB_AB,ibool, &
- np,nelement,it,nee,numpoin)
- else
- ! subdivided spectral elements
- call cvd_write_GLL_elements(NSPEC_AB,NGLOB_AB,ibool, &
- np,nelement,it,nee,numpoin)
- endif
-
- print*,' elements:',ne,nelement
- print*,' points : ',np,numpoin
-
- ne = ne + nelement
-
- deallocate(ibool)
-
- enddo ! num_node
-
- ! checks with total number of elements
- if (ne /= nee) then
- print*,'error: number of elements counted:',ne,'total:',nee
- stop 'Number of total elements are not consistent'
- endif
- print *, 'Total number of elements: ', ne
-
- ! close mesh file
- call close_file()
-
- print *, 'Done writing '//trim(mesh_file)
-
- end program combine_paraview_data_ext_mesh
-
-
-!=============================================================
-
-
- subroutine cvd_count_totals_ext_mesh(num_node,node_list,LOCAL_PATH,&
- npp,nee,HIGH_RESOLUTION_MESH)
-
-! counts total number of points and elements for external meshes in given slice list
-! returns: total number of elements (nee) and number of points (npp)
-
- implicit none
- include 'constants.h'
-
- integer,intent(in) :: num_node,node_list(300)
- character(len=256),intent(in) :: LOCAL_PATH
- integer,intent(out) :: npp,nee
- logical,intent(in) :: HIGH_RESOLUTION_MESH
-
- ! local parameters
- integer, dimension(:,:,:,:),allocatable :: ibool
- logical, dimension(:),allocatable :: mask_ibool
- integer :: NSPEC_AB, NGLOB_AB
- integer :: it,iproc,npoint,nelement,ios,ispec
- integer :: iglob1, iglob2, iglob3, iglob4, iglob5, iglob6, iglob7, iglob8
- character(len=256) :: prname_lp
-
-
- ! loops over all slices (process partitions)
- npp = 0
- nee = 0
- do it = 1, num_node
-
- ! gets number of elements and points for this slice
- iproc = node_list(it)
- write(prname_lp,'(a,i6.6,a)') trim(LOCAL_PATH)//'/proc',iproc,'_'
- open(unit=27,file=prname_lp(1:len_trim(prname_lp))//'external_mesh.bin',&
- status='old',action='read',form='unformatted',iostat=ios)
- if (ios /= 0) then
- print *,'Error opening: ',prname_lp(1:len_trim(prname_lp))//'external_mesh.bin'
- stop
- endif
-
- read(27) NSPEC_AB
- read(27) NGLOB_AB
- ! gets ibool
- if( .not. HIGH_RESOLUTION_MESH ) then
- allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- read(27) ibool
- endif
- close(27)
-
- ! calculates totals
- if( HIGH_RESOLUTION_MESH ) then
- ! total number of global points
- npp = npp + NGLOB_AB
-
- ! total number of elements
- ! each spectral elements gets subdivided by GLL points,
- ! which form (NGLLX-1)*(NGLLY-1)*(NGLLZ-1) sub-elements
- nelement = NSPEC_AB * (NGLLX-1) * (NGLLY-1) * (NGLLZ-1)
- nee = nee + nelement
-
- else
-
- ! mark element corners (global AVS or DX points)
- allocate(mask_ibool(NGLOB_AB))
- mask_ibool = .false.
- do ispec=1,NSPEC_AB
- iglob1=ibool(1,1,1,ispec)
- iglob2=ibool(NGLLX,1,1,ispec)
- iglob3=ibool(NGLLX,NGLLY,1,ispec)
- iglob4=ibool(1,NGLLY,1,ispec)
- iglob5=ibool(1,1,NGLLZ,ispec)
- iglob6=ibool(NGLLX,1,NGLLZ,ispec)
- iglob7=ibool(NGLLX,NGLLY,NGLLZ,ispec)
- iglob8=ibool(1,NGLLY,NGLLZ,ispec)
- mask_ibool(iglob1) = .true.
- mask_ibool(iglob2) = .true.
- mask_ibool(iglob3) = .true.
- mask_ibool(iglob4) = .true.
- mask_ibool(iglob5) = .true.
- mask_ibool(iglob6) = .true.
- mask_ibool(iglob7) = .true.
- mask_ibool(iglob8) = .true.
- enddo
-
- ! count global number of AVS or DX points
- npoint = count(mask_ibool(:))
- npp = npp + npoint
-
- ! total number of spectral elements
- nee = nee + NSPEC_AB
-
- endif ! HIGH_RESOLUTION_MESH
-
- ! frees arrays
- if( allocated(mask_ibool) ) deallocate( mask_ibool)
- if( allocated(ibool) ) deallocate(ibool)
-
- enddo
-
- end subroutine cvd_count_totals_ext_mesh
-
-!=============================================================
-
-
- subroutine cvd_write_corners(NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore,dat,&
- it,npp,numpoin)
-
-! writes out locations of spectral element corners only
-
- implicit none
- include 'constants.h'
-
- integer,intent(in) :: NSPEC_AB,NGLOB_AB
- integer,dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB),intent(in) :: ibool
- real(kind=CUSTOM_REAL),dimension(NGLOB_AB) :: xstore, ystore, zstore
- real,dimension(NGLLY,NGLLY,NGLLZ,NSPEC_AB),intent(in) :: dat
- integer:: it
- integer :: npp,numpoin
-
- ! local parameters
- logical,dimension(:),allocatable :: mask_ibool
- real :: x, y, z
- integer :: ispec
- integer :: iglob1, iglob2, iglob3, iglob4, iglob5, iglob6, iglob7, iglob8
-
- ! writes out total number of points
- if (it == 1) then
- call write_integer(npp)
- endif
-
- ! writes our corner point locations
- allocate(mask_ibool(NGLOB_AB))
- mask_ibool(:) = .false.
- numpoin = 0
- do ispec=1,NSPEC_AB
- iglob1=ibool(1,1,1,ispec)
- iglob2=ibool(NGLLX,1,1,ispec)
- iglob3=ibool(NGLLX,NGLLY,1,ispec)
- iglob4=ibool(1,NGLLY,1,ispec)
- iglob5=ibool(1,1,NGLLZ,ispec)
- iglob6=ibool(NGLLX,1,NGLLZ,ispec)
- iglob7=ibool(NGLLX,NGLLY,NGLLZ,ispec)
- iglob8=ibool(1,NGLLY,NGLLZ,ispec)
-
- if(.not. mask_ibool(iglob1)) then
- numpoin = numpoin + 1
- x = xstore(iglob1)
- y = ystore(iglob1)
- z = zstore(iglob1)
- call write_real(x)
- call write_real(y)
- call write_real(z)
- call write_real(dat(1,1,1,ispec))
- mask_ibool(iglob1) = .true.
- endif
- if(.not. mask_ibool(iglob2)) then
- numpoin = numpoin + 1
- x = xstore(iglob2)
- y = ystore(iglob2)
- z = zstore(iglob2)
- call write_real(x)
- call write_real(y)
- call write_real(z)
- call write_real(dat(NGLLX,1,1,ispec))
- mask_ibool(iglob2) = .true.
- endif
- if(.not. mask_ibool(iglob3)) then
- numpoin = numpoin + 1
- x = xstore(iglob3)
- y = ystore(iglob3)
- z = zstore(iglob3)
- call write_real(x)
- call write_real(y)
- call write_real(z)
- call write_real(dat(NGLLX,NGLLY,1,ispec))
- mask_ibool(iglob3) = .true.
- endif
- if(.not. mask_ibool(iglob4)) then
- numpoin = numpoin + 1
- x = xstore(iglob4)
- y = ystore(iglob4)
- z = zstore(iglob4)
- call write_real(x)
- call write_real(y)
- call write_real(z)
- call write_real(dat(1,NGLLY,1,ispec))
- mask_ibool(iglob4) = .true.
- endif
- if(.not. mask_ibool(iglob5)) then
- numpoin = numpoin + 1
- x = xstore(iglob5)
- y = ystore(iglob5)
- z = zstore(iglob5)
- call write_real(x)
- call write_real(y)
- call write_real(z)
- call write_real(dat(1,1,NGLLZ,ispec))
- mask_ibool(iglob5) = .true.
- endif
- if(.not. mask_ibool(iglob6)) then
- numpoin = numpoin + 1
- x = xstore(iglob6)
- y = ystore(iglob6)
- z = zstore(iglob6)
- call write_real(x)
- call write_real(y)
- call write_real(z)
- call write_real(dat(NGLLX,1,NGLLZ,ispec))
- mask_ibool(iglob6) = .true.
- endif
- if(.not. mask_ibool(iglob7)) then
- numpoin = numpoin + 1
- x = xstore(iglob7)
- y = ystore(iglob7)
- z = zstore(iglob7)
- call write_real(x)
- call write_real(y)
- call write_real(z)
- call write_real(dat(NGLLX,NGLLY,NGLLZ,ispec))
- mask_ibool(iglob7) = .true.
- endif
- if(.not. mask_ibool(iglob8)) then
- numpoin = numpoin + 1
- x = xstore(iglob8)
- y = ystore(iglob8)
- z = zstore(iglob8)
- call write_real(x)
- call write_real(y)
- call write_real(z)
- call write_real(dat(1,NGLLY,NGLLZ,ispec))
- mask_ibool(iglob8) = .true.
- endif
- enddo ! ispec
-
- end subroutine cvd_write_corners
-
-
-!=============================================================
-
-
- subroutine cvd_write_GLL_points(NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore,dat,&
- it,npp,numpoin)
-
-! writes out locations of all GLL points of spectral elements
-
- implicit none
- include 'constants.h'
-
- integer,intent(in) :: NSPEC_AB,NGLOB_AB
- integer,dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB),intent(in) :: ibool
- real(kind=CUSTOM_REAL),dimension(NGLOB_AB) :: xstore, ystore, zstore
- real,dimension(NGLLY,NGLLY,NGLLZ,NSPEC_AB),intent(in) :: dat
- integer:: it,npp,numpoin
-
- ! local parameters
- logical,dimension(:),allocatable :: mask_ibool
- real :: x, y, z
- integer :: ispec,i,j,k,iglob
-
- ! writes out total number of points
- if (it == 1) then
- call write_integer(npp)
- endif
-
- ! writes out point locations and values
- allocate(mask_ibool(NGLOB_AB))
- mask_ibool(:) = .false.
- numpoin = 0
- do ispec=1,NSPEC_AB
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
- iglob = ibool(i,j,k,ispec)
- if(.not. mask_ibool(iglob)) then
- numpoin = numpoin + 1
- x = xstore(iglob)
- y = ystore(iglob)
- z = zstore(iglob)
- call write_real(x)
- call write_real(y)
- call write_real(z)
- call write_real(dat(i,j,k,ispec))
- mask_ibool(iglob) = .true.
- endif
- enddo ! i
- enddo ! j
- enddo ! k
- enddo !ispec
-
- end subroutine cvd_write_GLL_points
-
-!=============================================================
-
-! writes out locations of spectral element corners only
-
- subroutine cvd_write_corner_elements(NSPEC_AB,NGLOB_AB,ibool,&
- np,nelement,it,nee,numpoin)
-
- implicit none
- include 'constants.h'
-
- integer,intent(in) :: NSPEC_AB,NGLOB_AB
- integer,dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB),intent(in) :: ibool
- integer:: it,nee,np,nelement,numpoin
-
- ! local parameters
- logical,dimension(:),allocatable :: mask_ibool
- integer,dimension(:),allocatable :: num_ibool
- integer :: ispec
- integer :: iglob1, iglob2, iglob3, iglob4, iglob5, iglob6, iglob7, iglob8
- integer :: n1, n2, n3, n4, n5, n6, n7, n8
-
- ! outputs total number of elements for all slices
- if (it == 1) then
- call write_integer(nee)
- end if
-
- ! writes out element indices
- allocate(mask_ibool(NGLOB_AB))
- allocate(num_ibool(NGLOB_AB))
- mask_ibool(:) = .false.
- num_ibool(:) = 0
- numpoin = 0
- do ispec=1,NSPEC_AB
- ! gets corner indices
- iglob1=ibool(1,1,1,ispec)
- iglob2=ibool(NGLLX,1,1,ispec)
- iglob3=ibool(NGLLX,NGLLY,1,ispec)
- iglob4=ibool(1,NGLLY,1,ispec)
- iglob5=ibool(1,1,NGLLZ,ispec)
- iglob6=ibool(NGLLX,1,NGLLZ,ispec)
- iglob7=ibool(NGLLX,NGLLY,NGLLZ,ispec)
- iglob8=ibool(1,NGLLY,NGLLZ,ispec)
-
- ! sets increasing numbering
- if(.not. mask_ibool(iglob1)) then
- numpoin = numpoin + 1
- num_ibool(iglob1) = numpoin
- mask_ibool(iglob1) = .true.
- endif
- if(.not. mask_ibool(iglob2)) then
- numpoin = numpoin + 1
- num_ibool(iglob2) = numpoin
- mask_ibool(iglob2) = .true.
- endif
- if(.not. mask_ibool(iglob3)) then
- numpoin = numpoin + 1
- num_ibool(iglob3) = numpoin
- mask_ibool(iglob3) = .true.
- endif
- if(.not. mask_ibool(iglob4)) then
- numpoin = numpoin + 1
- num_ibool(iglob4) = numpoin
- mask_ibool(iglob4) = .true.
- endif
- if(.not. mask_ibool(iglob5)) then
- numpoin = numpoin + 1
- num_ibool(iglob5) = numpoin
- mask_ibool(iglob5) = .true.
- endif
- if(.not. mask_ibool(iglob6)) then
- numpoin = numpoin + 1
- num_ibool(iglob6) = numpoin
- mask_ibool(iglob6) = .true.
- endif
- if(.not. mask_ibool(iglob7)) then
- numpoin = numpoin + 1
- num_ibool(iglob7) = numpoin
- mask_ibool(iglob7) = .true.
- endif
- if(.not. mask_ibool(iglob8)) then
- numpoin = numpoin + 1
- num_ibool(iglob8) = numpoin
- mask_ibool(iglob8) = .true.
- endif
-
- ! outputs corner indices (starting with 0 )
- n1 = num_ibool(iglob1) -1 + np
- n2 = num_ibool(iglob2) -1 + np
- n3 = num_ibool(iglob3) -1 + np
- n4 = num_ibool(iglob4) -1 + np
- n5 = num_ibool(iglob5) -1 + np
- n6 = num_ibool(iglob6) -1 + np
- n7 = num_ibool(iglob7) -1 + np
- n8 = num_ibool(iglob8) -1 + np
-
- call write_integer(n1)
- call write_integer(n2)
- call write_integer(n3)
- call write_integer(n4)
- call write_integer(n5)
- call write_integer(n6)
- call write_integer(n7)
- call write_integer(n8)
-
- enddo
-
- ! elements written
- nelement = NSPEC_AB
-
- ! updates points written
- np = np + numpoin
-
- end subroutine cvd_write_corner_elements
-
-
-!=============================================================
-
-
- subroutine cvd_write_GLL_elements(NSPEC_AB,NGLOB_AB,ibool, &
- np,nelement,it,nee,numpoin)
-
-! writes out indices of elements given by GLL points
-
- implicit none
- include 'constants.h'
-
- integer,intent(in):: NSPEC_AB,NGLOB_AB
- integer,dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB),intent(in) :: ibool
- integer:: it,nee,np,numpoin,nelement
-
- ! local parameters
- logical,dimension(:),allocatable :: mask_ibool
- integer,dimension(:),allocatable :: num_ibool
- integer :: ispec,i,j,k
- integer :: iglob,iglob1, iglob2, iglob3, iglob4, iglob5, iglob6, iglob7, iglob8
- integer :: n1, n2, n3, n4, n5, n6, n7, n8
-
- ! outputs total number of elements for all slices
- if (it == 1) then
- !nee = nelement * num_node
- call write_integer(nee)
- endif
-
- ! sets numbering num_ibool respecting mask
- allocate(mask_ibool(NGLOB_AB))
- allocate(num_ibool(NGLOB_AB))
- mask_ibool(:) = .false.
- num_ibool(:) = 0
- numpoin = 0
- do ispec=1,NSPEC_AB
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
- iglob = ibool(i,j,k,ispec)
- if(.not. mask_ibool(iglob)) then
- numpoin = numpoin + 1
- num_ibool(iglob) = numpoin
- mask_ibool(iglob) = .true.
- endif
- enddo ! i
- enddo ! j
- enddo ! k
- enddo !ispec
-
- ! outputs GLL subelement
- do ispec = 1, NSPEC_AB
- do k = 1, NGLLZ-1
- do j = 1, NGLLY-1
- do i = 1, NGLLX-1
- iglob1 = ibool(i,j,k,ispec)
- iglob2 = ibool(i+1,j,k,ispec)
- iglob3 = ibool(i+1,j+1,k,ispec)
- iglob4 = ibool(i,j+1,k,ispec)
- iglob5 = ibool(i,j,k+1,ispec)
- iglob6 = ibool(i+1,j,k+1,ispec)
- iglob7 = ibool(i+1,j+1,k+1,ispec)
- iglob8 = ibool(i,j+1,k+1,ispec)
- n1 = num_ibool(iglob1)+np-1
- n2 = num_ibool(iglob2)+np-1
- n3 = num_ibool(iglob3)+np-1
- n4 = num_ibool(iglob4)+np-1
- n5 = num_ibool(iglob5)+np-1
- n6 = num_ibool(iglob6)+np-1
- n7 = num_ibool(iglob7)+np-1
- n8 = num_ibool(iglob8)+np-1
- call write_integer(n1)
- call write_integer(n2)
- call write_integer(n3)
- call write_integer(n4)
- call write_integer(n5)
- call write_integer(n6)
- call write_integer(n7)
- call write_integer(n8)
- enddo
- enddo
- enddo
- enddo
- ! elements written
- nelement = NSPEC_AB * (NGLLX-1) * (NGLLY-1) * (NGLLZ-1)
-
- ! updates points written
- np = np + numpoin
-
- end subroutine cvd_write_GLL_elements
-
Deleted: seismo/3D/SPECFEM3D/trunk/comp_source_time_function.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/comp_source_time_function.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/comp_source_time_function.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,89 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- double precision function comp_source_time_function(t,hdur)
-
- implicit none
-
- include "constants.h"
-
- double precision t,hdur
-
- double precision, external :: netlib_specfun_erf
-
- ! quasi Heaviside, small Gaussian moment-rate tensor with hdur
- comp_source_time_function = 0.5d0*(1.0d0 + netlib_specfun_erf(t/hdur))
-
- end function comp_source_time_function
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- double precision function comp_source_time_function_gauss(t,hdur)
-
- implicit none
-
- include "constants.h"
-
- double precision :: t,hdur
- double precision :: hdur_decay
- double precision,parameter :: SOURCE_DECAY_STRONG = 2.0d0/SOURCE_DECAY_MIMIC_TRIANGLE
-
- ! note: hdur given is hdur_gaussian = hdur/SOURCE_DECAY_MIMIC_TRIANGLE
- ! and SOURCE_DECAY_MIMIC_TRIANGLE ~ 1.68
- hdur_decay = hdur
-
- ! this here uses a stronger gaussian decay rate (empirical value) to avoid non-zero onset times;
- ! however, it should mimik a triangle source time function...
- !hdur_decay = hdur / SOURCE_DECAY_STRONG
-
- ! note: a nonzero time to start the simulation with would lead to more high-frequency noise
- ! due to the (spatial) discretization of the point source on the mesh
-
- ! gaussian
- comp_source_time_function_gauss = exp(-(t/hdur_decay)**2)/(sqrt(PI)*hdur_decay)
-
- end function comp_source_time_function_gauss
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- double precision function comp_source_time_function_rickr(t,f0)
-
- implicit none
-
- include "constants.h"
-
- double precision t,f0
-
- ! ricker
- comp_source_time_function_rickr = (1.d0 - 2.d0*PI*PI*f0*f0*t*t ) &
- * exp( -PI*PI*f0*f0*t*t )
-
- end function comp_source_time_function_rickr
-
\ No newline at end of file
Deleted: seismo/3D/SPECFEM3D/trunk/compute_add_sources_acoustic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_add_sources_acoustic.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_add_sources_acoustic.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,388 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-! for acoustic solver
-
- subroutine compute_add_sources_acoustic(NSPEC_AB,NGLOB_AB,potential_dot_dot_acoustic, &
- ibool,ispec_is_inner,phase_is_inner, &
- NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
- xi_source,eta_source,gamma_source, &
- hdur,hdur_gaussian,t_cmt,dt,t0, &
- sourcearrays,kappastore,ispec_is_acoustic,&
- SIMULATION_TYPE,NSTEP,NGLOB_ADJOINT, &
- nrec,islice_selected_rec,ispec_selected_rec, &
- nadj_rec_local,adj_sourcearrays,b_potential_dot_dot_acoustic, &
- NTSTEP_BETWEEN_READ_ADJSRC )
-
- use specfem_par,only: PRINT_SOURCE_TIME_FUNCTION,stf_used_total, &
- xigll,yigll,zigll,xi_receiver,eta_receiver,gamma_receiver,&
- station_name,network_name,adj_source_file
- implicit none
-
- include "constants.h"
-
- integer :: NSPEC_AB,NGLOB_AB
-
-! displacement and acceleration
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_dot_acoustic
-
-! arrays with mesh parameters per slice
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: kappastore
-
-! communication overlap
- logical, dimension(NSPEC_AB) :: ispec_is_inner
- logical :: phase_is_inner
-
-! source
- integer :: NSOURCES,myrank,it
- integer, dimension(NSOURCES) :: islice_selected_source,ispec_selected_source
- double precision, dimension(NSOURCES) :: xi_source,eta_source,gamma_source
- double precision, dimension(NSOURCES) :: hdur,hdur_gaussian,t_cmt
- double precision :: dt,t0
- real(kind=CUSTOM_REAL), dimension(NSOURCES,NDIM,NGLLX,NGLLY,NGLLZ) :: sourcearrays
-
- double precision, external :: comp_source_time_function,comp_source_time_function_rickr,&
- comp_source_time_function_gauss
-
- logical, dimension(NSPEC_AB) :: ispec_is_acoustic
-
-!adjoint simulations
- integer:: SIMULATION_TYPE,NSTEP,NGLOB_ADJOINT
- integer:: nrec
- integer,dimension(nrec) :: islice_selected_rec,ispec_selected_rec
- integer:: nadj_rec_local
- real(kind=CUSTOM_REAL),dimension(NGLOB_ADJOINT):: b_potential_dot_dot_acoustic
-!<YANGL
- logical :: ibool_read_adj_arrays
- integer :: it_sub_adj,itime,NTSTEP_BETWEEN_READ_ADJSRC
-! real(kind=CUSTOM_REAL),dimension(nadj_rec_local,NSTEP,NDIM,NGLLX,NGLLY,NGLLZ):: adj_sourcearrays
- real(kind=CUSTOM_REAL),dimension(nadj_rec_local,NTSTEP_BETWEEN_READ_ADJSRC,NDIM,NGLLX,NGLLY,NGLLZ):: adj_sourcearrays
- real(kind=CUSTOM_REAL),dimension(NTSTEP_BETWEEN_READ_ADJSRC,NDIM,NGLLX,NGLLY,NGLLZ):: adj_sourcearray
-!>YANGL
-
-! local parameters
- double precision :: f0
- double precision :: stf
- real(kind=CUSTOM_REAL) stf_used,stf_used_total_all,time_source
- integer :: isource,iglob,ispec,i,j,k
- integer :: irec_local,irec
-
-! plotting source time function
- if(PRINT_SOURCE_TIME_FUNCTION .and. .not. phase_is_inner ) then
- ! initializes total
- stf_used_total = 0.0_CUSTOM_REAL
- endif
-
-! forward simulations
- if (SIMULATION_TYPE == 1) then
-
- ! adds acoustic sources
- do isource = 1,NSOURCES
-
- ! add the source (only if this proc carries the source)
- if(myrank == islice_selected_source(isource)) then
-
- ispec = ispec_selected_source(isource)
-
- if (ispec_is_inner(ispec) .eqv. phase_is_inner) then
-
- if( ispec_is_acoustic(ispec) ) then
-
- if(USE_FORCE_POINT_SOURCE) then
-
- ! note: for use_force_point_source xi/eta/gamma are in the range [1,NGLL*]
- iglob = ibool(nint(xi_source(isource)), &
- nint(eta_source(isource)), &
- nint(gamma_source(isource)), &
- ispec)
-
- f0 = hdur(isource) !! using hdur as a FREQUENCY just to avoid changing CMTSOLUTION file format
- t0 = 1.2d0/f0
-
- !if (it == 1 .and. myrank == 0) then
- ! write(IMAIN,*) 'using a source of dominant frequency ',f0
- ! write(IMAIN,*) 'lambda_S at dominant frequency = ',3000./sqrt(3.)/f0
- ! write(IMAIN,*) 'lambda_S at highest significant frequency = ',3000./sqrt(3.)/(2.5*f0)
- !endif
-
- ! gaussian source time function
- !stf_used = comp_source_time_function(dble(it-1)*DT-t0-t_cmt(isource),hdur_gaussian(isource))
-
- ! we use nu_source(:,3) here because we want a source normal to the surface.
- ! This is the expression of a Ricker; should be changed according maybe to the Par_file.
- stf_used = FACTOR_FORCE_SOURCE * comp_source_time_function_rickr(dble(it-1)*DT-t0-t_cmt(isource),f0)
-
- ! beware, for acoustic medium, source is: pressure divided by Kappa of the fluid
- ! the sign is negative because pressure p = - Chi_dot_dot therefore we need
- ! to add minus the source to Chi_dot_dot to get plus the source in pressure:
-
- ! acoustic source for pressure gets divided by kappa
- ! source contribution
- potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) &
- - stf_used / kappastore(nint(xi_source(isource)), &
- nint(eta_source(isource)), &
- nint(gamma_source(isource)),ispec)
-
- else
-
- ! gaussian source time
- stf = comp_source_time_function_gauss(dble(it-1)*DT-t0-t_cmt(isource),hdur_gaussian(isource))
-
- ! quasi-heaviside
- !stf = comp_source_time_function(dble(it-1)*DT-t0-t_cmt(isource),hdur_gaussian(isource))
-
- ! distinguishes between single and double precision for reals
- if(CUSTOM_REAL == SIZE_REAL) then
- stf_used = sngl(stf)
- else
- stf_used = stf
- endif
-
- ! beware, for acoustic medium, source is: pressure divided by Kappa of the fluid
- ! the sign is negative because pressure p = - Chi_dot_dot therefore we need
- ! to add minus the source to Chi_dot_dot to get plus the source in pressure
-
- ! add source array
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- ! adds source contribution
- ! note: acoustic source for pressure gets divided by kappa
- iglob = ibool(i,j,k,ispec)
- potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) &
- - sourcearrays(isource,1,i,j,k) * stf_used / kappastore(i,j,k,ispec)
- enddo
- enddo
- enddo
-
- endif ! USE_FORCE_POINT_SOURCE
-
- stf_used_total = stf_used_total + stf_used
-
- endif ! ispec_is_elastic
- endif ! ispec_is_inner
- endif ! myrank
-
- enddo ! NSOURCES
- endif
-
-! NOTE: adjoint sources and backward wavefield timing:
-! idea is to start with the backward field b_potential,.. at time (T)
-! and convolve with the adjoint field at time (T-t)
-!
-! backward/reconstructed wavefields:
-! time for b_potential( it ) would correspond to (NSTEP - it - 1 )*DT - t0
-! if we read in saved wavefields b_potential() before Newark time scheme
-! (see sources for simulation_type 1 and seismograms)
-! since at the beginning of the time loop, the numerical Newark time scheme updates
-! the wavefields, that is b_potential( it=1) would correspond to time (NSTEP -1 - 1)*DT - t0
-!
-! b_potential is now read in after Newark time scheme:
-! we read the backward/reconstructed wavefield at the end of the first time loop,
-! such that b_potential(it=1) corresponds to -t0 + (NSTEP-1)*DT.
-! assuming that until that end the backward/reconstructed wavefield and adjoint fields
-! have a zero contribution to adjoint kernels.
-! thus the correct indexing is NSTEP - it + 1, instead of NSTEP - it
-!
-! adjoint wavefields:
-! since the adjoint source traces were derived from the seismograms,
-! it follows that for the adjoint wavefield, the time equivalent to ( T - t ) uses the time-reversed
-! adjoint source traces which start at -t0 and end at time (NSTEP-1)*DT - t0
-! for step it=1: (NSTEP -it + 1)*DT - t0 for backward wavefields corresponds to time T
-
-! adjoint simulations
- if (SIMULATION_TYPE == 2 .or. SIMULATION_TYPE == 3) then
-
-!<YANGL
-! read in adjoint sources block by block (for memory consideration)
-! e.g., in exploration experiments, both the number of receivers (nrec) and the number of time steps (NSTEP) are huge,
-! which may cause problems since we have a large array: adj_sourcearrays(nadj_rec_local,NSTEP,NDIM,NGLLX,NGLLY,NGLLZ)
-
- ! figure out if we need to read in a chunk of the adjoint source at this timestep
- it_sub_adj = ceiling( dble(it)/dble(NTSTEP_BETWEEN_READ_ADJSRC) ) !chunk_number
- ibool_read_adj_arrays = (((mod(it-1,NTSTEP_BETWEEN_READ_ADJSRC) == 0)) .and. (nadj_rec_local > 0))
-
- ! needs to read in a new chunk/block of the adjoint source
- if(ibool_read_adj_arrays) then
-
- irec_local = 0
- do irec = 1, nrec
- ! compute source arrays
- if(myrank == islice_selected_rec(irec)) then
- irec_local = irec_local + 1
-
- ! reads in **sta**.**net**.**LH**.adj files
- adj_source_file = trim(station_name(irec))//'.'//trim(network_name(irec))
- call compute_arrays_adjoint_source(myrank,adj_source_file, &
- xi_receiver(irec),eta_receiver(irec),gamma_receiver(irec), &
- adj_sourcearray, xigll,yigll,zigll, &
- it_sub_adj,NSTEP,NTSTEP_BETWEEN_READ_ADJSRC)
- do itime = 1,NTSTEP_BETWEEN_READ_ADJSRC
- adj_sourcearrays(irec_local,itime,:,:,:,:) = adj_sourcearray(itime,:,:,:,:)
- enddo
-
- endif
- enddo
-
- endif ! if(ibool_read_adj_arrays)
-!>YANGL
-
- if( it < NSTEP ) then
- ! receivers act as sources
- irec_local = 0
- do irec = 1,nrec
- ! add the source (only if this proc carries the source)
- if(myrank == islice_selected_rec(irec)) then
- irec_local = irec_local + 1
- ! adds source array
- ispec = ispec_selected_rec(irec)
- do k = 1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
-
- ! beware, for acoustic medium, source is: pressure divided by Kappa of the fluid
- ! note: it takes the first component of the adj_sourcearrays
- ! the idea is to have e.g. a pressure source, where all 3 components would be the same
-!<YANGL
-! potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) &
-! - adj_sourcearrays(irec_local,NSTEP-it+1,1,i,j,k) / kappastore(i,j,k,ispec)
- potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) &
- - adj_sourcearrays(irec_local,NTSTEP_BETWEEN_READ_ADJSRC &
- -mod(it-1,NTSTEP_BETWEEN_READ_ADJSRC),1,i,j,k) &
- / kappastore(i,j,k,ispec)
-!>YANGL
- enddo
- enddo
- enddo
- endif
- enddo ! nrec
- endif ! it
- endif
-
-! note: b_potential() is read in after Newark time scheme, thus
-! b_potential(it=1) corresponds to -t0 + (NSTEP-1)*DT.
-! thus indexing is NSTEP - it , instead of NSTEP - it - 1
-
-! adjoint simulations
- if (SIMULATION_TYPE == 3) then
- ! adds acoustic sources
- do isource = 1,NSOURCES
-
- ! add the source (only if this proc carries the source)
- if(myrank == islice_selected_source(isource)) then
-
- ispec = ispec_selected_source(isource)
-
- if (ispec_is_inner(ispec) .eqv. phase_is_inner) then
-
- if( ispec_is_acoustic(ispec) ) then
-
- if(USE_FORCE_POINT_SOURCE) then
-
- ! note: for use_force_point_source xi/eta/gamma are in the range [1,NGLL*]
- iglob = ibool(nint(xi_source(isource)), &
- nint(eta_source(isource)), &
- nint(gamma_source(isource)), &
- ispec)
-
- f0 = hdur(isource) !! using hdur as a FREQUENCY just to avoid changing CMTSOLUTION file format
- t0 = 1.2d0/f0
-
- !if (it == 1 .and. myrank == 0) then
- ! write(IMAIN,*) 'using a source of dominant frequency ',f0
- ! write(IMAIN,*) 'lambda_S at dominant frequency = ',3000./sqrt(3.)/f0
- ! write(IMAIN,*) 'lambda_S at highest significant frequency = ',3000./sqrt(3.)/(2.5*f0)
- !endif
-
- ! gaussian source time function
- !stf_used = comp_source_time_function(dble(it-1)*DT-t0-t_cmt(isource),hdur_gaussian(isource))
-
- ! we use nu_source(:,3) here because we want a source normal to the surface.
- ! This is the expression of a Ricker; should be changed according maybe to the Par_file.
- stf_used = FACTOR_FORCE_SOURCE * comp_source_time_function_rickr(dble(NSTEP-it)*DT-t0-t_cmt(isource),f0)
-
- ! beware, for acoustic medium, source is: pressure divided by Kappa of the fluid
- ! the sign is negative because pressure p = - Chi_dot_dot therefore we need
- ! to add minus the source to Chi_dot_dot to get plus the source in pressure:
-
- ! acoustic source for pressure gets divided by kappa
- ! source contribution
- b_potential_dot_dot_acoustic(iglob) = b_potential_dot_dot_acoustic(iglob) &
- - stf_used / kappastore(nint(xi_source(isource)), &
- nint(eta_source(isource)), &
- nint(gamma_source(isource)),ispec)
-
- else
-
- ! gaussian source time
- stf = comp_source_time_function_gauss(dble(NSTEP-it)*DT-t0-t_cmt(isource),hdur_gaussian(isource))
-
- ! distinguishes between single and double precision for reals
- if(CUSTOM_REAL == SIZE_REAL) then
- stf_used = sngl(stf)
- else
- stf_used = stf
- endif
-
- ! beware, for acoustic medium, source is: pressure divided by Kappa of the fluid
- ! the sign is negative because pressure p = - Chi_dot_dot therefore we need
- ! to add minus the source to Chi_dot_dot to get plus the source in pressure
-
- ! add source array
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- ! adds source contribution
- ! note: acoustic source for pressure gets divided by kappa
- iglob = ibool(i,j,k,ispec)
- b_potential_dot_dot_acoustic(iglob) = b_potential_dot_dot_acoustic(iglob) &
- - sourcearrays(isource,1,i,j,k) * stf_used / kappastore(i,j,k,ispec)
- enddo
- enddo
- enddo
-
- endif ! USE_FORCE_POINT_SOURCE
-
- stf_used_total = stf_used_total + stf_used
-
- endif ! ispec_is_elastic
- endif ! ispec_is_inner
- endif ! myrank
-
- enddo ! NSOURCES
- endif
-
- ! master prints out source time function to file
- if(PRINT_SOURCE_TIME_FUNCTION .and. phase_is_inner) then
- time_source = (it-1)*DT - t0
- call sum_all_cr(stf_used_total,stf_used_total_all)
- if( myrank == 0 ) write(IOSTF,*) time_source,stf_used_total_all
- endif
-
-
-end subroutine compute_add_sources_acoustic
Deleted: seismo/3D/SPECFEM3D/trunk/compute_add_sources_elastic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_add_sources_elastic.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_add_sources_elastic.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,344 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-! for elastic solver
-
- subroutine compute_add_sources_elastic( NSPEC_AB,NGLOB_AB,accel, &
- ibool,ispec_is_inner,phase_is_inner, &
- NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
- xi_source,eta_source,gamma_source,nu_source, &
- hdur,hdur_gaussian,t_cmt,dt,t0,sourcearrays, &
- ispec_is_elastic,SIMULATION_TYPE,NSTEP,NGLOB_ADJOINT, &
- nrec,islice_selected_rec,ispec_selected_rec, &
- nadj_rec_local,adj_sourcearrays,b_accel, &
- NTSTEP_BETWEEN_READ_ADJSRC )
-
- use specfem_par,only: PRINT_SOURCE_TIME_FUNCTION,stf_used_total, &
- xigll,yigll,zigll,xi_receiver,eta_receiver,gamma_receiver,&
- station_name,network_name,adj_source_file
- implicit none
-
- include "constants.h"
-
- integer :: NSPEC_AB,NGLOB_AB
-
-! displacement and acceleration
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: accel
-
-! arrays with mesh parameters per slice
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
-! communication overlap
- logical, dimension(NSPEC_AB) :: ispec_is_inner
- logical :: phase_is_inner
-
-! source
- integer :: NSOURCES,myrank,it
- integer, dimension(NSOURCES) :: islice_selected_source,ispec_selected_source
- double precision, dimension(NSOURCES) :: xi_source,eta_source,gamma_source
- double precision, dimension(3,3,NSOURCES) :: nu_source
- double precision, dimension(NSOURCES) :: hdur,hdur_gaussian,t_cmt
- double precision :: dt,t0
- real(kind=CUSTOM_REAL), dimension(NSOURCES,NDIM,NGLLX,NGLLY,NGLLZ) :: sourcearrays
-
- double precision, external :: comp_source_time_function,comp_source_time_function_rickr
-
- logical, dimension(NSPEC_AB) :: ispec_is_elastic
-
-!adjoint simulations
- integer:: SIMULATION_TYPE,NSTEP,NGLOB_ADJOINT
- integer:: nrec
- integer,dimension(nrec) :: islice_selected_rec,ispec_selected_rec
- integer:: nadj_rec_local
- real(kind=CUSTOM_REAL),dimension(NDIM,NGLOB_ADJOINT):: b_accel
-!<YANGL
-! real(kind=CUSTOM_REAL),dimension(nadj_rec_local,NSTEP,NDIM,NGLLX,NGLLY,NGLLZ):: adj_sourcearrays
- logical :: ibool_read_adj_arrays
- integer :: it_sub_adj,itime,NTSTEP_BETWEEN_READ_ADJSRC
- real(kind=CUSTOM_REAL),dimension(nadj_rec_local,NTSTEP_BETWEEN_READ_ADJSRC,NDIM,NGLLX,NGLLY,NGLLZ):: adj_sourcearrays
- real(kind=CUSTOM_REAL),dimension(NTSTEP_BETWEEN_READ_ADJSRC,NDIM,NGLLX,NGLLY,NGLLZ):: adj_sourcearray
-!>YANGL
-
-! local parameters
- double precision :: f0
- double precision :: stf
- real(kind=CUSTOM_REAL) stf_used,stf_used_total_all,time_source
- integer :: isource,iglob,i,j,k,ispec
- integer :: irec_local,irec
-
-! plotting source time function
- if(PRINT_SOURCE_TIME_FUNCTION .and. .not. phase_is_inner ) then
- ! initializes total
- stf_used_total = 0.0_CUSTOM_REAL
- endif
-
-! forward simulations
- if (SIMULATION_TYPE == 1) then
-
- do isource = 1,NSOURCES
-
- ! add the source (only if this proc carries the source)
- if(myrank == islice_selected_source(isource)) then
-
- ispec = ispec_selected_source(isource)
-
- if (ispec_is_inner(ispec) .eqv. phase_is_inner) then
-
- if( ispec_is_elastic(ispec) ) then
-
- if(USE_FORCE_POINT_SOURCE) then
-
- ! note: for use_force_point_source xi/eta/gamma are in the range [1,NGLL*]
- iglob = ibool(nint(xi_source(isource)), &
- nint(eta_source(isource)), &
- nint(gamma_source(isource)), &
- ispec_selected_source(isource))
-
- f0 = hdur(isource) !! using hdur as a FREQUENCY just to avoid changing CMTSOLUTION file format
- ! note: for a Ricker source time function, a start time ~1.2 * main_period is a good choice
- t0 = 1.2d0/f0
-
- !if (it == 1 .and. myrank == 0) then
- ! write(IMAIN,*) 'using a source of dominant frequency ',f0
- ! write(IMAIN,*) 'lambda_S at dominant frequency = ',3000./sqrt(3.)/f0
- ! write(IMAIN,*) 'lambda_S at highest significant frequency = ',3000./sqrt(3.)/(2.5*f0)
- !endif
-
- ! This is the expression of a Ricker; should be changed according maybe to the Par_file.
- stf_used = FACTOR_FORCE_SOURCE * comp_source_time_function_rickr(dble(it-1)*DT-t0-t_cmt(isource),f0)
-
- ! we use a force in a single direction along one of the components:
- ! x/y/z or E/N/Z-direction would correspond to 1/2/3 = COMPONENT_FORCE_SOURCE
- ! e.g. nu_source(:,3) here would be a source normal to the surface (z-direction).
- accel(:,iglob) = accel(:,iglob) &
- + sngl( nu_source(:,COMPONENT_FORCE_SOURCE,isource) ) * stf_used
-
- else
-
- stf = comp_source_time_function(dble(it-1)*DT-t0-t_cmt(isource),hdur_gaussian(isource))
-
- ! distinguish between single and double precision for reals
- if(CUSTOM_REAL == SIZE_REAL) then
- stf_used = sngl(stf)
- else
- stf_used = stf
- endif
-
- ! add source array
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
- accel(:,iglob) = accel(:,iglob) + sourcearrays(isource,:,i,j,k)*stf_used
- enddo
- enddo
- enddo
-
- endif ! USE_FORCE_POINT_SOURCE
-
- stf_used_total = stf_used_total + stf_used
-
- endif ! ispec_is_elastic
- endif ! ispec_is_inner
- endif ! myrank
-
- enddo ! NSOURCES
- endif ! forward
-
-! NOTE: adjoint sources and backward wavefield timing:
-! idea is to start with the backward field b_displ,.. at time (T)
-! and convolve with the adjoint field at time (T-t)
-!
-! backward/reconstructed wavefields:
-! time for b_displ( it ) would correspond to (NSTEP - it - 1 )*DT - t0
-! if we read in saved wavefields b_displ() before Newark time scheme
-! (see sources for simulation_type 1 and seismograms)
-! since at the beginning of the time loop, the numerical Newark time scheme updates
-! the wavefields, that is b_displ( it=1) would correspond to time (NSTEP -1 - 1)*DT - t0
-!
-! b_displ is now read in after Newark time scheme:
-! we read the backward/reconstructed wavefield at the end of the first time loop,
-! such that b_displ(it=1) corresponds to -t0 + (NSTEP-1)*DT.
-! assuming that until that end the backward/reconstructed wavefield and adjoint fields
-! have a zero contribution to adjoint kernels.
-! thus the correct indexing is NSTEP - it + 1, instead of NSTEP - it
-!
-! adjoint wavefields:
-! since the adjoint source traces were derived from the seismograms,
-! it follows that for the adjoint wavefield, the time equivalent to ( T - t ) uses the time-reversed
-! adjoint source traces which start at -t0 and end at time (NSTEP-1)*DT - t0
-! for step it=1: (NSTEP -it + 1)*DT - t0 for backward wavefields corresponds to time T
-
-! adjoint simulations
- if (SIMULATION_TYPE == 2 .or. SIMULATION_TYPE == 3) then
-
-!<YANGL
-! read in adjoint sources block by block (for memory consideration)
-! e.g., in exploration experiments, both the number of receivers (nrec) and the number of time steps (NSTEP) are huge,
-! which may cause problems since we have a large array: adj_sourcearrays(nadj_rec_local,NSTEP,NDIM,NGLLX,NGLLY,NGLLZ)
-
- ! figure out if we need to read in a chunk of the adjoint source at this timestep
- it_sub_adj = ceiling( dble(it)/dble(NTSTEP_BETWEEN_READ_ADJSRC) ) !chunk_number
- ibool_read_adj_arrays = (((mod(it-1,NTSTEP_BETWEEN_READ_ADJSRC) == 0)) .and. (nadj_rec_local > 0))
-
- ! needs to read in a new chunk/block of the adjoint source
- if(ibool_read_adj_arrays) then
-
- irec_local = 0
- do irec = 1, nrec
- ! compute source arrays
- if(myrank == islice_selected_rec(irec)) then
- irec_local = irec_local + 1
-
- ! reads in **sta**.**net**.**LH**.adj files
- adj_source_file = trim(station_name(irec))//'.'//trim(network_name(irec))
- call compute_arrays_adjoint_source(myrank,adj_source_file, &
- xi_receiver(irec),eta_receiver(irec),gamma_receiver(irec), &
- adj_sourcearray, xigll,yigll,zigll, &
- it_sub_adj,NSTEP,NTSTEP_BETWEEN_READ_ADJSRC)
- do itime = 1,NTSTEP_BETWEEN_READ_ADJSRC
- adj_sourcearrays(irec_local,itime,:,:,:,:) = adj_sourcearray(itime,:,:,:,:)
- enddo
-
- endif
- enddo
-
- endif ! if(ibool_read_adj_arrays)
-!>YANGL
-
- if( it < NSTEP ) then
-
- ! receivers act as sources
- irec_local = 0
- do irec = 1,nrec
- ! add the source (only if this proc carries the source)
- if(myrank == islice_selected_rec(irec)) then
- irec_local = irec_local + 1
- ! adds source array
- do k = 1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec_selected_rec(irec))
-!<YANGL
-! accel(:,iglob) = accel(:,iglob) + adj_sourcearrays(irec_local,NSTEP-it+1,:,i,j,k)
- accel(:,iglob) = accel(:,iglob) + &
- adj_sourcearrays(irec_local,NTSTEP_BETWEEN_READ_ADJSRC-mod(it-1,NTSTEP_BETWEEN_READ_ADJSRC),:,i,j,k)
-!>YANGL
- enddo
- enddo
- enddo
- endif
- enddo ! nrec
-
- endif ! it
-
- endif !adjoint
-
-! note: b_displ() is read in after Newark time scheme, thus
-! b_displ(it=1) corresponds to -t0 + (NSTEP-1)*DT.
-! thus indexing is NSTEP - it , instead of NSTEP - it - 1
-
-! adjoint simulations
- if (SIMULATION_TYPE == 3) then
-
- ! backward source reconstruction
- do isource = 1,NSOURCES
-
- ! add the source (only if this proc carries the source)
- if(myrank == islice_selected_source(isource)) then
-
- ispec = ispec_selected_source(isource)
-
- if (ispec_is_inner(ispec) .eqv. phase_is_inner) then
-
- if( ispec_is_elastic(ispec) ) then
-
- if(USE_FORCE_POINT_SOURCE) then
-
- ! note: for use_force_point_source xi/eta/gamma are in the range [1,NGLL*]
- iglob = ibool(nint(xi_source(isource)), &
- nint(eta_source(isource)), &
- nint(gamma_source(isource)), &
- ispec_selected_source(isource))
-
- f0 = hdur(isource) !! using hdur as a FREQUENCY just to avoid changing CMTSOLUTION file format
- t0 = 1.2d0/f0
-
- !if (it == 1 .and. myrank == 0) then
- ! write(IMAIN,*) 'using a source of dominant frequency ',f0
- ! write(IMAIN,*) 'lambda_S at dominant frequency = ',3000./sqrt(3.)/f0
- ! write(IMAIN,*) 'lambda_S at highest significant frequency = ',3000./sqrt(3.)/(2.5*f0)
- !endif
-
- ! This is the expression of a Ricker; should be changed according maybe to the Par_file.
- stf_used = FACTOR_FORCE_SOURCE * comp_source_time_function_rickr(dble(NSTEP-it)*DT-t0-t_cmt(isource),f0)
-
- ! e.g. we use nu_source(:,3) here if we want a source normal to the surface.
- ! note: time step is now at NSTEP-it
- b_accel(:,iglob) = b_accel(:,iglob) &
- + sngl( nu_source(:,COMPONENT_FORCE_SOURCE,isource) ) * stf_used
-
- else
-
- ! see note above: time step corresponds now to NSTEP-it
- ! (also compare to it-1 for forward simulation)
- stf = comp_source_time_function(dble(NSTEP-it)*DT-t0-t_cmt(isource),hdur_gaussian(isource))
-
- ! distinguish between single and double precision for reals
- if(CUSTOM_REAL == SIZE_REAL) then
- stf_used = sngl(stf)
- else
- stf_used = stf
- endif
-
- ! add source array
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec_selected_source(isource))
- b_accel(:,iglob) = b_accel(:,iglob) + sourcearrays(isource,:,i,j,k)*stf_used
- enddo
- enddo
- enddo
- endif ! USE_FORCE_POINT_SOURCE
-
- stf_used_total = stf_used_total + stf_used
-
- endif ! elastic
- endif ! phase_inner
- endif ! myrank
-
- enddo ! NSOURCES
- endif ! adjoint
-
- ! master prints out source time function to file
- if(PRINT_SOURCE_TIME_FUNCTION .and. phase_is_inner) then
- time_source = (it-1)*DT - t0
- call sum_all_cr(stf_used_total,stf_used_total_all)
- if( myrank == 0 ) write(IOSTF,*) time_source,stf_used_total_all
- endif
-
-
- end subroutine compute_add_sources_elastic
Deleted: seismo/3D/SPECFEM3D/trunk/compute_arrays_source.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_arrays_source.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_arrays_source.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,576 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine compute_arrays_source(ispec_selected_source, &
- xi_source,eta_source,gamma_source,sourcearray, &
- Mxx,Myy,Mzz,Mxy,Mxz,Myz, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
- xigll,yigll,zigll,nspec)
-
- implicit none
-
- include "constants.h"
-
- integer ispec_selected_source
- integer nspec
-
- double precision xi_source,eta_source,gamma_source
- double precision Mxx,Myy,Mzz,Mxy,Mxz,Myz
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,nspec) :: xix,xiy,xiz,etax,etay,etaz, &
- gammax,gammay,gammaz
-
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NGLLZ) :: sourcearray
-
- double precision xixd,xiyd,xizd,etaxd,etayd,etazd,gammaxd,gammayd,gammazd
-
-! Gauss-Lobatto-Legendre points of integration and weights
- double precision, dimension(NGLLX) :: xigll
- double precision, dimension(NGLLY) :: yigll
- double precision, dimension(NGLLZ) :: zigll
-
-! source arrays
- double precision, dimension(NDIM,NGLLX,NGLLY,NGLLZ) :: sourcearrayd
- double precision, dimension(NGLLX,NGLLY,NGLLZ) :: G11,G12,G13,G21,G22,G23,G31,G32,G33
- double precision, dimension(NGLLX) :: hxis,hpxis
- double precision, dimension(NGLLY) :: hetas,hpetas
- double precision, dimension(NGLLZ) :: hgammas,hpgammas
-
- integer k,l,m
-
-! calculate G_ij for general source location
-! the source does not necessarily correspond to a Gauss-Lobatto point
- do m=1,NGLLZ
- do l=1,NGLLY
- do k=1,NGLLX
-
- xixd = dble(xix(k,l,m,ispec_selected_source))
- xiyd = dble(xiy(k,l,m,ispec_selected_source))
- xizd = dble(xiz(k,l,m,ispec_selected_source))
- etaxd = dble(etax(k,l,m,ispec_selected_source))
- etayd = dble(etay(k,l,m,ispec_selected_source))
- etazd = dble(etaz(k,l,m,ispec_selected_source))
- gammaxd = dble(gammax(k,l,m,ispec_selected_source))
- gammayd = dble(gammay(k,l,m,ispec_selected_source))
- gammazd = dble(gammaz(k,l,m,ispec_selected_source))
-
- G11(k,l,m) = Mxx*xixd+Mxy*xiyd+Mxz*xizd
- G12(k,l,m) = Mxx*etaxd+Mxy*etayd+Mxz*etazd
- G13(k,l,m) = Mxx*gammaxd+Mxy*gammayd+Mxz*gammazd
- G21(k,l,m) = Mxy*xixd+Myy*xiyd+Myz*xizd
- G22(k,l,m) = Mxy*etaxd+Myy*etayd+Myz*etazd
- G23(k,l,m) = Mxy*gammaxd+Myy*gammayd+Myz*gammazd
- G31(k,l,m) = Mxz*xixd+Myz*xiyd+Mzz*xizd
- G32(k,l,m) = Mxz*etaxd+Myz*etayd+Mzz*etazd
- G33(k,l,m) = Mxz*gammaxd+Myz*gammayd+Mzz*gammazd
-
- enddo
- enddo
- enddo
-
-! compute Lagrange polynomials at the source location
- call lagrange_any(xi_source,NGLLX,xigll,hxis,hpxis)
- call lagrange_any(eta_source,NGLLY,yigll,hetas,hpetas)
- call lagrange_any(gamma_source,NGLLZ,zigll,hgammas,hpgammas)
-
-! calculate source array
- do m=1,NGLLZ
- do l=1,NGLLY
- do k=1,NGLLX
- call multiply_arrays_source(sourcearrayd,G11,G12,G13,G21,G22,G23, &
- G31,G32,G33,hxis,hpxis,hetas,hpetas,hgammas,hpgammas,k,l,m)
- enddo
- enddo
- enddo
-
-! distinguish between single and double precision for reals
- if(CUSTOM_REAL == SIZE_REAL) then
- sourcearray(:,:,:,:) = sngl(sourcearrayd(:,:,:,:))
- else
- sourcearray(:,:,:,:) = sourcearrayd(:,:,:,:)
- endif
-
- end subroutine compute_arrays_source
-
-!================================================================
-
-! we put these multiplications in a separate routine because otherwise
-! some compilers try to unroll the six loops above and take forever to compile
- subroutine multiply_arrays_source(sourcearrayd,G11,G12,G13,G21,G22,G23, &
- G31,G32,G33,hxis,hpxis,hetas,hpetas,hgammas,hpgammas,k,l,m)
-
- implicit none
-
- include "constants.h"
-
-! source arrays
- double precision, dimension(NDIM,NGLLX,NGLLY,NGLLZ) :: sourcearrayd
- double precision, dimension(NGLLX,NGLLY,NGLLZ) :: G11,G12,G13,G21,G22,G23,G31,G32,G33
- double precision, dimension(NGLLX) :: hxis,hpxis
- double precision, dimension(NGLLY) :: hetas,hpetas
- double precision, dimension(NGLLZ) :: hgammas,hpgammas
-
- integer k,l,m
-
- integer ir,it,iv
-
- sourcearrayd(:,k,l,m) = ZERO
-
- do iv=1,NGLLZ
- do it=1,NGLLY
- do ir=1,NGLLX
-
- sourcearrayd(1,k,l,m) = sourcearrayd(1,k,l,m) + hxis(ir)*hetas(it)*hgammas(iv) &
- *(G11(ir,it,iv)*hpxis(k)*hetas(l)*hgammas(m) &
- +G12(ir,it,iv)*hxis(k)*hpetas(l)*hgammas(m) &
- +G13(ir,it,iv)*hxis(k)*hetas(l)*hpgammas(m))
-
- sourcearrayd(2,k,l,m) = sourcearrayd(2,k,l,m) + hxis(ir)*hetas(it)*hgammas(iv) &
- *(G21(ir,it,iv)*hpxis(k)*hetas(l)*hgammas(m) &
- +G22(ir,it,iv)*hxis(k)*hpetas(l)*hgammas(m) &
- +G23(ir,it,iv)*hxis(k)*hetas(l)*hpgammas(m))
-
- sourcearrayd(3,k,l,m) = sourcearrayd(3,k,l,m) + hxis(ir)*hetas(it)*hgammas(iv) &
- *(G31(ir,it,iv)*hpxis(k)*hetas(l)*hgammas(m) &
- +G32(ir,it,iv)*hxis(k)*hpetas(l)*hgammas(m) &
- +G33(ir,it,iv)*hxis(k)*hetas(l)*hpgammas(m))
-
- enddo
- enddo
- enddo
-
- end subroutine multiply_arrays_source
-
-!=============================================================================
-!<YANGL
-! testing read in adjoint sources block by block
-
-!!!the original version
-!!!
-!!!subroutine compute_arrays_adjoint_source(myrank, adj_source_file, &
-!!! xi_receiver,eta_receiver,gamma_receiver, adj_sourcearray, &
-!!! xigll,yigll,zigll,NSTEP)
-!!!
-!!!
-!!! implicit none
-!!!
-!!! include 'constants.h'
-!!!
-!!!! input
-!!! integer myrank, NSTEP
-!!!
-!!! double precision xi_receiver, eta_receiver, gamma_receiver
-!!!
-!!! character(len=*) adj_source_file
-!!!
-!!!! output
-!!! real(kind=CUSTOM_REAL),dimension(NSTEP,NDIM,NGLLX,NGLLY,NGLLZ) :: adj_sourcearray
-!!!
-!!!! Gauss-Lobatto-Legendre points of integration and weights
-!!! double precision, dimension(NGLLX) :: xigll
-!!! double precision, dimension(NGLLY) :: yigll
-!!! double precision, dimension(NGLLZ) :: zigll
-!!!
-!!! double precision :: hxir(NGLLX), hpxir(NGLLX), hetar(NGLLY), hpetar(NGLLY), &
-!!! hgammar(NGLLZ), hpgammar(NGLLZ)
-!!!
-!!! real(kind=CUSTOM_REAL) :: adj_src(NSTEP,NDIM)
-!!!
-!!! integer icomp, itime, i, j, k, ios
-!!! double precision :: junk
-!!! ! note: should have same order as orientation in write_seismograms_to_file()
-!!! character(len=3),dimension(NDIM) :: comp = (/ "BHE", "BHN", "BHZ" /)
-!!! character(len=256) :: filename
-!!!
-!!! !adj_sourcearray(:,:,:,:,:) = 0.
-!!! adj_src = 0._CUSTOM_REAL
-!!!
-!!! ! loops over components
-!!! do icomp = 1, NDIM
-!!!
-!!! filename = 'SEM/'//trim(adj_source_file) // '.'// comp(icomp) // '.adj'
-!!! open(unit=IIN,file=trim(filename),status='old',action='read',iostat = ios)
-!!! if (ios /= 0) cycle ! cycles to next file
-!!! !if (ios /= 0) call exit_MPI(myrank, ' file '//trim(filename)//'does not exist')
-!!!
-!!! ! reads in adjoint source trace
-!!! do itime = 1, NSTEP
-!!!
-!!! ! things become a bit tricky because of the Newark time scheme at
-!!! ! the very beginning of the time loop. however, when we read in the backward/reconstructed
-!!! ! wavefields at the end of the first time loop, we can use the adjoint source index from 1 to NSTEP
-!!! ! (and then access it in reverse NSTEP-it+1 down to 1, for it=1,..NSTEP; see compute_add_sources*.f90).
-!!! read(IIN,*,iostat=ios) junk, adj_src(itime,icomp)
-!!! if( ios /= 0 ) &
-!!! call exit_MPI(myrank, &
-!!! 'file '//trim(filename)//' has wrong length, please check with your simulation duration')
-!!! enddo
-!!! close(IIN)
-!!!
-!!! enddo
-!!!
-!!! ! lagrange interpolators for receiver location
-!!! call lagrange_any(xi_receiver,NGLLX,xigll,hxir,hpxir)
-!!! call lagrange_any(eta_receiver,NGLLY,yigll,hetar,hpetar)
-!!! call lagrange_any(gamma_receiver,NGLLZ,zigll,hgammar,hpgammar)
-!!!
-!!! ! interpolates adjoint source onto GLL points within this element
-!!! do k = 1, NGLLZ
-!!! do j = 1, NGLLY
-!!! do i = 1, NGLLX
-!!! adj_sourcearray(:,:,i,j,k) = hxir(i) * hetar(j) * hgammar(k) * adj_src(:,:)
-!!! enddo
-!!! enddo
-!!! enddo
-!!!
-!!!end subroutine compute_arrays_adjoint_source
-
-
-!!! test version
-subroutine compute_arrays_adjoint_source(myrank, adj_source_file, &
- xi_receiver,eta_receiver,gamma_receiver, adj_sourcearray, &
- xigll,yigll,zigll, &
- it_sub_adj,NSTEP,NTSTEP_BETWEEN_READ_ADJSRC)
-
- implicit none
-
- include 'constants.h'
-
-! input
- integer myrank, NSTEP, it_sub_adj, NTSTEP_BETWEEN_READ_ADJSRC
-
- double precision xi_receiver, eta_receiver, gamma_receiver
-
- character(len=*) adj_source_file
-
-! output
- real(kind=CUSTOM_REAL),dimension(NTSTEP_BETWEEN_READ_ADJSRC,NDIM,NGLLX,NGLLY,NGLLZ) :: adj_sourcearray
-
-! Gauss-Lobatto-Legendre points of integration and weights
- double precision, dimension(NGLLX) :: xigll
- double precision, dimension(NGLLY) :: yigll
- double precision, dimension(NGLLZ) :: zigll
-
- double precision :: hxir(NGLLX), hpxir(NGLLX), hetar(NGLLY), hpetar(NGLLY), &
- hgammar(NGLLZ), hpgammar(NGLLZ)
-
- real(kind=CUSTOM_REAL) :: adj_src(NTSTEP_BETWEEN_READ_ADJSRC,NDIM)
-
- integer icomp, itime, i, j, k, ios, it_start, it_end
- double precision :: junk
- ! note: should have same order as orientation in write_seismograms_to_file()
- character(len=3),dimension(NDIM) :: comp = (/ "BHE", "BHN", "BHZ" /)
- character(len=256) :: filename
-
- ! range of the block we need to read
- it_start = NSTEP - it_sub_adj*NTSTEP_BETWEEN_READ_ADJSRC + 1
- it_end = it_start + NTSTEP_BETWEEN_READ_ADJSRC - 1
-
- !adj_sourcearray(:,:,:,:,:) = 0.
- adj_src = 0._CUSTOM_REAL
-
- ! loops over components
- do icomp = 1, NDIM
-
- filename = 'SEM/'//trim(adj_source_file) // '.'// comp(icomp) // '.adj'
- open(unit=IIN,file=trim(filename),status='old',action='read',iostat = ios)
- if (ios /= 0) cycle ! cycles to next file
- !if (ios /= 0) call exit_MPI(myrank, ' file '//trim(filename)//'does not exist')
-
- ! reads in adjoint source trace
- !! skip unused blocks
- do itime = 1, it_start-1
- read(IIN,*,iostat=ios) junk, junk
- if( ios /= 0 ) &
- call exit_MPI(myrank, &
- 'file '//trim(filename)//' has wrong length, please check with your simulation duration (1111)')
- enddo
- !! read the block we need
- do itime = it_start, it_end
- read(IIN,*,iostat=ios) junk, adj_src(itime-it_start+1,icomp)
- if( ios /= 0 ) &
- call exit_MPI(myrank, &
- 'file '//trim(filename)//' has wrong length, please check with your simulation duration (2222)')
- enddo
- close(IIN)
-
- enddo
-
- ! lagrange interpolators for receiver location
- call lagrange_any(xi_receiver,NGLLX,xigll,hxir,hpxir)
- call lagrange_any(eta_receiver,NGLLY,yigll,hetar,hpetar)
- call lagrange_any(gamma_receiver,NGLLZ,zigll,hgammar,hpgammar)
-
- ! interpolates adjoint source onto GLL points within this element
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
- adj_sourcearray(:,:,i,j,k) = hxir(i) * hetar(j) * hgammar(k) * adj_src(:,:)
- enddo
- enddo
- enddo
-
-end subroutine compute_arrays_adjoint_source
-
-!>YANGL
-
-
-! =======================================================================
-! compute the integrated derivatives of source parameters (M_jk and X_s)
-
-subroutine compute_adj_source_frechet(displ_s,Mxx,Myy,Mzz,Mxy,Mxz,Myz,eps_s,eps_m_s, &
- hxir,hetar,hgammar,hpxir,hpetar,hpgammar, hprime_xx,hprime_yy,hprime_zz, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz)
-
- implicit none
-
- include 'constants.h'
-
- ! input
- real(kind=CUSTOM_REAL) :: displ_s(NDIM,NGLLX,NGLLY,NGLLZ)
- double precision :: Mxx, Myy, Mzz, Mxy, Mxz, Myz
- ! output
- real(kind=CUSTOM_REAL) :: eps_s(NDIM,NDIM), eps_m_s(NDIM)
-
- ! auxilliary
- double precision :: hxir(NGLLX), hetar(NGLLY), hgammar(NGLLZ), &
- hpxir(NGLLX),hpetar(NGLLY),hpgammar(NGLLZ)
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLY) :: hprime_yy
- real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz
-
-! local variables
- real(kind=CUSTOM_REAL) :: tempx1l,tempx2l,tempx3l, tempy1l,tempy2l,tempy3l, &
- tempz1l,tempz2l,tempz3l, hp1, hp2, hp3, &
- xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl, &
- duxdxl,duxdyl,duxdzl,duydxl,duydyl,duydzl,duzdxl,duzdyl,duzdzl, &
- xix_s,xiy_s,xiz_s,etax_s,etay_s,etaz_s,gammax_s,gammay_s,gammaz_s, &
- hlagrange_xi, hlagrange_eta, hlagrange_gamma, hlagrange
-
- real(kind=CUSTOM_REAL) :: eps(NDIM,NDIM), eps_array(NDIM,NDIM,NGLLX,NGLLY,NGLLZ), &
- eps_m_array(NGLLX,NGLLY,NGLLZ)
-
- integer i,j,k,l
-
-
-! first compute the strain at all the GLL points of the source element
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
-
- tempx1l = 0._CUSTOM_REAL
- tempx2l = 0._CUSTOM_REAL
- tempx3l = 0._CUSTOM_REAL
-
- tempy1l = 0._CUSTOM_REAL
- tempy2l = 0._CUSTOM_REAL
- tempy3l = 0._CUSTOM_REAL
-
- tempz1l = 0._CUSTOM_REAL
- tempz2l = 0._CUSTOM_REAL
- tempz3l = 0._CUSTOM_REAL
-
- do l=1,NGLLX
- hp1 = hprime_xx(i,l)
- tempx1l = tempx1l + displ_s(1,l,j,k)*hp1
- tempy1l = tempy1l + displ_s(2,l,j,k)*hp1
- tempz1l = tempz1l + displ_s(3,l,j,k)*hp1
-
- hp2 = hprime_yy(j,l)
- tempx2l = tempx2l + displ_s(1,i,l,k)*hp2
- tempy2l = tempy2l + displ_s(2,i,l,k)*hp2
- tempz2l = tempz2l + displ_s(3,i,l,k)*hp2
-
- hp3 = hprime_zz(k,l)
- tempx3l = tempx3l + displ_s(1,i,j,l)*hp3
- tempy3l = tempy3l + displ_s(2,i,j,l)*hp3
- tempz3l = tempz3l + displ_s(3,i,j,l)*hp3
- enddo
-
-! dudx
- xixl = xix(i,j,k)
- xiyl = xiy(i,j,k)
- xizl = xiz(i,j,k)
- etaxl = etax(i,j,k)
- etayl = etay(i,j,k)
- etazl = etaz(i,j,k)
- gammaxl = gammax(i,j,k)
- gammayl = gammay(i,j,k)
- gammazl = gammaz(i,j,k)
-
- duxdxl = xixl*tempx1l + etaxl*tempx2l + gammaxl*tempx3l
- duxdyl = xiyl*tempx1l + etayl*tempx2l + gammayl*tempx3l
- duxdzl = xizl*tempx1l + etazl*tempx2l + gammazl*tempx3l
-
- duydxl = xixl*tempy1l + etaxl*tempy2l + gammaxl*tempy3l
- duydyl = xiyl*tempy1l + etayl*tempy2l + gammayl*tempy3l
- duydzl = xizl*tempy1l + etazl*tempy2l + gammazl*tempy3l
-
- duzdxl = xixl*tempz1l + etaxl*tempz2l + gammaxl*tempz3l
- duzdyl = xiyl*tempz1l + etayl*tempz2l + gammayl*tempz3l
- duzdzl = xizl*tempz1l + etazl*tempz2l + gammazl*tempz3l
-
-! strain eps_jk
- eps(1,1) = duxdxl
- eps(1,2) = (duxdyl + duydxl) / 2
- eps(1,3) = (duxdzl + duzdxl) / 2
- eps(2,2) = duydyl
- eps(2,3) = (duydzl + duzdyl) / 2
- eps(3,3) = duzdzl
- eps(2,1) = eps(1,2)
- eps(3,1) = eps(1,3)
- eps(3,2) = eps(2,3)
-
- eps_array(:,:,i,j,k) = eps(:,:)
-
-! Mjk eps_jk
- eps_m_array(i,j,k) = Mxx * eps(1,1) + Myy * eps(2,2) + Mzz * eps(3,3) + &
- 2 * (Mxy * eps(1,2) + Mxz * eps(1,3) + Myz * eps(2,3))
-
- enddo
- enddo
- enddo
-
- ! interpolate the strain eps_s(:,:) from eps_array(:,:,i,j,k)
- eps_s = 0.
- xix_s = 0.; xiy_s = 0.; xiz_s = 0.
- etax_s = 0.; etay_s = 0.; etaz_s = 0.
- gammax_s = 0.; gammay_s = 0.; gammaz_s = 0.
-
- do k = 1,NGLLZ
- do j = 1,NGLLY
- do i = 1,NGLLX
-
- hlagrange = hxir(i)*hetar(j)*hgammar(k)
-
- eps_s(1,1) = eps_s(1,1) + eps_array(1,1,i,j,k)*hlagrange
- eps_s(1,2) = eps_s(1,2) + eps_array(1,2,i,j,k)*hlagrange
- eps_s(1,3) = eps_s(1,3) + eps_array(1,3,i,j,k)*hlagrange
- eps_s(2,2) = eps_s(2,2) + eps_array(2,2,i,j,k)*hlagrange
- eps_s(2,3) = eps_s(2,3) + eps_array(2,3,i,j,k)*hlagrange
- eps_s(3,3) = eps_s(3,3) + eps_array(3,3,i,j,k)*hlagrange
-
- xix_s = xix_s + xix(i,j,k)*hlagrange
- xiy_s = xiy_s + xiy(i,j,k)*hlagrange
- xiz_s = xiz_s + xiz(i,j,k)*hlagrange
- etax_s = etax_s + etax(i,j,k)*hlagrange
- etay_s = etay_s + etay(i,j,k)*hlagrange
- etaz_s = etaz_s + etaz(i,j,k)*hlagrange
- gammax_s = gammax_s + gammax(i,j,k)*hlagrange
- gammay_s = gammay_s + gammay(i,j,k)*hlagrange
- gammaz_s = gammaz_s + gammaz(i,j,k)*hlagrange
-
- enddo
- enddo
- enddo
-
-! for completion purpose, not used in specfem3D.f90
- eps_s(2,1) = eps_s(1,2)
- eps_s(3,1) = eps_s(1,3)
- eps_s(3,2) = eps_s(2,3)
-
-! compute the gradient of M_jk * eps_jk, and then interpolate it
-
- eps_m_s = 0.
- do k = 1,NGLLZ
- do j = 1,NGLLY
- do i = 1,NGLLX
-
- hlagrange_xi = hpxir(i)*hetar(j)*hgammar(k)
- hlagrange_eta = hxir(i)*hpetar(j)*hgammar(k)
- hlagrange_gamma = hxir(i)*hetar(j)*hpgammar(k)
-
- eps_m_s(1) = eps_m_s(1) + eps_m_array(i,j,k) * (hlagrange_xi * xix_s &
- + hlagrange_eta * etax_s + hlagrange_gamma * gammax_s)
- eps_m_s(2) = eps_m_s(2) + eps_m_array(i,j,k) * (hlagrange_xi * xiy_s &
- + hlagrange_eta * etay_s + hlagrange_gamma * gammay_s)
- eps_m_s(3) = eps_m_s(3) + eps_m_array(i,j,k) * (hlagrange_xi * xiz_s &
- + hlagrange_eta * etaz_s + hlagrange_gamma * gammaz_s)
-
- enddo
- enddo
- enddo
-
-end subroutine compute_adj_source_frechet
-
-! =======================================================================
-
-! compute array for acoustic source
- subroutine compute_arrays_source_acoustic(xi_source,eta_source,gamma_source,&
- sourcearray,xigll,yigll,zigll,factor_source)
-
- implicit none
-
- include "constants.h"
-
- double precision :: xi_source,eta_source,gamma_source
- real(kind=CUSTOM_REAL) :: factor_source
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NGLLZ) :: sourcearray
-
-! Gauss-Lobatto-Legendre points of integration and weights
- double precision, dimension(NGLLX) :: xigll
- double precision, dimension(NGLLY) :: yigll
- double precision, dimension(NGLLZ) :: zigll
-
-! local parameters
-! source arrays
- double precision, dimension(NDIM,NGLLX,NGLLY,NGLLZ) :: sourcearrayd
- double precision, dimension(NGLLX) :: hxis,hpxis
- double precision, dimension(NGLLY) :: hetas,hpetas
- double precision, dimension(NGLLZ) :: hgammas,hpgammas
- integer :: i,j,k
-
-! initializes
- sourcearray(:,:,:,:) = 0._CUSTOM_REAL
- sourcearrayd(:,:,:,:) = 0.d0
-
-! computes Lagrange polynomials at the source location
- call lagrange_any(xi_source,NGLLX,xigll,hxis,hpxis)
- call lagrange_any(eta_source,NGLLY,yigll,hetas,hpetas)
- call lagrange_any(gamma_source,NGLLZ,zigll,hgammas,hpgammas)
-
-! calculates source array for interpolated location
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- ! identical source array components in x,y,z-direction
- sourcearrayd(:,i,j,k) = hxis(i)*hetas(j)*hgammas(k)*dble(factor_source)
- enddo
- enddo
- enddo
-
-! distinguish between single and double precision for reals
- if(CUSTOM_REAL == SIZE_REAL) then
- sourcearray(:,:,:,:) = sngl(sourcearrayd(:,:,:,:))
- else
- sourcearray(:,:,:,:) = sourcearrayd(:,:,:,:)
- endif
-
- end subroutine compute_arrays_source_acoustic
-
-
Deleted: seismo/3D/SPECFEM3D/trunk/compute_boundary_kernel.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_boundary_kernel.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_boundary_kernel.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,232 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine compute_boundary_kernel()
-
-! isotropic topography kernel computation
-! compare with Tromp et al. (2005), eq. (25), or see Liu & Tromp (2008), eq. (65)
-
- use specfem_par
- use specfem_par_elastic
- use specfem_par_acoustic
-
- implicit none
- ! local parameters
- real(kind=CUSTOM_REAL):: kernel_moho_top,kernel_moho_bot
- integer :: i,j,k
- integer :: ispec2D,igll,jgll
- integer :: ispec_top,ispec_bot,iglob_top,iglob_bot
- logical :: is_done
-
- ! loops over top/bottom elements of moho surface
- do ispec2D = 1, NSPEC2D_MOHO
- ispec_top = ibelm_moho_top(ispec2D)
- ispec_bot = ibelm_moho_bot(ispec2D)
-
- ! elements on both sides available
- if( ispec_top > 0 .and. ispec_bot > 0 ) then
- ! loops over surface
- do igll=1,NGLLSQUARE
- i = ijk_moho_top(1,igll,ispec2D)
- j = ijk_moho_top(2,igll,ispec2D)
- k = ijk_moho_top(3,igll,ispec2D)
- iglob_top = ibool(i,j,k,ispec_top)
-
- ! computes contribution from top element
- call compute_boundary_kernel_elem( kernel_moho_top, &
- mustore(i,j,k,ispec_top), &
- kappastore(i,j,k,ispec_top),rho_vs(i,j,k,ispec_top), &
- accel(:,iglob_top),b_displ(:,iglob_top), &
- dsdx_top(:,:,i,j,k,ispec2D),b_dsdx_top(:,:,i,j,k,ispec2D), &
- normal_moho_top(:,igll,ispec2D) )
-
- ! finds corresponding global node in bottom element
- is_done = .false.
- do jgll = 1,NGLLSQUARE
- i = ijk_moho_bot(1,jgll,ispec2D)
- j = ijk_moho_bot(2,jgll,ispec2D)
- k = ijk_moho_bot(3,jgll,ispec2D)
- iglob_bot = ibool(i,j,k,ispec_bot)
-
- if( iglob_bot /= iglob_top ) cycle
- ! iglob_top == iglob_bot!
-
- ! computes contribution from bottom element
- call compute_boundary_kernel_elem( kernel_moho_bot, &
- mustore(i,j,k,ispec_bot), &
- kappastore(i,j,k,ispec_bot),rho_vs(i,j,k,ispec_bot), &
- accel(:,iglob_bot),b_displ(:,iglob_bot), &
- dsdx_bot(:,:,i,j,k,ispec2D),b_dsdx_bot(:,:,i,j,k,ispec2D), &
- normal_moho_bot(:,jgll,ispec2D) )
-
- ! note: kernel point position: indices given by ijk_moho_top(:,igll,ispec2D)
- moho_kl(igll,ispec2D) = moho_kl(igll,ispec2D) &
- + (kernel_moho_top - kernel_moho_bot) * deltat
-
- ! kernel done for this point
- is_done = .true.
- enddo
-
- ! checks
- if( .not. is_done ) then
- print*,'error : moho kernel not computed'
- print*,'ispec:',ispec_top,ispec_bot,iglob_top,i,j,k
- call exit_mpi(myrank,'error moho kernel computation')
- endif
-
- enddo
-
- ! only one element available
- ! e.g. free-surface: see Tromp et al. (2005), eq. (28)
- else if( ispec_bot > 0 .or. ispec_top > 0 ) then
-
- ! loops over surface
- do igll=1,NGLLSQUARE
-
- if( ispec_top > 0 ) then
- i = ijk_moho_top(1,igll,ispec2D)
- j = ijk_moho_top(2,igll,ispec2D)
- k = ijk_moho_top(3,igll,ispec2D)
- iglob_top = ibool(i,j,k,ispec_top)
-
- ! computes contribution from top element
- call compute_boundary_kernel_elem( kernel_moho_top, &
- mustore(i,j,k,ispec_top), &
- kappastore(i,j,k,ispec_top),rho_vs(i,j,k,ispec_top), &
- accel(:,iglob_top),b_displ(:,iglob_top), &
- dsdx_top(:,:,i,j,k,ispec2D),b_dsdx_top(:,:,i,j,k,ispec2D), &
- normal_moho_top(:,igll,ispec2D) )
-
- ! note: kernel point position igll: indices given by ijk_moho_top(:,igll,ispec2D)
- moho_kl(igll,ispec2D) = moho_kl(igll,ispec2D) + kernel_moho_top * deltat
-
- else
- i = ijk_moho_bot(1,igll,ispec2D)
- j = ijk_moho_bot(2,igll,ispec2D)
- k = ijk_moho_bot(3,igll,ispec2D)
- iglob_bot = ibool(i,j,k,ispec_bot)
-
- ! computes contribution from bottom element
- call compute_boundary_kernel_elem( kernel_moho_bot, &
- mustore(i,j,k,ispec_bot), &
- kappastore(i,j,k,ispec_bot),rho_vs(i,j,k,ispec_bot), &
- accel(:,iglob_bot),b_displ(:,iglob_bot), &
- dsdx_bot(:,:,i,j,k,ispec2D),b_dsdx_bot(:,:,i,j,k,ispec2D), &
- normal_moho_bot(:,igll,ispec2D) )
-
- ! note: kernel point position igll: indices given by ijk_moho_bot(:,igll,ispec2D)
- moho_kl(igll,ispec2D) = moho_kl(igll,ispec2D) - kernel_moho_bot * deltat
-
- endif
- enddo
- endif
- enddo ! ispec2D
-
-
-end subroutine compute_boundary_kernel
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine compute_boundary_kernel_elem(kernel, mul, kappal, rho_vsl, &
- accel, b_displ, ds, b_ds, norm)
-
-! compute the boundary kernel contribution from one side of the boundary
-! see e.g.: Tromp et al. (2005), eq. (25), or Liu & Tromp (2008), eq. (65)
-
- implicit none
- include 'constants.h'
-
- real(kind=CUSTOM_REAL) kernel, mul, kappal, rho_vsl
- real(kind=CUSTOM_REAL) :: accel(NDIM), b_displ(NDIM), ds(NDIM,NDIM), b_ds(NDIM,NDIM), norm(NDIM)
-
- real(kind=CUSTOM_REAL) :: eps3, eps(NDIM,NDIM), epsdev(NDIM,NDIM), normal(NDIM,1)
- real(kind=CUSTOM_REAL) :: b_eps3, b_eps(NDIM,NDIM), b_epsdev(NDIM,NDIM)
- real(kind=CUSTOM_REAL) :: temp1(NDIM,NDIM), rhol, kl(1,1), one_matrix(1,1)
-
-
- normal(:,1) = norm
- one_matrix(1,1) = ONE
-
- ! adjoint strain (epsilon) trace
- eps3 = ds(1,1) + ds(2,2) + ds(3,3)
-
- ! adjoint strain tensor
- eps(1,1) = ds(1,1)
- eps(2,2) = ds(2,2)
- eps(3,3) = ds(3,3)
- eps(1,2) = (ds(1,2) + ds(2,1))/2
- eps(1,3) = (ds(1,3) + ds(3,1))/2
- eps(2,3) = (ds(2,3) + ds(3,2))/2
- eps(2,1) = eps(1,2)
- eps(3,1) = eps(1,3)
- eps(3,2) = eps(2,3)
-
- ! adjoint deviatoric strain component
- epsdev = eps
- epsdev(1,1) = eps(1,1) - eps3 / 3
- epsdev(2,2) = eps(2,2) - eps3 / 3
- epsdev(3,3) = eps(3,3) - eps3 / 3
-
-
- ! backward/reconstructed-forward strain (epsilon) trace
- b_eps3 = b_ds(1,1) + b_ds(2,2) + b_ds(3,3)
-
- ! backward/reconstructed-forward strain tensor
- b_eps(1,1) = b_ds(1,1)
- b_eps(2,2) = b_ds(2,2)
- b_eps(3,3) = b_ds(3,3)
- b_eps(1,2) = (b_ds(1,2) + b_ds(2,1))/2
- b_eps(1,3) = (b_ds(1,3) + b_ds(3,1))/2
- b_eps(2,3) = (b_ds(2,3) + b_ds(3,2))/2
- b_eps(2,1) = b_eps(1,2)
- b_eps(3,1) = b_eps(1,3)
- b_eps(3,2) = b_eps(2,3)
-
- ! backward/reconstructed-forward deviatoric strain
- b_epsdev = b_eps
- b_epsdev(1,1) = b_eps(1,1) - b_eps3 / 3
- b_epsdev(2,2) = b_eps(2,2) - b_eps3 / 3
- b_epsdev(3,3) = b_eps(3,3) - b_eps3 / 3
-
- ! matrix multiplication
- temp1 = matmul(epsdev,b_epsdev)
-
- ! density value
- rhol = rho_vsl ** 2 / mul
-
- ! isotropic kernel value
- ! see e.g.: Tromp et al. (2005), eq. (25), or Liu & Tromp 2008, eq. (65)
- kl = ( rhol * dot_product(accel(:), b_displ(:)) + kappal * eps3 * b_eps3 &
- + 2 * mul * (temp1(1,1) + temp1(2,2) + temp1(3,3)) ) * one_matrix &
- - kappal * matmul(transpose(normal),matmul(eps,normal)) * b_eps3 &
- - kappal * matmul(transpose(normal),matmul(b_eps,normal)) * eps3 &
- - 2 * mul * matmul(transpose(normal), matmul(matmul(b_epsdev,ds), normal)) &
- - 2 * mul * matmul(transpose(normal), matmul(matmul(epsdev,b_ds), normal))
-
- kernel = kl(1,1)
-
-end subroutine compute_boundary_kernel_elem
Deleted: seismo/3D/SPECFEM3D/trunk/compute_coupling_acoustic_el.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_coupling_acoustic_el.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_coupling_acoustic_el.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,123 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-! for acoustic solver
-
- subroutine compute_coupling_acoustic_el(NSPEC_AB,NGLOB_AB, &
- ibool,displ,potential_dot_dot_acoustic, &
- num_coupling_ac_el_faces, &
- coupling_ac_el_ispec,coupling_ac_el_ijk, &
- coupling_ac_el_normal, &
- coupling_ac_el_jacobian2Dw, &
- ispec_is_inner,phase_is_inner)
-
-! returns the updated pressure array: potential_dot_dot_acoustic
-
- implicit none
- include 'constants.h'
-
- integer :: NSPEC_AB,NGLOB_AB
-
-! displacement and pressure
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: displ
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_dot_acoustic
-
-! global indexing
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
-! acoustic-elastic coupling surface
- integer :: num_coupling_ac_el_faces
- real(kind=CUSTOM_REAL) :: coupling_ac_el_normal(NDIM,NGLLSQUARE,num_coupling_ac_el_faces)
- real(kind=CUSTOM_REAL) :: coupling_ac_el_jacobian2Dw(NGLLSQUARE,num_coupling_ac_el_faces)
- integer :: coupling_ac_el_ijk(3,NGLLSQUARE,num_coupling_ac_el_faces)
- integer :: coupling_ac_el_ispec(num_coupling_ac_el_faces)
-
-! communication overlap
- logical, dimension(NSPEC_AB) :: ispec_is_inner
- logical :: phase_is_inner
-
-! local parameters
- real(kind=CUSTOM_REAL) :: displ_x,displ_y,displ_z,displ_n
- real(kind=CUSTOM_REAL) :: nx,ny,nz,jacobianw
-
- integer :: iface,igll,ispec,iglob
- integer :: i,j,k
-
-! loops on all coupling faces
- do iface = 1,num_coupling_ac_el_faces
-
- ! gets corresponding elements
- ! (note: can be either acoustic or elastic element, no need to specify since
- ! no material properties are needed for this coupling term)
- ispec = coupling_ac_el_ispec(iface)
-
- if( ispec_is_inner(ispec) .eqv. phase_is_inner ) then
-
- ! loops over common GLL points
- do igll = 1, NGLLSQUARE
- i = coupling_ac_el_ijk(1,igll,iface)
- j = coupling_ac_el_ijk(2,igll,iface)
- k = coupling_ac_el_ijk(3,igll,iface)
-
- ! gets global index of this common GLL point
- ! (note: should be the same as for corresponding i',j',k',ispec_elastic or ispec_acoustic)
- iglob = ibool(i,j,k,ispec)
-
- ! elastic displacement on global point
- displ_x = displ(1,iglob)
- displ_y = displ(2,iglob)
- displ_z = displ(3,iglob)
-
- ! gets associated normal on GLL point
- ! (note convention: pointing outwards of acoustic element)
- nx = coupling_ac_el_normal(1,igll,iface)
- ny = coupling_ac_el_normal(2,igll,iface)
- nz = coupling_ac_el_normal(3,igll,iface)
-
- ! calculates displacement component along normal
- ! (normal points outwards of acoustic element)
- displ_n = displ_x*nx + displ_y*ny + displ_z*nz
-
- ! gets associated, weighted jacobian
- jacobianw = coupling_ac_el_jacobian2Dw(igll,iface)
-
- ! continuity of pressure and normal displacement on global point
- !
- ! note: newark time scheme together with definition of scalar potential:
- ! pressure = - chi_dot_dot
- ! requires that this coupling term uses the updated displacement at time step [t+delta_t],
- ! which is done at the very beginning of the time loop
- ! (see e.g. Chaljub & Vilotte, Nissen-Meyer thesis...)
- ! it also means you have to calculate and update this here first before
- ! calculating the coupling on the elastic side for the acceleration...
- potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) + jacobianw*displ_n
-
- enddo ! igll
-
- endif
-
- enddo ! iface
-
-end subroutine compute_coupling_acoustic_el
Deleted: seismo/3D/SPECFEM3D/trunk/compute_coupling_elastic_ac.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_coupling_elastic_ac.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_coupling_elastic_ac.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,121 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-! for elastic solver
-
- subroutine compute_coupling_elastic_ac(NSPEC_AB,NGLOB_AB, &
- ibool,accel,potential_dot_dot_acoustic, &
- num_coupling_ac_el_faces, &
- coupling_ac_el_ispec,coupling_ac_el_ijk, &
- coupling_ac_el_normal, &
- coupling_ac_el_jacobian2Dw, &
- ispec_is_inner,phase_is_inner)
-
-! returns the updated acceleration array: accel
-
- implicit none
- include 'constants.h'
-
- integer :: NSPEC_AB,NGLOB_AB
-
-! displacement and pressure
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: accel
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_dot_acoustic
-
-! global indexing
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
-! acoustic-elastic coupling surface
- integer :: num_coupling_ac_el_faces
- real(kind=CUSTOM_REAL) :: coupling_ac_el_normal(NDIM,NGLLSQUARE,num_coupling_ac_el_faces)
- real(kind=CUSTOM_REAL) :: coupling_ac_el_jacobian2Dw(NGLLSQUARE,num_coupling_ac_el_faces)
- integer :: coupling_ac_el_ijk(3,NGLLSQUARE,num_coupling_ac_el_faces)
- integer :: coupling_ac_el_ispec(num_coupling_ac_el_faces)
-
-! communication overlap
- logical, dimension(NSPEC_AB) :: ispec_is_inner
- logical :: phase_is_inner
-
-! local parameters
- real(kind=CUSTOM_REAL) :: pressure
- real(kind=CUSTOM_REAL) :: nx,ny,nz,jacobianw
-
- integer :: iface,igll,ispec,iglob
- integer :: i,j,k
-
-! loops on all coupling faces
- do iface = 1,num_coupling_ac_el_faces
-
- ! gets corresponding spectral element
- ! (note: can be either acoustic or elastic element, no need to specify since
- ! no material properties are needed for this coupling term)
- ispec = coupling_ac_el_ispec(iface)
-
- if( ispec_is_inner(ispec) .eqv. phase_is_inner ) then
-
- ! loops over common GLL points
- do igll = 1, NGLLSQUARE
- i = coupling_ac_el_ijk(1,igll,iface)
- j = coupling_ac_el_ijk(2,igll,iface)
- k = coupling_ac_el_ijk(3,igll,iface)
-
- ! gets global index of this common GLL point
- ! (note: should be the same as for corresponding i',j',k',ispec_elastic or ispec_elastic )
- iglob = ibool(i,j,k,ispec)
-
- ! acoustic pressure on global point
- pressure = - potential_dot_dot_acoustic(iglob)
-
- ! gets associated normal on GLL point
- ! (note convention: pointing outwards of acoustic element)
- nx = coupling_ac_el_normal(1,igll,iface)
- ny = coupling_ac_el_normal(2,igll,iface)
- nz = coupling_ac_el_normal(3,igll,iface)
-
- ! gets associated, weighted 2D jacobian
- ! (note: should be the same for elastic and acoustic element)
- jacobianw = coupling_ac_el_jacobian2Dw(igll,iface)
-
- ! continuity of displacement and pressure on global point
- !
- ! note: newark time scheme together with definition of scalar potential:
- ! pressure = - chi_dot_dot
- ! requires that this coupling term uses the *UPDATED* pressure (chi_dot_dot), i.e.
- ! pressure at time step [t + delta_t]
- ! (see e.g. Chaljub & Vilotte, Nissen-Meyer thesis...)
- ! it means you have to calculate and update the acoustic pressure first before
- ! calculating this term...
- accel(1,iglob) = accel(1,iglob) + jacobianw*nx*pressure
- accel(2,iglob) = accel(2,iglob) + jacobianw*ny*pressure
- accel(3,iglob) = accel(3,iglob) + jacobianw*nz*pressure
-
- enddo ! igll
-
- endif
-
- enddo ! iface
-
-end subroutine compute_coupling_elastic_ac
-
Deleted: seismo/3D/SPECFEM3D/trunk/compute_forces_acoustic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_forces_acoustic.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_forces_acoustic.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,388 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-! acoustic solver
-
-! in case of an acoustic medium, a potential Chi of (density * displacement) is used as in Chaljub and Valette,
-! Geophysical Journal International, vol. 158, p. 131-141 (2004) and *NOT* a velocity potential
-! as in Komatitsch and Tromp, Geophysical Journal International, vol. 150, p. 303-318 (2002).
-!
-! This permits acoustic-elastic coupling based on a non-iterative time scheme.
-! Displacement is then:
-! u = grad(Chi) / rho
-! Velocity is then:
-! v = grad(Chi_dot) / rho
-! (Chi_dot being the time derivative of Chi)
-! and pressure is:
-! p = - Chi_dot_dot
-! (Chi_dot_dot being the time second derivative of Chi).
-!
-! The source in an acoustic element is a pressure source.
-!
-! First-order acoustic-acoustic discontinuities are also handled automatically
-! because pressure is continuous at such an interface, therefore Chi_dot_dot
-! is continuous, therefore Chi is also continuous, which is consistent with
-! the spectral-element basis functions and with the assembling process.
-! This is the reason why a simple displacement potential u = grad(Chi) would
-! not work because it would be discontinuous at such an interface and would
-! therefore not be consistent with the basis functions.
-
-
-subroutine compute_forces_acoustic()
-
- use specfem_par
- use specfem_par_acoustic
- use specfem_par_elastic
- use specfem_par_poroelastic
- use PML_par
- use PML_par_acoustic
- implicit none
- ! local parameters
- integer:: iphase
- logical:: phase_is_inner
-
-
-! enforces free surface (zeroes potentials at free surface)
- call acoustic_enforce_free_surface(NSPEC_AB,NGLOB_AB, &
- potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic, &
- ibool,free_surface_ijk,free_surface_ispec, &
- num_free_surface_faces,ispec_is_acoustic)
-
- ! adjoint simulations
- if( SIMULATION_TYPE == 3 ) &
- call acoustic_enforce_free_surface(NSPEC_AB,NGLOB_ADJOINT, &
- b_potential_acoustic,b_potential_dot_acoustic,b_potential_dot_dot_acoustic, &
- ibool,free_surface_ijk,free_surface_ispec, &
- num_free_surface_faces,ispec_is_acoustic)
-
-
- if(PML) call PML_acoustic_enforce_free_srfc(NSPEC_AB,NGLOB_AB, &
- potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic, &
- ibool,free_surface_ijk,free_surface_ispec, &
- num_free_surface_faces,ispec_is_acoustic, &
- num_PML_ispec,PML_ispec,&
- chi1,chi2,chi2_t,chi3,chi4,&
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot,&
- chi1_dot_dot,chi2_t_dot_dot,&
- chi3_dot_dot,chi4_dot_dot)
-
-! distinguishes two runs: for points on MPI interfaces, and points within the partitions
- do iphase=1,2
-
- !first for points on MPI interfaces
- if( iphase == 1 ) then
- phase_is_inner = .false.
- else
- phase_is_inner = .true.
- endif
-
-! acoustic pressure term
- call compute_forces_acoustic_pot( iphase, NSPEC_AB,NGLOB_AB, &
- potential_acoustic,potential_dot_dot_acoustic, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
- hprime_xx,hprime_yy,hprime_zz, &
- hprimewgll_xx,hprimewgll_yy,hprimewgll_zz, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- rhostore,jacobian,ibool, &
- num_phase_ispec_acoustic,nspec_inner_acoustic,nspec_outer_acoustic,&
- phase_ispec_inner_acoustic )
-
- ! adjoint simulations
- if( SIMULATION_TYPE == 3 ) &
- call compute_forces_acoustic_pot( iphase, NSPEC_ADJOINT,NGLOB_ADJOINT, &
- b_potential_acoustic,b_potential_dot_dot_acoustic, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
- hprime_xx,hprime_yy,hprime_zz, &
- hprimewgll_xx,hprimewgll_yy,hprimewgll_zz, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- rhostore,jacobian,ibool, &
- num_phase_ispec_acoustic,nspec_inner_acoustic,nspec_outer_acoustic,&
- phase_ispec_inner_acoustic )
-
-
- if(PML) then
- call compute_forces_acoustic_PML(NSPEC_AB,NGLOB_AB, &
- ibool,ispec_is_inner,phase_is_inner, &
- rhostore,ispec_is_acoustic,potential_acoustic, &
- hprime_xx,hprime_yy,hprime_zz, &
- hprimewgll_xx,hprimewgll_yy,hprimewgll_zz, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz,jacobian,&
- wxgll,wygll,wzgll,&
- PML_damping_dprime,num_PML_ispec,&
- PML_ispec,PML_normal,&
- chi1_dot_dot,chi2_t_dot_dot,&
- chi3_dot_dot,chi4_dot_dot)
-
- ! couples potential_dot_dot with PML interface contributions
- call PML_acoustic_interface_coupling(phase_is_inner,NSPEC_AB,NGLOB_AB,&
- potential_dot_dot_acoustic,&
- ibool,ispec_is_inner,ispec_is_acoustic,&
- num_PML_ispec,PML_ispec,iglob_is_PML_interface,&
- chi1_dot_dot,chi3_dot_dot,chi4_dot_dot)
-
- endif ! PML
-
-! absorbing boundaries
- if(ABSORBING_CONDITIONS) then
- if( PML .and. PML_USE_SOMMERFELD ) then
- ! adds a Sommerfeld condition on the domain's absorbing boundaries
- call PML_acoustic_abs_boundaries(phase_is_inner,NSPEC_AB,NGLOB_AB,&
- abs_boundary_jacobian2Dw,abs_boundary_ijk,abs_boundary_ispec, &
- num_abs_boundary_faces, &
- kappastore,ibool,ispec_is_inner, &
- rhostore,ispec_is_acoustic,&
- potential_dot_acoustic,potential_dot_dot_acoustic,&
- num_PML_ispec,PML_ispec,ispec_is_PML_inum,&
- chi1_dot,chi2_t,chi2_t_dot,chi3_dot,chi4_dot,&
- chi1_dot_dot,chi3_dot_dot,chi4_dot_dot)
- else
- call compute_stacey_acoustic(NSPEC_AB,NGLOB_AB, &
- potential_dot_dot_acoustic,potential_dot_acoustic, &
- ibool,ispec_is_inner,phase_is_inner, &
- abs_boundary_jacobian2Dw,abs_boundary_ijk,abs_boundary_ispec, &
- num_abs_boundary_faces,rhostore,kappastore,ispec_is_acoustic, &
- SIMULATION_TYPE,SAVE_FORWARD,NSTEP,it,myrank,NGLOB_ADJOINT, &
- b_potential_dot_dot_acoustic,b_reclen_potential, &
- b_absorb_potential,b_num_abs_boundary_faces)
- endif
- endif
-
-! elastic coupling
- if(ELASTIC_SIMULATION ) then
- call compute_coupling_acoustic_el(NSPEC_AB,NGLOB_AB, &
- ibool,displ,potential_dot_dot_acoustic, &
- num_coupling_ac_el_faces, &
- coupling_ac_el_ispec,coupling_ac_el_ijk, &
- coupling_ac_el_normal, &
- coupling_ac_el_jacobian2Dw, &
- ispec_is_inner,phase_is_inner)
- ! adjoint simulations
- if( SIMULATION_TYPE == 3 ) &
- call compute_coupling_acoustic_el(NSPEC_ADJOINT,NGLOB_ADJOINT, &
- ibool,b_displ,b_potential_dot_dot_acoustic, &
- num_coupling_ac_el_faces, &
- coupling_ac_el_ispec,coupling_ac_el_ijk, &
- coupling_ac_el_normal, &
- coupling_ac_el_jacobian2Dw, &
- ispec_is_inner,phase_is_inner)
- endif
-
-! poroelastic coupling
-! not implemented yet
- !if(POROELASTIC_SIMULATION ) &
- ! call compute_coupling_acoustic_poro()
-
-! sources
- call compute_add_sources_acoustic(NSPEC_AB,NGLOB_AB,potential_dot_dot_acoustic, &
- ibool,ispec_is_inner,phase_is_inner, &
- NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
- xi_source,eta_source,gamma_source, &
- hdur,hdur_gaussian,t_cmt,dt,t0, &
- sourcearrays,kappastore,ispec_is_acoustic,&
- SIMULATION_TYPE,NSTEP,NGLOB_ADJOINT, &
- nrec,islice_selected_rec,ispec_selected_rec, &
- nadj_rec_local,adj_sourcearrays,b_potential_dot_dot_acoustic, &
- NTSTEP_BETWEEN_READ_ADJSRC )
-
-! assemble all the contributions between slices using MPI
- if( phase_is_inner .eqv. .false. ) then
- ! sends potential_dot_dot_acoustic values to corresponding MPI interface neighbors (non-blocking)
- call assemble_MPI_scalar_ext_mesh_s(NPROC,NGLOB_AB,potential_dot_dot_acoustic, &
- buffer_send_scalar_ext_mesh,buffer_recv_scalar_ext_mesh, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh, &
- request_send_scalar_ext_mesh,request_recv_scalar_ext_mesh)
- ! adjoint simulations
- if( SIMULATION_TYPE == 3 ) &
- call assemble_MPI_scalar_ext_mesh_s(NPROC,NGLOB_ADJOINT,b_potential_dot_dot_acoustic, &
- b_buffer_send_scalar_ext_mesh,b_buffer_recv_scalar_ext_mesh, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh, &
- b_request_send_scalar_ext_mesh,b_request_recv_scalar_ext_mesh)
- else
- ! waits for send/receive requests to be completed and assembles values
- call assemble_MPI_scalar_ext_mesh_w(NPROC,NGLOB_AB,potential_dot_dot_acoustic, &
- buffer_recv_scalar_ext_mesh,num_interfaces_ext_mesh,&
- max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- request_send_scalar_ext_mesh,request_recv_scalar_ext_mesh)
- ! adjoint simulations
- if( SIMULATION_TYPE == 3 ) &
- call assemble_MPI_scalar_ext_mesh_w(NPROC,NGLOB_ADJOINT,b_potential_dot_dot_acoustic, &
- b_buffer_recv_scalar_ext_mesh,num_interfaces_ext_mesh,&
- max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- b_request_send_scalar_ext_mesh,b_request_recv_scalar_ext_mesh)
-
- endif
-
-
- enddo
-
- ! divides pressure with mass matrix
- potential_dot_dot_acoustic(:) = potential_dot_dot_acoustic(:) * rmass_acoustic(:)
-
- ! adjoint simulations
- if (SIMULATION_TYPE == 3) &
- b_potential_dot_dot_acoustic(:) = b_potential_dot_dot_acoustic(:) * rmass_acoustic(:)
-
-
- if(PML) then
- ! divides local contributions with mass term
- call PML_acoustic_mass_update(NSPEC_AB,NGLOB_AB,&
- ispec_is_acoustic,rmass_acoustic,ibool,&
- num_PML_ispec,PML_ispec,&
- chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot)
-
- ! Newark time scheme corrector terms
- call PML_acoustic_time_corrector(NSPEC_AB,ispec_is_acoustic,deltatover2,&
- num_PML_ispec,PML_ispec,PML_damping_d,&
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot,&
- chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot)
- endif
-
-
-! update velocity
-! note: Newark finite-difference time scheme with acoustic domains:
-! (see e.g. Hughes, 1987; Chaljub et al., 2003)
-!
-! chi(t+delta_t) = chi(t) + delta_t chi_dot(t) + 1/2 delta_t**2 chi_dot_dot(t)
-! chi_dot(t+delta_t) = chi_dot(t) + 1/2 delta_t chi_dot_dot(t) + 1/2 DELTA_T CHI_DOT_DOT( T + DELTA_T )
-! chi_dot_dot(t+delta_t) = 1/M_acoustic( -K_acoustic chi(t+delta) + B_acoustic u(t+delta_t) + f(t+delta_t) )
-!
-! where
-! chi, chi_dot, chi_dot_dot are acoustic (fluid) potentials ( dotted with respect to time)
-! u, v, a are displacement,velocity & acceleration
-! M is mass matrix, K stiffness matrix and B boundary term
-! f denotes a source term
-!
-! corrector:
-! updates the chi_dot term which requires chi_dot_dot(t+delta)
- potential_dot_acoustic(:) = potential_dot_acoustic(:) + deltatover2*potential_dot_dot_acoustic(:)
-
- ! adjoint simulations
- if (SIMULATION_TYPE == 3) &
- b_potential_dot_acoustic(:) = b_potential_dot_acoustic(:) + b_deltatover2*b_potential_dot_dot_acoustic(:)
-
- ! updates potential_dot_acoustic and potential_dot_dot_acoustic inside PML region for plotting seismograms/movies
- if(PML) call PML_acoustic_update_potentials(NGLOB_AB,NSPEC_AB, &
- ibool,ispec_is_acoustic, &
- potential_dot_acoustic,potential_dot_dot_acoustic,&
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh,NPROC,&
- num_PML_ispec,PML_ispec,iglob_is_PML_interface,&
- PML_mask_ibool,PML_damping_d,&
- chi1,chi2,chi2_t,chi3,&
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot,&
- chi1_dot_dot,chi3_dot_dot,chi4_dot_dot)
-
-
-! enforces free surface (zeroes potentials at free surface)
- call acoustic_enforce_free_surface(NSPEC_AB,NGLOB_AB, &
- potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic, &
- ibool,free_surface_ijk,free_surface_ispec, &
- num_free_surface_faces,ispec_is_acoustic)
-
- ! adjoint simulations
- if (SIMULATION_TYPE == 3) &
- call acoustic_enforce_free_surface(NSPEC_AB,NGLOB_ADJOINT, &
- b_potential_acoustic,b_potential_dot_acoustic,b_potential_dot_dot_acoustic, &
- ibool,free_surface_ijk,free_surface_ispec, &
- num_free_surface_faces,ispec_is_acoustic)
-
-
- if(PML) call PML_acoustic_enforce_free_srfc(NSPEC_AB,NGLOB_AB, &
- potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic, &
- ibool,free_surface_ijk,free_surface_ispec, &
- num_free_surface_faces, &
- ispec_is_acoustic, &
- num_PML_ispec,PML_ispec,&
- chi1,chi2,chi2_t,chi3,chi4,&
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot,&
- chi1_dot_dot,chi2_t_dot_dot,&
- chi3_dot_dot,chi4_dot_dot)
-
-
-end subroutine compute_forces_acoustic
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-
-subroutine acoustic_enforce_free_surface(NSPEC_AB,NGLOB_AB, &
- potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic, &
- ibool,free_surface_ijk,free_surface_ispec, &
- num_free_surface_faces,ispec_is_acoustic)
- implicit none
- include 'constants.h'
-
- integer :: NSPEC_AB,NGLOB_AB
-
-! acoustic potentials
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: &
- potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic
-
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
-! free surface
- integer :: num_free_surface_faces
- integer :: free_surface_ijk(3,NGLLSQUARE,num_free_surface_faces)
- integer :: free_surface_ispec(num_free_surface_faces)
-
- logical, dimension(NSPEC_AB) :: ispec_is_acoustic
-
-! local parameters
- integer :: iface,igll,i,j,k,ispec,iglob
-
-! enforce potentials to be zero at surface
- do iface = 1, num_free_surface_faces
-
- ispec = free_surface_ispec(iface)
-
- if( ispec_is_acoustic(ispec) ) then
-
- do igll = 1, NGLLSQUARE
- i = free_surface_ijk(1,igll,iface)
- j = free_surface_ijk(2,igll,iface)
- k = free_surface_ijk(3,igll,iface)
- iglob = ibool(i,j,k,ispec)
-
- ! sets potentials to zero
- potential_acoustic(iglob) = 0._CUSTOM_REAL
- potential_dot_acoustic(iglob) = 0._CUSTOM_REAL
- potential_dot_dot_acoustic(iglob) = 0._CUSTOM_REAL
- enddo
- endif
-
- enddo
-
-end subroutine acoustic_enforce_free_surface
-
Deleted: seismo/3D/SPECFEM3D/trunk/compute_forces_acoustic_PML.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_forces_acoustic_PML.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_forces_acoustic_PML.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,1186 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-subroutine compute_forces_acoustic_PML(NSPEC_AB,NGLOB_AB, &
- ibool,ispec_is_inner,phase_is_inner, &
- rhostore,ispec_is_acoustic,potential_acoustic, &
- hprime_xx,hprime_yy,hprime_zz, &
- hprimewgll_xx,hprimewgll_yy,hprimewgll_zz, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz,jacobian,&
- wxgll,wygll,wzgll,&
- PML_damping_dprime,num_PML_ispec,&
- PML_ispec,PML_normal,&
- chi1_dot_dot,chi2_t_dot_dot,&
- chi3_dot_dot,chi4_dot_dot)
-
- use constants,only: NGLLX,NGLLY,NGLLZ,NDIM,TINYVAL_SNGL,CUSTOM_REAL
- implicit none
-
- integer :: NSPEC_AB,NGLOB_AB
-
- ! potential
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_acoustic
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
- ! split-potentials
- integer :: num_PML_ispec
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- PML_damping_dprime
- integer,dimension(num_PML_ispec):: PML_ispec
- real(kind=CUSTOM_REAL),dimension(NDIM,num_PML_ispec):: PML_normal
-
- ! communication overlap
- logical, dimension(NSPEC_AB) :: ispec_is_inner
- logical :: phase_is_inner
-
- logical, dimension(NSPEC_AB) :: ispec_is_acoustic
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: rhostore
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz,jacobian
-
- ! array with derivatives of Lagrange polynomials and precalculated products
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx,hprimewgll_xx
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLY) :: hprime_yy,hprimewgll_yy
- real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz,hprimewgll_zz
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY) :: wgllwgll_xy
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ) :: wgllwgll_xz
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ) :: wgllwgll_yz
-
- double precision, dimension(NGLLX) :: wxgll
- double precision, dimension(NGLLY) :: wygll
- double precision, dimension(NGLLZ) :: wzgll
-
- ! local parameters
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: chi_elem
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: temp1_n,temp2_n,temp3_n
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: temp1_p,temp2_p,temp3_p
- real(kind=CUSTOM_REAL) :: rho_invl
- real(kind=CUSTOM_REAL) :: temp1l,temp2l,temp3l
- real(kind=CUSTOM_REAL) :: xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl,jacobianl
- real(kind=CUSTOM_REAL) :: dpotentialdxl,dpotentialdyl,dpotentialdzl
- real(kind=CUSTOM_REAL) :: dpotentialdxl_n,dpotentialdyl_n,dpotentialdzl_n
- real(kind=CUSTOM_REAL) :: dpotentialdxl_p,dpotentialdyl_p,dpotentialdzl_p
- real(kind=CUSTOM_REAL) :: nx,ny,nz,grad_n,dprime,weights
- integer :: ispec,iglob,i,j,k,l,ispecPML
-
- ! loops over all PML elements
- do ispecPML=1,num_PML_ispec
-
- ispec = PML_ispec(ispecPML)
-
- ! checks with MPI interface flag
- if (ispec_is_inner(ispec) .eqv. phase_is_inner) then
-
- ! only acoustic part
- if( ispec_is_acoustic(ispec) ) then
-
- ! gets values for element
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- chi_elem(i,j,k) = potential_acoustic(ibool(i,j,k,ispec))
- enddo
- enddo
- enddo
- ! checks if anything to do
- if( maxval( abs( chi_elem ) ) < TINYVAL_SNGL ) cycle
-
- ! PML normal
- nx = PML_normal(1,ispecPML)
- ny = PML_normal(2,ispecPML)
- nz = PML_normal(3,ispecPML)
-
- ! calculates terms:
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
-
- ! density (reciproc)
- rho_invl = 1.0_CUSTOM_REAL / rhostore(i,j,k,ispec)
-
- ! derivative along x, y, z
- ! first double loop over GLL points to compute and store gradients
- ! we can merge the loops because NGLLX == NGLLY == NGLLZ
- temp1l = 0._CUSTOM_REAL
- temp2l = 0._CUSTOM_REAL
- temp3l = 0._CUSTOM_REAL
-
- do l = 1,NGLLX
- temp1l = temp1l + chi_elem(l,j,k)*hprime_xx(i,l)
- temp2l = temp2l + chi_elem(i,l,k)*hprime_yy(j,l)
- temp3l = temp3l + chi_elem(i,j,l)*hprime_zz(k,l)
- enddo
-
- ! get derivatives of potential with respect to x, y and z
- xixl = xix(i,j,k,ispec)
- xiyl = xiy(i,j,k,ispec)
- xizl = xiz(i,j,k,ispec)
- etaxl = etax(i,j,k,ispec)
- etayl = etay(i,j,k,ispec)
- etazl = etaz(i,j,k,ispec)
- gammaxl = gammax(i,j,k,ispec)
- gammayl = gammay(i,j,k,ispec)
- gammazl = gammaz(i,j,k,ispec)
- jacobianl = jacobian(i,j,k,ispec)
-
- ! derivatives of potential
- ! \npartial_i \chi
- dpotentialdxl = xixl*temp1l + etaxl*temp2l + gammaxl*temp3l
- dpotentialdyl = xiyl*temp1l + etayl*temp2l + gammayl*temp3l
- dpotentialdzl = xizl*temp1l + etazl*temp2l + gammazl*temp3l
-
- ! splits derivatives of potential into normal and parallel components
- ! dpotential normal to PML plane
- ! \hat{n} \partial_n \chi
- grad_n = dpotentialdxl*nx + dpotentialdyl*ny + dpotentialdzl*nz
- dpotentialdxl_n = nx * grad_n
- dpotentialdyl_n = ny * grad_n
- dpotentialdzl_n = nz * grad_n
-
-
- ! dpotential parallel to plane
- ! \nabla^{parallel} \chi
- dpotentialdxl_p = dpotentialdxl - dpotentialdxl_n
- dpotentialdyl_p = dpotentialdyl - dpotentialdyl_n
- dpotentialdzl_p = dpotentialdzl - dpotentialdzl_n
-
- ! normal incidence term: ( 1/rho J \hat{n} \partial_n \chi )
- ! (note: we can add two weights at this point to save some computations )
- temp1_n(i,j,k) = rho_invl * jacobianl * dpotentialdxl_n
- temp2_n(i,j,k) = rho_invl * jacobianl * dpotentialdyl_n
- temp3_n(i,j,k) = rho_invl * jacobianl * dpotentialdzl_n
-
- ! parallel incidence 1/rho J \nabla^{parallel} \chi
- temp1_p(i,j,k) = rho_invl * jacobianl * dpotentialdxl_p
- temp2_p(i,j,k) = rho_invl * jacobianl * dpotentialdyl_p
- temp3_p(i,j,k) = rho_invl * jacobianl * dpotentialdzl_p
- enddo
- enddo
- enddo
-
- ! second double-loop over GLL to compute all the terms
- do k = 1,NGLLZ
- do j = 1,NGLLZ
- do i = 1,NGLLX
-
- iglob = ibool(i,j,k,ispec)
-
- ! 1. split term:
- !-----------------
- ! normal derivative of w dotted with normal dpotential
- ! ( \hat{n} \nabla_n w ) \cdot ( 1/rho \hat{n} \nabla_n \chi )
- temp1l = 0._CUSTOM_REAL
- temp2l = 0._CUSTOM_REAL
- temp3l = 0._CUSTOM_REAL
- do l=1,NGLLX
- ! derivatives
- xixl = xix(l,j,k,ispec)
- xiyl = xiy(l,j,k,ispec)
- xizl = xiz(l,j,k,ispec)
- ! note: hprimewgll_xx(l,i) = hprime_xx(l,i)*wxgll(l)
- ! don't confuse order of indices in hprime_xx: they are l and i
- ! -> lagrangian (hprime) function i evaluated at point xi_{ l }
- temp1l = temp1l + hprimewgll_xx(l,i) &
- *(nx*temp1_n(l,j,k)+ny*temp2_n(l,j,k)+nz*temp3_n(l,j,k)) &
- *(nx*xixl+ny*xiyl+nz*xizl)
-
- etaxl = etax(i,l,k,ispec)
- etayl = etay(i,l,k,ispec)
- etazl = etaz(i,l,k,ispec)
-
- temp2l = temp2l + hprimewgll_yy(l,j) &
- *(nx*temp1_n(i,l,k)+ny*temp2_n(i,l,k)+nz*temp3_n(i,l,k)) &
- *(nx*etaxl+ny*etayl+nz*etazl)
-
- gammaxl = gammax(i,j,l,ispec)
- gammayl = gammay(i,j,l,ispec)
- gammazl = gammaz(i,j,l,ispec)
-
- temp3l = temp3l + hprimewgll_zz(l,k) &
- *(nx*temp1_n(i,j,l)+ny*temp2_n(i,j,l)+nz*temp3_n(i,j,l)) &
- *(nx*gammaxl+ny*gammayl+nz*gammazl)
- enddo
- temp1l = temp1l * wgllwgll_yz(j,k)
- temp2l = temp2l * wgllwgll_xz(i,k)
- temp3l = temp3l * wgllwgll_xy(i,j)
-
- chi1_dot_dot(i,j,k,ispecPML) = - (temp1l + temp2l + temp3l)
-
- ! 2. split term:
- !-----------------
- ! dprime times normal w dotted with normal dpotential
- ! w dprime \hat{n} \cdot ( 1/rho \hat{n} \nabla_n \chi )
-
- weights = wxgll(i)*wygll(j)*wzgll(k)
-
- temp1l = nx*temp1_n(i,j,k)*weights
- temp2l = ny*temp2_n(i,j,k)*weights
- temp3l = nz*temp3_n(i,j,k)*weights
-
- dprime = PML_damping_dprime(i,j,k,ispecPML)
-
- ! contribution has negative sign?
- chi2_t_dot_dot(i,j,k,ispecPML) = - dprime*(temp1l + temp2l + temp3l )
-
-
- ! 3. split term:
- !-----------------
- ! parallel derivative of w dotted with normal dpotential
- ! ( \nabla^{parallel} w ) \cdot ( 1/rho \hat{n} \nabla_n \chi )
- ! and
- ! normal derivative of w dotted with parallel dpotential
- ! ( \hat{n} \nabla_n w ) \cdot ( 1/rho \nabla_{parallel} \chi )
- temp1l = 0._CUSTOM_REAL
- temp2l = 0._CUSTOM_REAL
- temp3l = 0._CUSTOM_REAL
- do l=1,NGLLX
- ! derivatives
- xixl = xix(l,j,k,ispec)
- xiyl = xiy(l,j,k,ispec)
- xizl = xiz(l,j,k,ispec)
- etaxl = etax(i,l,k,ispec)
- etayl = etay(i,l,k,ispec)
- etazl = etaz(i,l,k,ispec)
- gammaxl = gammax(i,j,l,ispec)
- gammayl = gammay(i,j,l,ispec)
- gammazl = gammaz(i,j,l,ispec)
-
- ! normal derivative of w dotted with parallel dpotential
- temp1l = temp1l + hprimewgll_xx(l,i) &
- *(nx*temp1_p(l,j,k)+ny*temp2_p(l,j,k)+nz*temp3_p(l,j,k)) &
- *(nx*xixl+ny*xiyl+nz*xizl)
-
- temp2l = temp2l + hprimewgll_yy(l,j) &
- *(nx*temp1_p(i,l,k)+ny*temp2_p(i,l,k)+nz*temp3_p(i,l,k)) &
- *(nx*etaxl+ny*etayl+nz*etazl)
-
- temp3l = temp3l + hprimewgll_zz(l,k) &
- *(nx*temp1_p(i,j,l)+ny*temp2_p(i,j,l)+nz*temp3_p(i,j,l)) &
- *(nx*gammaxl+ny*gammayl+nz*gammazl)
-
-
- ! parallel derivative of w dotted with normal dpotential
- temp1l = temp1l + hprimewgll_xx(l,i) &
- *( (xixl - nx*(nx*xixl+ny*xiyl+nz*xizl))*temp1_n(l,j,k) &
- +(xiyl - ny*(nx*xixl+ny*xiyl+nz*xizl))*temp2_n(l,j,k) &
- +(xizl - nz*(nx*xixl+ny*xiyl+nz*xizl))*temp3_n(l,j,k) )
-
- temp2l = temp2l + hprimewgll_yy(l,j) &
- *( (etaxl - nx*(nx*etaxl+ny*etayl+nz*etazl))*temp1_n(i,l,k) &
- +(etayl - ny*(nx*etaxl+ny*etayl+nz*etazl))*temp2_n(i,l,k) &
- +(etazl - nz*(nx*etaxl+ny*etayl+nz*etazl))*temp3_n(i,l,k) )
-
- temp3l = temp3l + hprimewgll_zz(l,k) &
- *( (gammaxl - nx*(nx*gammaxl+ny*gammayl+nz*gammazl))*temp1_n(i,j,l) &
- +(gammayl - ny*(nx*gammaxl+ny*gammayl+nz*gammazl))*temp2_n(i,j,l) &
- +(gammazl - nz*(nx*gammaxl+ny*gammayl+nz*gammazl))*temp3_n(i,j,l) )
- enddo
- temp1l = temp1l * wgllwgll_yz(j,k)
- temp2l = temp2l * wgllwgll_xz(i,k)
- temp3l = temp3l * wgllwgll_xy(i,j)
-
- chi3_dot_dot(i,j,k,ispecPML) = - (temp1l + temp2l + temp3l)
-
-
- ! 4. split term:
- !-----------------
- ! parallel derivative of w dotted with parallel dpotential
- ! ( \nabla_{parallel} w ) \cdot ( 1/rho \nabla_{parallel} \chi )
- temp1l = 0._CUSTOM_REAL
- temp2l = 0._CUSTOM_REAL
- temp3l = 0._CUSTOM_REAL
- do l=1,NGLLX
- ! derivatives
- xixl = xix(l,j,k,ispec)
- xiyl = xiy(l,j,k,ispec)
- xizl = xiz(l,j,k,ispec)
- etaxl = etax(i,l,k,ispec)
- etayl = etay(i,l,k,ispec)
- etazl = etaz(i,l,k,ispec)
- gammaxl = gammax(i,j,l,ispec)
- gammayl = gammay(i,j,l,ispec)
- gammazl = gammaz(i,j,l,ispec)
-
- temp1l = temp1l + hprimewgll_xx(l,i) &
- *( (xixl - nx*(nx*xixl+ny*xiyl+nz*xizl))*temp1_p(l,j,k) &
- +(xiyl - ny*(nx*xixl+ny*xiyl+nz*xizl))*temp2_p(l,j,k) &
- +(xizl - nz*(nx*xixl+ny*xiyl+nz*xizl))*temp3_p(l,j,k) )
-
- temp2l = temp2l + hprimewgll_yy(l,j) &
- *( (etaxl - nx*(nx*etaxl+ny*etayl+nz*etazl))*temp1_p(i,l,k) &
- +(etayl - ny*(nx*etaxl+ny*etayl+nz*etazl))*temp2_p(i,l,k) &
- +(etazl - nz*(nx*etaxl+ny*etayl+nz*etazl))*temp3_p(i,l,k) )
-
- temp3l = temp3l + hprimewgll_zz(l,k) &
- *( (gammaxl - nx*(nx*gammaxl+ny*gammayl+nz*gammazl))*temp1_p(i,j,l) &
- +(gammayl - ny*(nx*gammaxl+ny*gammayl+nz*gammazl))*temp2_p(i,j,l) &
- +(gammazl - nz*(nx*gammaxl+ny*gammayl+nz*gammazl))*temp3_p(i,j,l) )
- enddo
- temp1l = temp1l * wgllwgll_yz(j,k)
- temp2l = temp2l * wgllwgll_xz(i,k)
- temp3l = temp3l * wgllwgll_xy(i,j)
-
- chi4_dot_dot(i,j,k,ispecPML) = - (temp1l + temp2l + temp3l)
-
- enddo
- enddo
- enddo
-
- ! note: the surface integral expressions would be needed for points on a free surface
- !
- ! BUT at the free surface: potentials are set to zero (zero pressure condition),
- ! thus the additional surface term contributions would be zeored again.
-
- endif ! ispec_is_acoustic
- endif ! ispec_is_inner
- enddo ! num_PML_ispec
-
-end subroutine compute_forces_acoustic_PML
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_acoustic_abs_boundaries(phase_is_inner,NSPEC_AB,NGLOB_AB,&
- abs_boundary_jacobian2Dw,abs_boundary_ijk,abs_boundary_ispec, &
- num_abs_boundary_faces, &
- kappastore,ibool,ispec_is_inner, &
- rhostore,ispec_is_acoustic,&
- potential_dot_acoustic,potential_dot_dot_acoustic,&
- num_PML_ispec,PML_ispec,ispec_is_PML_inum,&
- chi1_dot,chi2_t,chi2_t_dot,chi3_dot,chi4_dot,&
- chi1_dot_dot,chi3_dot_dot,chi4_dot_dot)
-
-! absorbs absorbing-boundary surface using Sommerfeld condition (vanishing field in the outer-space)
-
- use constants,only: NGLLX,NGLLY,NGLLZ,NGLLSQUARE,CUSTOM_REAL
- implicit none
-
- integer :: NSPEC_AB,NGLOB_AB
-
- ! split-potentials
- integer :: num_PML_ispec
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1_dot,chi2_t,chi2_t_dot,chi3_dot,chi4_dot
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1_dot_dot,chi3_dot_dot,chi4_dot_dot
- integer,dimension(num_PML_ispec):: PML_ispec
- integer,dimension(NSPEC_AB):: ispec_is_PML_inum
-
- ! potentials
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_dot_acoustic,&
- potential_dot_acoustic
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
- ! communication overlap
- logical, dimension(NSPEC_AB) :: ispec_is_inner
- logical :: phase_is_inner
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: rhostore,kappastore
- logical, dimension(NSPEC_AB) :: ispec_is_acoustic
-
- ! absorbing boundary surface
- integer :: num_abs_boundary_faces
- real(kind=CUSTOM_REAL) :: abs_boundary_jacobian2Dw(NGLLSQUARE,num_abs_boundary_faces)
- integer :: abs_boundary_ijk(3,NGLLSQUARE,num_abs_boundary_faces)
- integer :: abs_boundary_ispec(num_abs_boundary_faces)
-
- ! local parameters
- real(kind=CUSTOM_REAL) :: rhol,cpl,jacobianw,temp
- integer :: ispec,iglob,i,j,k,iface,igll,ispecPML
-
- ! absorbs absorbing-boundary surface using Sommerfeld condition (vanishing field in the outer-space)
- do iface=1,num_abs_boundary_faces
-
- ispec = abs_boundary_ispec(iface)
-
- if (ispec_is_inner(ispec) .eqv. phase_is_inner) then
-
- if( ispec_is_acoustic(ispec) .and. ispec_is_PML_inum(ispec) > 0 ) then
-
- do ispecPML=1,num_PML_ispec
-
- if( PML_ispec(ispecPML) == ispec) then
-
- ! reference gll points on boundary face
- do igll = 1,NGLLSQUARE
-
- ! gets local indices for GLL point
- i = abs_boundary_ijk(1,igll,iface)
- j = abs_boundary_ijk(2,igll,iface)
- k = abs_boundary_ijk(3,igll,iface)
-
- ! gets global index
- iglob=ibool(i,j,k,ispec)
-
- ! determines bulk sound speed
- rhol = rhostore(i,j,k,ispec)
- cpl = sqrt( kappastore(i,j,k,ispec) / rhol )
-
- ! gets associated, weighted jacobian
- jacobianw = abs_boundary_jacobian2Dw(igll,iface)
-
- temp = jacobianw / cpl / rhol
-
- ! Sommerfeld condition
- potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) &
- - potential_dot_acoustic(iglob) * jacobianw / cpl / rhol
- ! split-potentials
- chi1_dot_dot(i,j,k,ispecPML) = chi1_dot_dot(i,j,k,ispecPML) - chi1_dot(i,j,k,ispecPML) * temp
- chi3_dot_dot(i,j,k,ispecPML) = chi3_dot_dot(i,j,k,ispecPML) - chi3_dot(i,j,k,ispecPML) * temp
- chi4_dot_dot(i,j,k,ispecPML) = chi4_dot_dot(i,j,k,ispecPML) - chi4_dot(i,j,k,ispecPML) * temp
-
- ! chi2 potential?
- chi2_t_dot(i,j,k,ispecPML) = chi2_t_dot(i,j,k,ispecPML) - chi2_t(i,j,k,ispecPML) * temp
-
- enddo
- endif
- enddo
- endif ! ispec_is_acoustic
- endif ! ispec_is_inner
- enddo ! num_abs_boundary_faces
-
-end subroutine PML_acoustic_abs_boundaries
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_acoustic_interface_coupling(phase_is_inner,NSPEC_AB,NGLOB_AB,&
- potential_dot_dot_acoustic,&
- ibool,ispec_is_inner,ispec_is_acoustic,&
- num_PML_ispec,PML_ispec,iglob_is_PML_interface,&
- chi1_dot_dot,chi3_dot_dot,chi4_dot_dot)
-
-! couples potential_dot_dot with PML interface contributions
-
- use constants,only: NGLLX,NGLLY,NGLLZ,CUSTOM_REAL
- implicit none
-
- integer :: NGLOB_AB,NSPEC_AB
-
- ! split-potentials
- integer :: num_PML_ispec
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1_dot_dot,chi3_dot_dot,chi4_dot_dot
- integer,dimension(num_PML_ispec):: PML_ispec
- integer,dimension(NGLOB_AB):: iglob_is_PML_interface
-
- ! potential
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_dot_acoustic
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
- ! communication overlap
- logical, dimension(NSPEC_AB) :: ispec_is_inner
- logical :: phase_is_inner
-
- logical, dimension(NSPEC_AB) :: ispec_is_acoustic
-
-
- !local parameters
- integer :: iglob,ispecPML,i,j,k,ispec
-
- ! experimental:
- ! updates with the contribution from potential_dot_dot_acoustic on split potentials and vice versa
-
- do ispecPML = 1,num_PML_ispec
-
- ispec = PML_ispec(ispecPML)
-
- if( ispec_is_inner(ispec) .eqv. phase_is_inner ) then
-
- ! acoustic potentials
- if( ispec_is_acoustic(ispec) ) then
-
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
-
- ! sums contributions to PML potentials on interface points
- if( iglob_is_PML_interface(iglob) > 0 ) then
-
- ! this would be the contribution to the potential_dot_dot array
- ! note: on PML interface, damping coefficient d should to be zero
- ! as well as dprime (-> no chi2 contribution)
-
- potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) &
- + chi1_dot_dot(i,j,k,ispecPML) &
- + chi3_dot_dot(i,j,k,ispecPML) &
- + chi4_dot_dot(i,j,k,ispecPML)
-
- endif ! interface iglob
- enddo
- enddo
- enddo
-
- endif ! ispec_is_acoustic
- endif ! ispec_is_inner
- enddo ! ispecPML
-
-
-end subroutine PML_acoustic_interface_coupling
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-
-subroutine PML_acoustic_mass_update(NSPEC_AB,NGLOB_AB,&
- ispec_is_acoustic,rmass_acoustic,ibool,&
- num_PML_ispec,PML_ispec,&
- chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot)
-
-! updates split-potentials with local mass in PML region
-
- use constants,only: NGLLX,NGLLY,NGLLZ,CUSTOM_REAL
- implicit none
- integer :: NSPEC_AB,NGLOB_AB
-
- ! split-potentials
- integer :: num_PML_ispec
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot
- integer,dimension(num_PML_ispec):: PML_ispec
-
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: rmass_acoustic
-
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
- logical, dimension(NSPEC_AB) :: ispec_is_acoustic
-
- !local parameters
- real(kind=CUSTOM_REAL):: mass
- integer :: ispec,ispecPML,i,j,k,iglob
-
- ! updates the dot_dot potentials for the PML
- do ispecPML = 1,num_PML_ispec
-
- ispec = PML_ispec(ispecPML)
-
- ! acoustic potentials
- if( ispec_is_acoustic(ispec) ) then
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
-
- ! global mass ( sum over elements included)
- mass = rmass_acoustic(iglob)
-
- chi1_dot_dot(i,j,k,ispecPML) = chi1_dot_dot(i,j,k,ispecPML) * mass
- chi2_t_dot_dot(i,j,k,ispecPML) = chi2_t_dot_dot(i,j,k,ispecPML) * mass
- chi3_dot_dot(i,j,k,ispecPML) = chi3_dot_dot(i,j,k,ispecPML) * mass
- chi4_dot_dot(i,j,k,ispecPML) = chi4_dot_dot(i,j,k,ispecPML) * mass
-
- enddo
- enddo
- enddo
- endif
- enddo
-
-end subroutine PML_acoustic_mass_update
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_acoustic_time_march(NSPEC_AB,NGLOB_AB,ibool,&
- potential_acoustic,potential_dot_acoustic,&
- deltat,deltatsqover2,deltatover2,&
- num_PML_ispec,PML_ispec,PML_damping_d,&
- chi1,chi2,chi2_t,chi3,chi4,&
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot,&
- chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot,&
- iglob_is_PML_interface,PML_mask_ibool,&
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh,&
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh,NPROC,&
- ispec_is_acoustic)
-
-
-! time marching scheme - updates with corrector terms
-!
-! note that the value of d changes according to the distance to the boundary,
-! thus instead of updating the whole arrays chi1(:) this scheme updates every given,single value chi1,...
-
- use constants,only: NGLLX,NGLLY,NGLLZ,CUSTOM_REAL
- implicit none
-
- integer :: NSPEC_AB,NGLOB_AB
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
- ! potentials
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_acoustic
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_acoustic
-
- real(kind=CUSTOM_REAL):: deltat,deltatsqover2,deltatover2
-
- ! split-potentials
- integer :: num_PML_ispec
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1,chi2,chi2_t,chi3,chi4
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- PML_damping_d
-
- integer,dimension(num_PML_ispec):: PML_ispec
- integer,dimension(NGLOB_AB) :: iglob_is_PML_interface
- logical,dimension(NGLOB_AB) :: PML_mask_ibool
-
- ! MPI communication
- integer :: NPROC
- integer :: num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: nibool_interfaces_ext_mesh,my_neighbours_ext_mesh
- integer, dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: ibool_interfaces_ext_mesh
-
- logical, dimension(NSPEC_AB) :: ispec_is_acoustic
-
- !local parameters
- real(kind=CUSTOM_REAL),dimension(:),allocatable:: contributions,contributions_dot
- real(kind=CUSTOM_REAL):: d
- integer :: ispec,ispecPML,i,j,k,iglob
-
- ! updates local points in PML
- allocate(contributions_dot(NGLOB_AB))
- allocate(contributions(NGLOB_AB))
- contributions_dot(:) = 0._CUSTOM_REAL
- contributions(:) = 0._CUSTOM_REAL
-
- do ispecPML = 1,num_PML_ispec
-
- ispec = PML_ispec(ispecPML)
-
- ! acoustic potentials
- if( ispec_is_acoustic(ispec) ) then
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
-
- ! updates split-potential arrays
- d = PML_damping_d(i,j,k,ispecPML)
-
- call PML_acoustic_time_march_s(chi1(i,j,k,ispecPML),chi2(i,j,k,ispecPML),&
- chi2_t(i,j,k,ispecPML),chi3(i,j,k,ispecPML),chi4(i,j,k,ispecPML), &
- chi1_dot(i,j,k,ispecPML),chi2_t_dot(i,j,k,ispecPML),&
- chi3_dot(i,j,k,ispecPML),chi4_dot(i,j,k,ispecPML), &
- chi1_dot_dot(i,j,k,ispecPML),chi2_t_dot_dot(i,j,k,ispecPML),&
- chi3_dot_dot(i,j,k,ispecPML),chi4_dot_dot(i,j,k,ispecPML), &
- deltat,deltatsqover2,deltatover2,d)
-
- ! adds new contributions
- iglob = ibool(i,j,k,ispec)
- if( iglob_is_PML_interface(iglob) > 0 ) then
- ! on interface points, the time marched global potential from the regular domains applies
- contributions(iglob) = 0._CUSTOM_REAL
- contributions_dot(iglob) = 0._CUSTOM_REAL
- else
- contributions(iglob) = contributions(iglob) &
- + chi1(i,j,k,ispecPML) &
- + chi2(i,j,k,ispecPML) &
- + chi3(i,j,k,ispecPML) &
- + chi4(i,j,k,ispecPML)
-
- contributions_dot(iglob) = contributions_dot(iglob) &
- + chi1_dot(i,j,k,ispecPML) - d*chi1(i,j,k,ispecPML) &
- + chi2_t(i,j,k,ispecPML) - d*chi2(i,j,k,ispecPML) &
- + chi3_dot(i,j,k,ispecPML) - d*chi3(i,j,k,ispecPML) &
- + chi4_dot(i,j,k,ispecPML)
- endif
- enddo
- enddo
- enddo
- endif
- enddo
-
- ! assembles contributions from different MPI processes
- call assemble_MPI_scalar_ext_mesh(NPROC,NGLOB_AB,contributions, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh)
- call assemble_MPI_scalar_ext_mesh(NPROC,NGLOB_AB,contributions_dot, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh)
-
- ! separates contributions from regular domain
- PML_mask_ibool = .false.
-
- !do ispec = 1,NSPEC_AB
- do ispecPML = 1,num_PML_ispec
-
- ispec = PML_ispec(ispecPML)
-
- ! acoustic potentials
- if( ispec_is_acoustic(ispec) ) then
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
-
- if( PML_mask_ibool(iglob) .eqv. .false. ) then
- ! on interface points, leave contribution from regular domain
-
- ! inside PML region, split potentials determine the global acoustic potential
- if( iglob_is_PML_interface(iglob) == 0 ) then
- potential_acoustic(iglob) = contributions(iglob)
- potential_dot_acoustic(iglob) = contributions_dot(iglob)
- endif
-
- PML_mask_ibool(iglob) = .true.
- endif
- enddo
- enddo
- enddo
- endif
- enddo
-
-end subroutine PML_acoustic_time_march
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_acoustic_time_march_s(chi1,chi2,chi2_t,chi3,chi4, &
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot, &
- chi1_dot_dot,chi2_t_dot_dot, &
- chi3_dot_dot,chi4_dot_dot, &
- deltat,deltatsqover2,deltatover2,d)
-
-! time marching scheme
-!
-! note that the value of d changes according to the distance to the boundary,
-! thus instead of updating the whole arrays chi1(:) this scheme updates every given,single value chi1,...
- use constants,only: CUSTOM_REAL
- implicit none
- real(kind=CUSTOM_REAL):: chi1,chi2,chi2_t,chi3,chi4
- real(kind=CUSTOM_REAL):: chi1_dot,chi2_t_dot,chi3_dot,chi4_dot
- real(kind=CUSTOM_REAL):: chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot
- real(kind=CUSTOM_REAL):: deltat,deltatsqover2,deltatover2,d
- !local parameters
- real(kind=CUSTOM_REAL):: fac1,fac2,fac3,fac4
-
- ! pre-computes some factors
- fac1 = 1._CUSTOM_REAL/(1.0_CUSTOM_REAL + deltatover2*d)
- fac2 = 1._CUSTOM_REAL/(d + 1.0_CUSTOM_REAL/deltatover2)
- fac3 = 1._CUSTOM_REAL/(2.0_CUSTOM_REAL + deltat*d)
- fac4 = deltatsqover2*d*d - deltat*d
-
- ! first term: chi1(t+deltat) update
- chi1 = chi1 + deltat*chi1_dot + deltatsqover2*chi1_dot_dot &
- + fac4*chi1 - deltat*deltat*d*chi1_dot
-
- ! chi1_dot predictor
- chi1_dot = fac1 * chi1_dot - d*fac2 * chi1_dot + fac2 * chi1_dot_dot
- chi1_dot_dot = 0._CUSTOM_REAL
-
- ! second term: chi2
- ! note that it uses chi2_t at time ( t )
- chi2 = 2.0*fac3 * chi2 - deltat*d*fac3 * chi2 + deltat*fac3 * chi2_t
-
- ! temporary chi2_t(t+deltat) update
- chi2_t = chi2_t + deltat*chi2_t_dot + deltatsqover2*chi2_t_dot_dot &
- + fac4*chi2_t - deltat*deltat*d*chi2_t_dot
-
- ! chi2 - corrector using updated chi2_t(t+deltat)
- chi2 = chi2 + deltat*fac3 * chi2_t
-
- ! temporary chi2_t_dot - predictor
- chi2_t_dot = fac1 * chi2_t_dot - d*fac2 * chi2_t_dot + fac2 * chi2_t_dot_dot
- chi2_t_dot_dot = 0._CUSTOM_REAL
-
- ! third term: chi3 (t+deltat) update
- chi3 = chi3 + deltat*chi3_dot + deltatsqover2*chi3_dot_dot &
- + fac4*chi3 - deltatsqover2*d*chi3_dot
- chi3_dot = chi3_dot + deltatover2*chi3_dot_dot
- chi3_dot_dot = 0._CUSTOM_REAL
-
- ! fourth term: chi4 (t+deltat) update
- chi4 = chi4 + deltat*chi4_dot + deltatsqover2*chi4_dot_dot
- chi4_dot = chi4_dot + deltatover2*chi4_dot_dot
- chi4_dot_dot = 0._CUSTOM_REAL
-
-end subroutine PML_acoustic_time_march_s
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_acoustic_time_corrector(NSPEC_AB,ispec_is_acoustic,deltatover2,&
- num_PML_ispec,PML_ispec,PML_damping_d,&
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot,&
- chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot)
-
-! time marching scheme - updates with corrector terms
-!
-! note that the value of d changes according to the distance to the boundary,
-! thus instead of updating the whole arrays chi1(:) this scheme updates every given,single value chi1,...
-
- use constants,only: NGLLX,NGLLY,NGLLZ,CUSTOM_REAL
- implicit none
-
- ! split-potentials
- integer :: num_PML_ispec
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: PML_damping_d
-
- integer,dimension(num_PML_ispec):: PML_ispec
-
- real(kind=CUSTOM_REAL):: deltatover2
-
- integer :: NSPEC_AB
- logical, dimension(NSPEC_AB) :: ispec_is_acoustic
-
- !local parameters
- real(kind=CUSTOM_REAL):: d
- integer :: ispec,ispecPML,i,j,k
-
- ! updates "velocity" potentials in PML with corrector terms
- do ispecPML = 1,num_PML_ispec
-
- ispec = PML_ispec(ispecPML)
-
- ! acoustic potentials
- if( ispec_is_acoustic(ispec) ) then
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
-
- ! time marches chi_dot,.. potentials
- d = PML_damping_d(i,j,k,ispecPML)
-
- call PML_acoustic_time_corrector_s(chi1_dot(i,j,k,ispecPML),chi2_t_dot(i,j,k,ispecPML), &
- chi3_dot(i,j,k,ispecPML),chi4_dot(i,j,k,ispecPML), &
- chi1_dot_dot(i,j,k,ispecPML),chi2_t_dot_dot(i,j,k,ispecPML), &
- chi3_dot_dot(i,j,k,ispecPML),chi4_dot_dot(i,j,k,ispecPML), &
- deltatover2,d)
- enddo
- enddo
- enddo
- endif
- enddo
-
-
-end subroutine PML_acoustic_time_corrector
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_acoustic_time_corrector_s(chi1_dot,chi2_t_dot,chi3_dot,chi4_dot, &
- chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot, &
- deltatover2,d)
-
-! time marching scheme - updates with corrector terms
-!
-! note that the value of d changes according to the distance to the boundary,
-! thus instead of updating the whole arrays chi1(:) this scheme updates every given,single value chi1,...
- use constants,only: CUSTOM_REAL
- implicit none
- real(kind=CUSTOM_REAL):: chi1_dot,chi2_t_dot,chi3_dot,chi4_dot
- real(kind=CUSTOM_REAL):: chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot
- real(kind=CUSTOM_REAL):: deltatover2,d
- real(kind=CUSTOM_REAL):: fac1
-
- fac1 = 1.0_CUSTOM_REAL/(d + 1.0_CUSTOM_REAL/deltatover2)
-
- ! first term:
- chi1_dot = chi1_dot + fac1*chi1_dot_dot
-
- ! second term:
- chi2_t_dot = chi2_t_dot + fac1*chi2_t_dot_dot
-
- ! third term:
- chi3_dot = chi3_dot + deltatover2*chi3_dot_dot
-
- ! fourth term:
- chi4_dot = chi4_dot + deltatover2*chi4_dot_dot
-
-end subroutine PML_acoustic_time_corrector_s
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine PML_acoustic_enforce_free_srfc(NSPEC_AB,NGLOB_AB, &
- potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic, &
- ibool,free_surface_ijk,free_surface_ispec, &
- num_free_surface_faces, &
- ispec_is_acoustic, &
- num_PML_ispec,PML_ispec,&
- chi1,chi2,chi2_t,chi3,chi4,&
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot,&
- chi1_dot_dot,chi2_t_dot_dot,&
- chi3_dot_dot,chi4_dot_dot)
-
- use constants,only: NGLLX,NGLLY,NGLLZ,NGLLSQUARE,CUSTOM_REAL
- implicit none
-
- integer :: NSPEC_AB,NGLOB_AB
-
- ! split-potentials
- integer :: num_PML_ispec
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1,chi2,chi2_t,chi3,chi4
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1_dot_dot,chi2_t_dot_dot,chi3_dot_dot,chi4_dot_dot
- integer,dimension(num_PML_ispec):: PML_ispec
-
- ! acoustic potentials
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: &
- potential_acoustic,potential_dot_acoustic,potential_dot_dot_acoustic
-
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
- ! free surface
- integer :: num_free_surface_faces
- integer :: free_surface_ijk(3,NGLLSQUARE,num_free_surface_faces)
- integer :: free_surface_ispec(num_free_surface_faces)
-
- logical, dimension(NSPEC_AB) :: ispec_is_acoustic
-
-! local parameters
- integer :: iface,igll,i,j,k,ispec,iglob,ispecPML
-
- ! enforce potentials to be zero at surface
- do iface = 1, num_free_surface_faces
-
- ispec = free_surface_ispec(iface)
-
- if( ispec_is_acoustic(ispec) ) then
-
- do ispecPML=1,num_PML_ispec
- if( PML_ispec(ispecPML) == ispec ) then
-
- do igll = 1, NGLLSQUARE
- i = free_surface_ijk(1,igll,iface)
- j = free_surface_ijk(2,igll,iface)
- k = free_surface_ijk(3,igll,iface)
- iglob = ibool(i,j,k,ispec)
-
- ! sets potentials to zero
- potential_acoustic(iglob) = 0._CUSTOM_REAL
- potential_dot_acoustic(iglob) = 0._CUSTOM_REAL
- potential_dot_dot_acoustic(iglob) = 0._CUSTOM_REAL
-
- ! sets PML potentials to zero
- chi1(i,j,k,ispecPML) = 0._CUSTOM_REAL
- chi1_dot(i,j,k,ispecPML) = 0._CUSTOM_REAL
- chi1_dot_dot(i,j,k,ispecPML) = 0._CUSTOM_REAL
-
- chi2(i,j,k,ispecPML) = 0._CUSTOM_REAL
- chi2_t(i,j,k,ispecPML) = 0._CUSTOM_REAL
- chi2_t_dot(i,j,k,ispecPML) = 0._CUSTOM_REAL
- chi2_t_dot_dot(i,j,k,ispecPML) = 0._CUSTOM_REAL
-
- chi3(i,j,k,ispecPML) = 0._CUSTOM_REAL
- chi3_dot(i,j,k,ispecPML) = 0._CUSTOM_REAL
- chi3_dot_dot(i,j,k,ispecPML) = 0._CUSTOM_REAL
-
- chi4(i,j,k,ispecPML) = 0._CUSTOM_REAL
- chi4_dot(i,j,k,ispecPML) = 0._CUSTOM_REAL
- chi4_dot_dot(i,j,k,ispecPML) = 0._CUSTOM_REAL
- enddo
- endif
- enddo
- endif
-
- enddo
-
-end subroutine PML_acoustic_enforce_free_srfc
-
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-
-subroutine PML_acoustic_update_potentials(NGLOB_AB,NSPEC_AB, &
- ibool,ispec_is_acoustic, &
- potential_dot_acoustic,potential_dot_dot_acoustic,&
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh,NPROC,&
- num_PML_ispec,PML_ispec,iglob_is_PML_interface,&
- PML_mask_ibool,PML_damping_d,&
- chi1,chi2,chi2_t,chi3,&
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot,&
- chi1_dot_dot,chi3_dot_dot,chi4_dot_dot)
-
-! updates potential_dot_acoustic and potential_dot_dot_acoustic inside PML region
-
- use constants,only: NGLLX,NGLLY,NGLLZ,CUSTOM_REAL
- implicit none
-
- integer :: NGLOB_AB,NSPEC_AB
-
- ! split-potentials
- integer :: num_PML_ispec
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1,chi2,chi2_t,chi3
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1_dot,chi2_t_dot,chi3_dot,chi4_dot
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- chi1_dot_dot,chi3_dot_dot,chi4_dot_dot
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,num_PML_ispec):: &
- PML_damping_d
- integer,dimension(num_PML_ispec):: PML_ispec
- integer,dimension(NGLOB_AB):: iglob_is_PML_interface
- logical,dimension(NGLOB_AB):: PML_mask_ibool
-
-
- ! potentials
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_acoustic
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_dot_acoustic
-
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
- logical, dimension(NSPEC_AB) :: ispec_is_acoustic
-
- ! MPI communication
- integer :: NPROC
- integer :: num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: nibool_interfaces_ext_mesh,my_neighbours_ext_mesh
- integer, dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: ibool_interfaces_ext_mesh
-
- !local parameters
- real(kind=CUSTOM_REAL),dimension(:),allocatable :: contributions_dot_dot,contributions_dot
- real(kind=CUSTOM_REAL):: d
- integer :: ispec,ispecPML,i,j,k,iglob
-
- allocate(contributions_dot_dot(NGLOB_AB),contributions_dot(NGLOB_AB))
- contributions_dot_dot = 0._CUSTOM_REAL
- contributions_dot = 0._CUSTOM_REAL
-
- ! updates the potential_dot & potential_dot_dot_acoustic array inside the PML
- do ispecPML = 1,num_PML_ispec
-
- ispec = PML_ispec(ispecPML)
-
- ! acoustic potentials
- if( ispec_is_acoustic(ispec) ) then
-
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
-
- ! for points inside PML region
- if( iglob_is_PML_interface(iglob) == 0 ) then
-
- ! damping coefficient
- d = PML_damping_d(i,j,k,ispecPML)
-
- ! inside PML region: at this stage, this is only needed for seismogram/plotting output
- ! afterwards potential_dot_dot, resp. chi1_dot_dot,.. get reset to zero
-
- ! potential_dot: note that we defined
- ! chi1_dot = (\partial_t + d) chi1
- ! chi2_t = (\partial_t + d) chi2
- ! chi3_dot = (\partial_t + d) chi3
- ! chi4_dot = \partial_t chi4
- ! where \partial_t is the time derivative, thus \partial_t (chi1+chi2+chi3+chi4) equals
- contributions_dot(iglob) = contributions_dot(iglob) &
- + chi1_dot(i,j,k,ispecPML) - d*chi1(i,j,k,ispecPML) &
- + chi2_t(i,j,k,ispecPML) - d*chi2(i,j,k,ispecPML) &
- + chi3_dot(i,j,k,ispecPML) - d*chi3(i,j,k,ispecPML) &
- + chi4_dot(i,j,k,ispecPML)
-
- ! potential_dot_dot: note that we defined
- ! chi1_dot_dot = (\partial_t + d)**2 chi1
- ! chi2_t_dot = (\partial_t + d)**2 chi2
- ! chi3_dot = \partial_t (\partial_t + d) chi3
- ! chi4_dot = \partial_t**2 chi4
- ! where \partial_t is the time derivative, thus \partial_t**2 (chi1+chi2+chi3+chi4) equals
- contributions_dot_dot(iglob) = contributions_dot_dot(iglob) &
- + chi1_dot_dot(i,j,k,ispecPML) - 2.0*d*chi1_dot(i,j,k,ispecPML) + d*d*chi1(i,j,k,ispecPML) &
- + chi2_t_dot(i,j,k,ispecPML) - 2.0*d*chi2_t(i,j,k,ispecPML) + d*d*chi2(i,j,k,ispecPML) &
- + chi3_dot_dot(i,j,k,ispecPML) - d*chi3_dot(i,j,k,ispecPML) + d*d*chi3(i,j,k,ispecPML) &
- + chi4_dot_dot(i,j,k,ispecPML)
-
- endif
-
- enddo
- enddo
- enddo
- endif
- enddo
-
- ! assembles contributions from different MPI processes
- call assemble_MPI_scalar_ext_mesh(NPROC,NGLOB_AB,contributions_dot, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh)
- call assemble_MPI_scalar_ext_mesh(NPROC,NGLOB_AB,contributions_dot_dot, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh)
-
- ! updates the potential_dot & potential_dot_dot_acoustic array inside the PML
- PML_mask_ibool = .false.
- do ispecPML = 1,num_PML_ispec
-
- ispec = PML_ispec(ispecPML)
-
- ! acoustic potentials
- if( ispec_is_acoustic(ispec) ) then
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
-
- if( PML_mask_ibool(iglob) .eqv. .false. ) then
- ! for points inside PML region
- if( iglob_is_PML_interface(iglob) == 0 ) then
- potential_dot_acoustic(iglob) = contributions_dot(iglob)
- potential_dot_dot_acoustic(iglob) = contributions_dot(iglob)
- endif
- PML_mask_ibool(iglob) = .true.
- endif
- enddo
- enddo
- enddo
- endif
- enddo
-
-end subroutine PML_acoustic_update_potentials
-
Deleted: seismo/3D/SPECFEM3D/trunk/compute_forces_acoustic_pot.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_forces_acoustic_pot.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_forces_acoustic_pot.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,203 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-! for acoustic solver
-
- subroutine compute_forces_acoustic_pot( iphase, NSPEC_AB,NGLOB_AB, &
- potential_acoustic,potential_dot_dot_acoustic, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
- hprime_xx,hprime_yy,hprime_zz, &
- hprimewgll_xx,hprimewgll_yy,hprimewgll_zz, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- rhostore,jacobian,ibool, &
- num_phase_ispec_acoustic,nspec_inner_acoustic,nspec_outer_acoustic,&
- phase_ispec_inner_acoustic )
-
-! computes forces for acoustic elements
-!
-! note that pressure is defined as:
-! p = - Chi_dot_dot
-!
- use constants,only: CUSTOM_REAL,NGLLX,NGLLY,NGLLZ,TINYVAL_SNGL
- use PML_par,only:PML,ispec_is_PML_inum
- implicit none
- !include "constants.h"
- integer :: NSPEC_AB,NGLOB_AB
-
-! acoustic potentials
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: &
- potential_acoustic,potential_dot_dot_acoustic
-
-! arrays with mesh parameters per slice
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: &
- rhostore,jacobian
-
-! array with derivatives of Lagrange polynomials and precalculated products
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx,hprimewgll_xx
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLY) :: hprime_yy,hprimewgll_yy
- real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz,hprimewgll_zz
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY) :: wgllwgll_xy
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ) :: wgllwgll_xz
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ) :: wgllwgll_yz
-
-! communication overlap
-! logical, dimension(NSPEC_AB) :: ispec_is_inner
-! logical :: phase_is_inner
-
-! logical, dimension(NSPEC_AB) :: ispec_is_acoustic
-
- integer :: iphase
- integer :: num_phase_ispec_acoustic,nspec_inner_acoustic,nspec_outer_acoustic
- integer, dimension(num_phase_ispec_acoustic,2) :: phase_ispec_inner_acoustic
-
-! local variables
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: chi_elem
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: temp1,temp2,temp3
- real(kind=CUSTOM_REAL) temp1l,temp2l,temp3l
-
- real(kind=CUSTOM_REAL) xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl,jacobianl
- real(kind=CUSTOM_REAL) dpotentialdxl,dpotentialdyl,dpotentialdzl
- real(kind=CUSTOM_REAL) rho_invl
-
- integer :: ispec,iglob,i,j,k,l,ispec_p,num_elements
-
- if( iphase == 1 ) then
- num_elements = nspec_outer_acoustic
- else
- num_elements = nspec_inner_acoustic
- endif
-
-! loop over spectral elements
- do ispec_p = 1,num_elements
-
- !if ( (ispec_is_inner(ispec) .eqv. phase_is_inner) ) then
-
- ispec = phase_ispec_inner_acoustic(ispec_p,iphase)
-
- ! only elements outside PML, inside "regular" domain
- if( PML ) then
- if( ispec_is_PML_inum(ispec) > 0 ) then
- cycle
- endif
- endif
-
-! if( ispec_is_acoustic(ispec) ) then
-
- ! gets values for element
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- chi_elem(i,j,k) = potential_acoustic(ibool(i,j,k,ispec))
- enddo
- enddo
- enddo
- ! would check if anything to do, but might lower accuracy of computation
- !if( maxval( abs( chi_elem ) ) < TINYVAL_SNGL ) cycle
-
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
-
- ! density (reciproc)
- rho_invl = 1.0_CUSTOM_REAL / rhostore(i,j,k,ispec)
-
- ! derivative along x, y, z
- ! first double loop over GLL points to compute and store gradients
- ! we can merge the loops because NGLLX == NGLLY == NGLLZ
- temp1l = 0._CUSTOM_REAL
- temp2l = 0._CUSTOM_REAL
- temp3l = 0._CUSTOM_REAL
- do l = 1,NGLLX
- temp1l = temp1l + chi_elem(l,j,k)*hprime_xx(i,l)
- temp2l = temp2l + chi_elem(i,l,k)*hprime_yy(j,l)
- temp3l = temp3l + chi_elem(i,j,l)*hprime_zz(k,l)
- enddo
-
- ! get derivatives of potential with respect to x, y and z
- xixl = xix(i,j,k,ispec)
- xiyl = xiy(i,j,k,ispec)
- xizl = xiz(i,j,k,ispec)
- etaxl = etax(i,j,k,ispec)
- etayl = etay(i,j,k,ispec)
- etazl = etaz(i,j,k,ispec)
- gammaxl = gammax(i,j,k,ispec)
- gammayl = gammay(i,j,k,ispec)
- gammazl = gammaz(i,j,k,ispec)
- jacobianl = jacobian(i,j,k,ispec)
-
- ! derivatives of potential
- dpotentialdxl = xixl*temp1l + etaxl*temp2l + gammaxl*temp3l
- dpotentialdyl = xiyl*temp1l + etayl*temp2l + gammayl*temp3l
- dpotentialdzl = xizl*temp1l + etazl*temp2l + gammazl*temp3l
-
- ! for acoustic medium
- ! also add GLL integration weights
- temp1(i,j,k) = rho_invl * wgllwgll_yz(j,k) * jacobianl* &
- (xixl*dpotentialdxl + xiyl*dpotentialdyl + xizl*dpotentialdzl)
- temp2(i,j,k) = rho_invl * wgllwgll_xz(i,k) * jacobianl* &
- (etaxl*dpotentialdxl + etayl*dpotentialdyl + etazl*dpotentialdzl)
- temp3(i,j,k) = rho_invl * wgllwgll_xy(i,j) * jacobianl* &
- (gammaxl*dpotentialdxl + gammayl*dpotentialdyl + gammazl*dpotentialdzl)
- enddo
- enddo
- enddo
-
- ! second double-loop over GLL to compute all the terms
- do k = 1,NGLLZ
- do j = 1,NGLLZ
- do i = 1,NGLLX
-
- ! along x,y,z direction
- ! and assemble the contributions
- !!! can merge these loops because NGLLX = NGLLY = NGLLZ
- temp1l = 0._CUSTOM_REAL
- temp2l = 0._CUSTOM_REAL
- temp3l = 0._CUSTOM_REAL
- do l=1,NGLLX
- temp1l = temp1l + temp1(l,j,k) * hprimewgll_xx(l,i)
- temp2l = temp2l + temp2(i,l,k) * hprimewgll_yy(l,j)
- temp3l = temp3l + temp3(i,j,l) * hprimewgll_zz(l,k)
- enddo
-
- ! sum contributions from each element to the global values
- iglob = ibool(i,j,k,ispec)
- potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) &
- - ( temp1l + temp2l + temp3l )
-
- enddo
- enddo
- enddo
-
-! endif ! end of test if acoustic element
-! endif ! ispec_is_inner
-
- enddo ! end of loop over all spectral elements
-
- end subroutine compute_forces_acoustic_pot
-
Deleted: seismo/3D/SPECFEM3D/trunk/compute_forces_elastic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_forces_elastic.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_forces_elastic.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,414 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-! elastic solver
-
-subroutine compute_forces_elastic()
-
- use specfem_par
- use specfem_par_acoustic
- use specfem_par_elastic
- use specfem_par_poroelastic
-
- implicit none
-
- integer:: iphase
- logical:: phase_is_inner
-
-! distinguishes two runs: for points on MPI interfaces, and points within the partitions
- do iphase=1,2
-
- !first for points on MPI interfaces
- if( iphase == 1 ) then
- phase_is_inner = .false.
- else
- phase_is_inner = .true.
- endif
-
-! elastic term
- if(USE_DEVILLE_PRODUCTS) then
- call compute_forces_elastic_Dev(iphase, NSPEC_AB,NGLOB_AB,displ,accel, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
- hprime_xx,hprime_xxT,hprimewgll_xx,hprimewgll_xxT, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- kappastore,mustore,jacobian,ibool, &
- ATTENUATION,USE_OLSEN_ATTENUATION, &
- one_minus_sum_beta,factor_common, &
- alphaval,betaval,gammaval, &
- NSPEC_ATTENUATION_AB, &
- R_xx,R_yy,R_xy,R_xz,R_yz, &
- epsilondev_xx,epsilondev_yy,epsilondev_xy, &
- epsilondev_xz,epsilondev_yz,epsilon_trace_over_3, &
- iflag_attenuation_store, &
- rho_vs,ANISOTROPY,NSPEC_ANISO, &
- c11store,c12store,c13store,c14store,c15store,c16store,&
- c22store,c23store,c24store,c25store,c26store,c33store,&
- c34store,c35store,c36store,c44store,c45store,c46store,&
- c55store,c56store,c66store, &
- SIMULATION_TYPE, COMPUTE_AND_STORE_STRAIN,NSPEC_STRAIN_ONLY, &
- NSPEC_BOUN,NSPEC2D_MOHO,NSPEC_ADJOINT,&
- is_moho_top,is_moho_bot, &
- dsdx_top,dsdx_bot, &
- ispec2D_moho_top,ispec2D_moho_bot, &
- num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic,&
- phase_ispec_inner_elastic )
- else
- call compute_forces_elastic_noDev( iphase, NSPEC_AB,NGLOB_AB,displ,accel, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
- hprime_xx,hprime_yy,hprime_zz, &
- hprimewgll_xx,hprimewgll_yy,hprimewgll_zz,&
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- kappastore,mustore,jacobian,ibool, &
- ATTENUATION,USE_OLSEN_ATTENUATION,&
- one_minus_sum_beta,factor_common, &
- alphaval,betaval,gammaval,&
- NSPEC_ATTENUATION_AB, &
- R_xx,R_yy,R_xy,R_xz,R_yz, &
- epsilondev_xx,epsilondev_yy,epsilondev_xy,&
- epsilondev_xz,epsilondev_yz,epsilon_trace_over_3, &
- iflag_attenuation_store,&
- rho_vs,ANISOTROPY,NSPEC_ANISO, &
- c11store,c12store,c13store,c14store,c15store,c16store,&
- c22store,c23store,c24store,c25store,c26store,c33store,&
- c34store,c35store,c36store,c44store,c45store,c46store,&
- c55store,c56store,c66store, &
- SIMULATION_TYPE,COMPUTE_AND_STORE_STRAIN,NSPEC_STRAIN_ONLY, &
- NSPEC_BOUN,NSPEC2D_MOHO,NSPEC_ADJOINT,&
- is_moho_top,is_moho_bot, &
- dsdx_top,dsdx_bot, &
- ispec2D_moho_top,ispec2D_moho_bot, &
- num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic,&
- phase_ispec_inner_elastic )
- endif
-
- ! adjoint simulations: backward/reconstructed wavefield
- if( SIMULATION_TYPE == 3 ) then
- if(USE_DEVILLE_PRODUCTS) then
- call compute_forces_elastic_Dev(iphase, NSPEC_AB,NGLOB_AB, &
- b_displ,b_accel, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
- hprime_xx,hprime_xxT,hprimewgll_xx,hprimewgll_xxT, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- kappastore,mustore,jacobian,ibool, &
- ATTENUATION,USE_OLSEN_ATTENUATION, &
- one_minus_sum_beta,factor_common, &
- b_alphaval,b_betaval,b_gammaval, &
- NSPEC_ATTENUATION_AB, &
- b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz, &
- b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy, &
- b_epsilondev_xz,b_epsilondev_yz,b_epsilon_trace_over_3, &
- iflag_attenuation_store, &
- rho_vs,ANISOTROPY,NSPEC_ANISO, &
- c11store,c12store,c13store,c14store,c15store,c16store,&
- c22store,c23store,c24store,c25store,c26store,c33store,&
- c34store,c35store,c36store,c44store,c45store,c46store,&
- c55store,c56store,c66store, &
- SIMULATION_TYPE, COMPUTE_AND_STORE_STRAIN,NSPEC_STRAIN_ONLY,&
- NSPEC_BOUN,NSPEC2D_MOHO,NSPEC_ADJOINT,&
- is_moho_top,is_moho_bot, &
- b_dsdx_top,b_dsdx_bot, &
- ispec2D_moho_top,ispec2D_moho_bot, &
- num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic,&
- phase_ispec_inner_elastic )
- else
- call compute_forces_elastic_noDev( iphase, NSPEC_AB,NGLOB_AB,&
- b_displ,b_accel, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
- hprime_xx,hprime_yy,hprime_zz, &
- hprimewgll_xx,hprimewgll_yy,hprimewgll_zz,&
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- kappastore,mustore,jacobian,ibool, &
- ATTENUATION,USE_OLSEN_ATTENUATION,&
- one_minus_sum_beta,factor_common, &
- b_alphaval,b_betaval,b_gammaval,&
- NSPEC_ATTENUATION_AB, &
- b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz, &
- b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy,&
- b_epsilondev_xz,b_epsilondev_yz,b_epsilon_trace_over_3, &
- iflag_attenuation_store,&
- rho_vs,ANISOTROPY,NSPEC_ANISO, &
- c11store,c12store,c13store,c14store,c15store,c16store,&
- c22store,c23store,c24store,c25store,c26store,c33store,&
- c34store,c35store,c36store,c44store,c45store,c46store,&
- c55store,c56store,c66store, &
- SIMULATION_TYPE,COMPUTE_AND_STORE_STRAIN,NSPEC_STRAIN_ONLY, &
- NSPEC_BOUN,NSPEC2D_MOHO,NSPEC_ADJOINT,&
- is_moho_top,is_moho_bot, &
- b_dsdx_top,b_dsdx_bot, &
- ispec2D_moho_top,ispec2D_moho_bot, &
- num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic,&
- phase_ispec_inner_elastic )
-
- endif
- endif
-
-
-
-! adds elastic absorbing boundary term to acceleration (Stacey conditions)
- if(ABSORBING_CONDITIONS) &
- call compute_stacey_elastic(NSPEC_AB,NGLOB_AB,accel, &
- ibool,ispec_is_inner,phase_is_inner, &
- abs_boundary_normal,abs_boundary_jacobian2Dw, &
- abs_boundary_ijk,abs_boundary_ispec, &
- num_abs_boundary_faces, &
- veloc,rho_vp,rho_vs, &
- ispec_is_elastic,SIMULATION_TYPE,myrank,SAVE_FORWARD, &
- NSTEP,it,NGLOB_ADJOINT,b_accel, &
- b_num_abs_boundary_faces,b_reclen_field,b_absorb_field )
-
-! acoustic coupling
- if( ACOUSTIC_SIMULATION ) then
- call compute_coupling_elastic_ac(NSPEC_AB,NGLOB_AB, &
- ibool,accel,potential_dot_dot_acoustic, &
- num_coupling_ac_el_faces, &
- coupling_ac_el_ispec,coupling_ac_el_ijk, &
- coupling_ac_el_normal, &
- coupling_ac_el_jacobian2Dw, &
- ispec_is_inner,phase_is_inner)
-
- ! adjoint simulations
- if( SIMULATION_TYPE == 3 ) &
- call compute_coupling_elastic_ac(NSPEC_ADJOINT,NGLOB_ADJOINT, &
- ibool,b_accel,b_potential_dot_dot_acoustic, &
- num_coupling_ac_el_faces, &
- coupling_ac_el_ispec,coupling_ac_el_ijk, &
- coupling_ac_el_normal, &
- coupling_ac_el_jacobian2Dw, &
- ispec_is_inner,phase_is_inner)
- endif
-
-
-! poroelastic coupling
-! not implemented yet
-! if( POROELASTIC_SIMULATION ) &
-! call compute_coupling_elastic_poro()
-
-! adds source term (single-force/moment-tensor solution)
- call compute_add_sources_elastic( NSPEC_AB,NGLOB_AB,accel, &
- ibool,ispec_is_inner,phase_is_inner, &
- NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
- xi_source,eta_source,gamma_source,nu_source, &
- hdur,hdur_gaussian,t_cmt,dt,t0,sourcearrays, &
- ispec_is_elastic,SIMULATION_TYPE,NSTEP,NGLOB_ADJOINT, &
- nrec,islice_selected_rec,ispec_selected_rec, &
- nadj_rec_local,adj_sourcearrays,b_accel, &
- NTSTEP_BETWEEN_READ_ADJSRC )
-
-! assemble all the contributions between slices using MPI
- if( phase_is_inner .eqv. .false. ) then
- ! sends accel values to corresponding MPI interface neighbors
- call assemble_MPI_vector_ext_mesh_s(NPROC,NGLOB_AB,accel, &
- buffer_send_vector_ext_mesh,buffer_recv_vector_ext_mesh, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh, &
- request_send_vector_ext_mesh,request_recv_vector_ext_mesh)
-
- ! adjoint simulations
- if( SIMULATION_TYPE == 3 ) then
- call assemble_MPI_vector_ext_mesh_s(NPROC,NGLOB_ADJOINT,b_accel, &
- b_buffer_send_vector_ext_mesh,b_buffer_recv_vector_ext_mesh, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- my_neighbours_ext_mesh, &
- b_request_send_vector_ext_mesh,b_request_recv_vector_ext_mesh)
- endif !adjoint
-
- else
- ! waits for send/receive requests to be completed and assembles values
- call assemble_MPI_vector_ext_mesh_w(NPROC,NGLOB_AB,accel, &
- buffer_recv_vector_ext_mesh,num_interfaces_ext_mesh,&
- max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- request_send_vector_ext_mesh,request_recv_vector_ext_mesh)
-
- ! adjoint simulations
- if( SIMULATION_TYPE == 3 ) then
- call assemble_MPI_vector_ext_mesh_w(NPROC,NGLOB_ADJOINT,b_accel, &
- b_buffer_recv_vector_ext_mesh,num_interfaces_ext_mesh,&
- max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- b_request_send_vector_ext_mesh,b_request_recv_vector_ext_mesh)
- endif !adjoint
-
- endif
-
- !! DK DK May 2009: removed this because now each slice of a CUBIT + SCOTCH mesh
- !! DK DK May 2009: has a different number of spectral elements and therefore
- !! DK DK May 2009: only the general non-blocking MPI routines assemble_MPI_vector_ext_mesh_s
- !! DK DK May 2009: and assemble_MPI_vector_ext_mesh_w above can be used.
- !! DK DK May 2009: For adjoint runs below (SIMULATION_TYPE == 3) they should be used as well.
-
- enddo
-
-! multiplies with inverse of mass matrix (note: rmass has been inverted already)
- accel(1,:) = accel(1,:)*rmass(:)
- accel(2,:) = accel(2,:)*rmass(:)
- accel(3,:) = accel(3,:)*rmass(:)
-
- ! adjoint simulations
- if (SIMULATION_TYPE == 3) then
- b_accel(1,:) = b_accel(1,:)*rmass(:)
- b_accel(2,:) = b_accel(2,:)*rmass(:)
- b_accel(3,:) = b_accel(3,:)*rmass(:)
- endif !adjoint
-
-
-! updates acceleration with ocean load term
- if(OCEANS) then
- call elastic_ocean_load(NSPEC_AB,NGLOB_AB, &
- ibool,rmass,rmass_ocean_load,accel, &
- free_surface_normal,free_surface_ijk,free_surface_ispec, &
- num_free_surface_faces,SIMULATION_TYPE, &
- NGLOB_ADJOINT,b_accel)
- endif
-
-! updates velocities
-! Newark finite-difference time scheme with elastic domains:
-! (see e.g. Hughes, 1987; Chaljub et al., 2003)
-!
-! u(t+delta_t) = u(t) + delta_t v(t) + 1/2 delta_t**2 a(t)
-! v(t+delta_t) = v(t) + 1/2 delta_t a(t) + 1/2 delta_t a(t+delta_t)
-! a(t+delta_t) = 1/M_elastic ( -K_elastic u(t+delta) + B_elastic chi_dot_dot(t+delta_t) + f( t+delta_t) )
-!
-! where
-! u, v, a are displacement,velocity & acceleration
-! M is mass matrix, K stiffness matrix and B boundary term for acoustic/elastic domains
-! f denotes a source term (acoustic/elastic)
-! chi_dot_dot is acoustic (fluid) potential ( dotted twice with respect to time)
-!
-! corrector:
-! updates the velocity term which requires a(t+delta)
- veloc(:,:) = veloc(:,:) + deltatover2*accel(:,:)
-
- ! adjoint simulations
- if (SIMULATION_TYPE == 3) b_veloc(:,:) = b_veloc(:,:) + b_deltatover2*b_accel(:,:)
-
-
-end subroutine compute_forces_elastic
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine elastic_ocean_load(NSPEC_AB,NGLOB_AB, &
- ibool,rmass,rmass_ocean_load,accel, &
- free_surface_normal,free_surface_ijk,free_surface_ispec, &
- num_free_surface_faces,SIMULATION_TYPE, &
- NGLOB_ADJOINT,b_accel)
-
-! updates acceleration with ocean load term:
-! approximates ocean-bottom continuity of pressure & displacement for longer period waves (> ~20s ),
-! assuming incompressible fluid column above bathymetry ocean bottom
-
- implicit none
-
- include 'constants.h'
-
- integer :: NSPEC_AB,NGLOB_AB
-
- real(kind=CUSTOM_REAL),dimension(NDIM,NGLOB_AB),intent(inout) :: accel
- real(kind=CUSTOM_REAL),dimension(NGLOB_AB),intent(in) :: rmass,rmass_ocean_load
-
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB),intent(in) :: ibool
-
- ! free surface
- integer :: num_free_surface_faces
- real(kind=CUSTOM_REAL) :: free_surface_normal(NDIM,NGLLSQUARE,num_free_surface_faces)
- integer :: free_surface_ijk(3,NGLLSQUARE,num_free_surface_faces)
- integer :: free_surface_ispec(num_free_surface_faces)
-
- ! adjoint simulations
- integer :: SIMULATION_TYPE,NGLOB_ADJOINT
- real(kind=CUSTOM_REAL),dimension(NDIM,NGLOB_ADJOINT):: b_accel
-
-! local parameters
- real(kind=CUSTOM_REAL) :: nx,ny,nz
- real(kind=CUSTOM_REAL) :: additional_term,force_normal_comp
- integer :: i,j,k,ispec,iglob
- integer :: igll,iface
- logical,dimension(NGLOB_AB) :: updated_dof_ocean_load
- ! adjoint locals
- real(kind=CUSTOM_REAL) :: b_additional_term,b_force_normal_comp
-
- ! initialize the updates
- updated_dof_ocean_load(:) = .false.
-
- ! for surface elements exactly at the top of the model (ocean bottom)
- do iface = 1,num_free_surface_faces
-
- ispec = free_surface_ispec(iface)
- do igll = 1, NGLLSQUARE
- i = free_surface_ijk(1,igll,iface)
- j = free_surface_ijk(2,igll,iface)
- k = free_surface_ijk(3,igll,iface)
-
- ! get global point number
- iglob = ibool(i,j,k,ispec)
-
- ! only update once
- if(.not. updated_dof_ocean_load(iglob)) then
-
- ! get normal
- nx = free_surface_normal(1,igll,iface)
- ny = free_surface_normal(2,igll,iface)
- nz = free_surface_normal(3,igll,iface)
-
- ! make updated component of right-hand side
- ! we divide by rmass() which is 1 / M
- ! we use the total force which includes the Coriolis term above
- force_normal_comp = ( accel(1,iglob)*nx + &
- accel(2,iglob)*ny + &
- accel(3,iglob)*nz ) / rmass(iglob)
-
- additional_term = (rmass_ocean_load(iglob) - rmass(iglob)) * force_normal_comp
-
- accel(1,iglob) = accel(1,iglob) + additional_term * nx
- accel(2,iglob) = accel(2,iglob) + additional_term * ny
- accel(3,iglob) = accel(3,iglob) + additional_term * nz
-
- ! adjoint simulations
- if (SIMULATION_TYPE == 3) then
- b_force_normal_comp = ( b_accel(1,iglob)*nx + &
- b_accel(2,iglob)*ny + &
- b_accel(3,iglob)*nz) / rmass(iglob)
- b_additional_term = (rmass_ocean_load(iglob) - rmass(iglob)) * b_force_normal_comp
-
- b_accel(1,iglob) = b_accel(1,iglob) + b_additional_term * nx
- b_accel(2,iglob) = b_accel(2,iglob) + b_additional_term * ny
- b_accel(3,iglob) = b_accel(3,iglob) + b_additional_term * nz
- endif !adjoint
-
- ! done with this point
- updated_dof_ocean_load(iglob) = .true.
-
- endif
-
- enddo ! igll
- enddo ! iface
-
-end subroutine elastic_ocean_load
-
Deleted: seismo/3D/SPECFEM3D/trunk/compute_forces_elastic_Dev.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_forces_elastic_Dev.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_forces_elastic_Dev.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,622 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-
-subroutine compute_forces_elastic_Dev( iphase ,NSPEC_AB,NGLOB_AB, &
- displ,accel, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
- hprime_xx,hprime_xxT, &
- hprimewgll_xx,hprimewgll_xxT, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- kappastore,mustore,jacobian,ibool, &
- ATTENUATION,USE_OLSEN_ATTENUATION, &
- one_minus_sum_beta,factor_common,alphaval,betaval,gammaval,&
- NSPEC_ATTENUATION_AB, &
- R_xx,R_yy,R_xy,R_xz,R_yz, &
- epsilondev_xx,epsilondev_yy,epsilondev_xy, &
- epsilondev_xz,epsilondev_yz,epsilon_trace_over_3, &
- iflag_attenuation_store,rho_vs, &
- ANISOTROPY,NSPEC_ANISO, &
- c11store,c12store,c13store,c14store,c15store,c16store,&
- c22store,c23store,c24store,c25store,c26store,c33store,&
- c34store,c35store,c36store,c44store,c45store,c46store,&
- c55store,c56store,c66store, &
- SIMULATION_TYPE,COMPUTE_AND_STORE_STRAIN,NSPEC_STRAIN_ONLY, &
- NSPEC_BOUN,NSPEC2D_MOHO,NSPEC_ADJOINT, &
- is_moho_top,is_moho_bot, &
- dsdx_top,dsdx_bot, &
- ispec2D_moho_top,ispec2D_moho_bot, &
- num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic,&
- phase_ispec_inner_elastic)
-
-
-! computes elastic tensor term
-
- use constants,only: CUSTOM_REAL,NGLLX,NGLLY,NGLLZ,NDIM, &
- NUM_REGIONS_ATTENUATION,N_SLS,SAVE_MOHO_MESH, &
- ONE_THIRD,FOUR_THIRDS,m1,m2
- implicit none
-
- integer :: NSPEC_AB,NGLOB_AB
-
-! displacement and acceleration
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: displ,accel
-
-! arrays with mesh parameters per slice
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: &
- kappastore,mustore,jacobian
-
-! array with derivatives of Lagrange polynomials and precalculated products
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx,hprime_xxT,hprimewgll_xx,hprimewgll_xxT
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY) :: wgllwgll_xy
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ) :: wgllwgll_xz
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ) :: wgllwgll_yz
-
-! memory variables and standard linear solids for attenuation
- logical :: ATTENUATION,USE_OLSEN_ATTENUATION
- logical :: COMPUTE_AND_STORE_STRAIN
- integer :: NSPEC_STRAIN_ONLY, NSPEC_ADJOINT
- integer :: NSPEC_ATTENUATION_AB
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: iflag_attenuation_store
- real(kind=CUSTOM_REAL), dimension(NUM_REGIONS_ATTENUATION) :: one_minus_sum_beta
- real(kind=CUSTOM_REAL), dimension(NUM_REGIONS_ATTENUATION,N_SLS) :: factor_common, &
- alphaval,betaval,gammaval
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB,N_SLS) :: &
- R_xx,R_yy,R_xy,R_xz,R_yz
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_STRAIN_ONLY) :: &
- epsilondev_xx,epsilondev_yy,epsilondev_xy,epsilondev_xz,epsilondev_yz
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT) :: epsilon_trace_over_3
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: rho_vs
-
-! anisotropy
- logical :: ANISOTROPY
- integer :: NSPEC_ANISO
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO) :: &
- c11store,c12store,c13store,c14store,c15store,c16store, &
- c22store,c23store,c24store,c25store,c26store,c33store, &
- c34store,c35store,c36store,c44store,c45store,c46store, &
- c55store,c56store,c66store
-
- integer :: iphase
- integer :: num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic
- integer, dimension(num_phase_ispec_elastic,2) :: phase_ispec_inner_elastic
-
-! adjoint simulations
- integer :: SIMULATION_TYPE
- integer :: NSPEC_BOUN,NSPEC2D_MOHO
-
- ! moho kernel
- real(kind=CUSTOM_REAL),dimension(NDIM,NDIM,NGLLX,NGLLY,NGLLZ,NSPEC2D_MOHO):: &
- dsdx_top,dsdx_bot
- logical,dimension(NSPEC_BOUN) :: is_moho_top,is_moho_bot
- integer :: ispec2D_moho_top, ispec2D_moho_bot
-
-! local parameters
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: dummyx_loc,dummyy_loc,dummyz_loc, &
- newtempx1,newtempx2,newtempx3,newtempy1,newtempy2,newtempy3,newtempz1,newtempz2,newtempz3
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: &
- tempx1,tempx2,tempx3,tempy1,tempy2,tempy3,tempz1,tempz2,tempz3
-
- ! manually inline the calls to the Deville et al. (2002) routines
- real(kind=CUSTOM_REAL), dimension(NGLLX,m2) :: B1_m1_m2_5points,B2_m1_m2_5points,B3_m1_m2_5points
- real(kind=CUSTOM_REAL), dimension(m1,m2) :: C1_m1_m2_5points,C2_m1_m2_5points,C3_m1_m2_5points
- real(kind=CUSTOM_REAL), dimension(m1,m2) :: E1_m1_m2_5points,E2_m1_m2_5points,E3_m1_m2_5points
-
- equivalence(dummyx_loc,B1_m1_m2_5points)
- equivalence(dummyy_loc,B2_m1_m2_5points)
- equivalence(dummyz_loc,B3_m1_m2_5points)
- equivalence(tempx1,C1_m1_m2_5points)
- equivalence(tempy1,C2_m1_m2_5points)
- equivalence(tempz1,C3_m1_m2_5points)
- equivalence(newtempx1,E1_m1_m2_5points)
- equivalence(newtempy1,E2_m1_m2_5points)
- equivalence(newtempz1,E3_m1_m2_5points)
-
- real(kind=CUSTOM_REAL), dimension(m2,NGLLX) :: &
- A1_mxm_m2_m1_5points,A2_mxm_m2_m1_5points,A3_mxm_m2_m1_5points
- real(kind=CUSTOM_REAL), dimension(m2,m1) :: &
- C1_mxm_m2_m1_5points,C2_mxm_m2_m1_5points,C3_mxm_m2_m1_5points
- real(kind=CUSTOM_REAL), dimension(m2,m1) :: &
- E1_mxm_m2_m1_5points,E2_mxm_m2_m1_5points,E3_mxm_m2_m1_5points
-
- equivalence(dummyx_loc,A1_mxm_m2_m1_5points)
- equivalence(dummyy_loc,A2_mxm_m2_m1_5points)
- equivalence(dummyz_loc,A3_mxm_m2_m1_5points)
- equivalence(tempx3,C1_mxm_m2_m1_5points)
- equivalence(tempy3,C2_mxm_m2_m1_5points)
- equivalence(tempz3,C3_mxm_m2_m1_5points)
- equivalence(newtempx3,E1_mxm_m2_m1_5points)
- equivalence(newtempy3,E2_mxm_m2_m1_5points)
- equivalence(newtempz3,E3_mxm_m2_m1_5points)
-
- ! local attenuation parameters
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: epsilondev_xx_loc, &
- epsilondev_yy_loc, epsilondev_xy_loc, epsilondev_xz_loc, epsilondev_yz_loc
- real(kind=CUSTOM_REAL) R_xx_val,R_yy_val
- real(kind=CUSTOM_REAL) factor_loc,alphaval_loc,betaval_loc,gammaval_loc,Sn,Snp1
- real(kind=CUSTOM_REAL) templ
- real(kind=CUSTOM_REAL) vs_val
-
- real(kind=CUSTOM_REAL) xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl,jacobianl
- real(kind=CUSTOM_REAL) duxdxl,duxdyl,duxdzl,duydxl,duydyl,duydzl,duzdxl,duzdyl,duzdzl
-
- real(kind=CUSTOM_REAL) duxdxl_plus_duydyl,duxdxl_plus_duzdzl,duydyl_plus_duzdzl
- real(kind=CUSTOM_REAL) duxdyl_plus_duydxl,duzdxl_plus_duxdzl,duzdyl_plus_duydzl
-
- real(kind=CUSTOM_REAL) sigma_xx,sigma_yy,sigma_zz,sigma_xy,sigma_xz,sigma_yz
-
- real(kind=CUSTOM_REAL) fac1,fac2,fac3
-
- real(kind=CUSTOM_REAL) lambdal,mul,lambdalplus2mul
- real(kind=CUSTOM_REAL) kappal
-
- ! local anisotropy parameters
- 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
-
- integer i_SLS,iselected
- integer ispec,iglob,ispec_p,num_elements
- integer i,j,k
-
-! real(kind=CUSTOM_REAL):: dsxx,dsxy,dsxz,dsyy,dsyz,dszz
-
- ! choses inner/outer elements
- if( iphase == 1 ) then
- num_elements = nspec_outer_elastic
- else
- num_elements = nspec_inner_elastic
- endif
-
- do ispec_p = 1,num_elements
-
- ! returns element id from stored element list
- ispec = phase_ispec_inner_elastic(ispec_p,iphase)
-
- ! adjoint simulations: moho kernel
- if( SIMULATION_TYPE == 3 .and. SAVE_MOHO_MESH ) then
- if (is_moho_top(ispec)) then
- ispec2D_moho_top = ispec2D_moho_top + 1
- else if (is_moho_bot(ispec)) then
- ispec2D_moho_bot = ispec2D_moho_bot + 1
- endif
- endif ! adjoint
-
- ! stores displacment values in local array
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
- dummyx_loc(i,j,k) = displ(1,iglob)
- dummyy_loc(i,j,k) = displ(2,iglob)
- dummyz_loc(i,j,k) = displ(3,iglob)
- enddo
- enddo
- enddo
-
- ! subroutines adapted from Deville, Fischer and Mund, High-order methods
- ! for incompressible fluid flow, Cambridge University Press (2002),
- ! pages 386 and 389 and Figure 8.3.1
- ! call mxm_m1_m2_5points(hprime_xx,dummyx_loc,dummyy_loc,dummyz_loc,tempx1,tempy1,tempz1)
- do j=1,m2
- do i=1,m1
- C1_m1_m2_5points(i,j) = hprime_xx(i,1)*B1_m1_m2_5points(1,j) + &
- hprime_xx(i,2)*B1_m1_m2_5points(2,j) + &
- hprime_xx(i,3)*B1_m1_m2_5points(3,j) + &
- hprime_xx(i,4)*B1_m1_m2_5points(4,j) + &
- hprime_xx(i,5)*B1_m1_m2_5points(5,j)
- C2_m1_m2_5points(i,j) = hprime_xx(i,1)*B2_m1_m2_5points(1,j) + &
- hprime_xx(i,2)*B2_m1_m2_5points(2,j) + &
- hprime_xx(i,3)*B2_m1_m2_5points(3,j) + &
- hprime_xx(i,4)*B2_m1_m2_5points(4,j) + &
- hprime_xx(i,5)*B2_m1_m2_5points(5,j)
- C3_m1_m2_5points(i,j) = hprime_xx(i,1)*B3_m1_m2_5points(1,j) + &
- hprime_xx(i,2)*B3_m1_m2_5points(2,j) + &
- hprime_xx(i,3)*B3_m1_m2_5points(3,j) + &
- hprime_xx(i,4)*B3_m1_m2_5points(4,j) + &
- hprime_xx(i,5)*B3_m1_m2_5points(5,j)
- enddo
- enddo
-
- ! call mxm_m1_m1_5points(dummyx_loc(1,1,k),dummyy_loc(1,1,k),dummyz_loc(1,1,k), &
- ! hprime_xxT,tempx2(1,1,k),tempy2(1,1,k),tempz2(1,1,k))
- do j=1,m1
- do i=1,m1
- ! for efficiency it is better to leave this loop on k inside, it leads to slightly faster code
- do k = 1,NGLLX
- tempx2(i,j,k) = dummyx_loc(i,1,k)*hprime_xxT(1,j) + &
- dummyx_loc(i,2,k)*hprime_xxT(2,j) + &
- dummyx_loc(i,3,k)*hprime_xxT(3,j) + &
- dummyx_loc(i,4,k)*hprime_xxT(4,j) + &
- dummyx_loc(i,5,k)*hprime_xxT(5,j)
- tempy2(i,j,k) = dummyy_loc(i,1,k)*hprime_xxT(1,j) + &
- dummyy_loc(i,2,k)*hprime_xxT(2,j) + &
- dummyy_loc(i,3,k)*hprime_xxT(3,j) + &
- dummyy_loc(i,4,k)*hprime_xxT(4,j) + &
- dummyy_loc(i,5,k)*hprime_xxT(5,j)
- tempz2(i,j,k) = dummyz_loc(i,1,k)*hprime_xxT(1,j) + &
- dummyz_loc(i,2,k)*hprime_xxT(2,j) + &
- dummyz_loc(i,3,k)*hprime_xxT(3,j) + &
- dummyz_loc(i,4,k)*hprime_xxT(4,j) + &
- dummyz_loc(i,5,k)*hprime_xxT(5,j)
- enddo
- enddo
- enddo
-
- ! call mxm_m2_m1_5points(dummyx_loc,dummyy_loc,dummyz_loc,tempx3,tempy3,tempz3)
- do j=1,m1
- do i=1,m2
- C1_mxm_m2_m1_5points(i,j) = A1_mxm_m2_m1_5points(i,1)*hprime_xxT(1,j) + &
- A1_mxm_m2_m1_5points(i,2)*hprime_xxT(2,j) + &
- A1_mxm_m2_m1_5points(i,3)*hprime_xxT(3,j) + &
- A1_mxm_m2_m1_5points(i,4)*hprime_xxT(4,j) + &
- A1_mxm_m2_m1_5points(i,5)*hprime_xxT(5,j)
- C2_mxm_m2_m1_5points(i,j) = A2_mxm_m2_m1_5points(i,1)*hprime_xxT(1,j) + &
- A2_mxm_m2_m1_5points(i,2)*hprime_xxT(2,j) + &
- A2_mxm_m2_m1_5points(i,3)*hprime_xxT(3,j) + &
- A2_mxm_m2_m1_5points(i,4)*hprime_xxT(4,j) + &
- A2_mxm_m2_m1_5points(i,5)*hprime_xxT(5,j)
- C3_mxm_m2_m1_5points(i,j) = A3_mxm_m2_m1_5points(i,1)*hprime_xxT(1,j) + &
- A3_mxm_m2_m1_5points(i,2)*hprime_xxT(2,j) + &
- A3_mxm_m2_m1_5points(i,3)*hprime_xxT(3,j) + &
- A3_mxm_m2_m1_5points(i,4)*hprime_xxT(4,j) + &
- A3_mxm_m2_m1_5points(i,5)*hprime_xxT(5,j)
- enddo
- enddo
-
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- ! get derivatives of ux, uy and uz with respect to x, y and z
- xixl = xix(i,j,k,ispec)
- xiyl = xiy(i,j,k,ispec)
- xizl = xiz(i,j,k,ispec)
- etaxl = etax(i,j,k,ispec)
- etayl = etay(i,j,k,ispec)
- etazl = etaz(i,j,k,ispec)
- gammaxl = gammax(i,j,k,ispec)
- gammayl = gammay(i,j,k,ispec)
- gammazl = gammaz(i,j,k,ispec)
- jacobianl = jacobian(i,j,k,ispec)
-
- duxdxl = xixl*tempx1(i,j,k) + etaxl*tempx2(i,j,k) + gammaxl*tempx3(i,j,k)
- duxdyl = xiyl*tempx1(i,j,k) + etayl*tempx2(i,j,k) + gammayl*tempx3(i,j,k)
- duxdzl = xizl*tempx1(i,j,k) + etazl*tempx2(i,j,k) + gammazl*tempx3(i,j,k)
-
- duydxl = xixl*tempy1(i,j,k) + etaxl*tempy2(i,j,k) + gammaxl*tempy3(i,j,k)
- duydyl = xiyl*tempy1(i,j,k) + etayl*tempy2(i,j,k) + gammayl*tempy3(i,j,k)
- duydzl = xizl*tempy1(i,j,k) + etazl*tempy2(i,j,k) + gammazl*tempy3(i,j,k)
-
- duzdxl = xixl*tempz1(i,j,k) + etaxl*tempz2(i,j,k) + gammaxl*tempz3(i,j,k)
- duzdyl = xiyl*tempz1(i,j,k) + etayl*tempz2(i,j,k) + gammayl*tempz3(i,j,k)
- duzdzl = xizl*tempz1(i,j,k) + etazl*tempz2(i,j,k) + gammazl*tempz3(i,j,k)
-
- ! save strain on the Moho boundary
- if (SAVE_MOHO_MESH ) then
- if (is_moho_top(ispec)) then
- dsdx_top(1,1,i,j,k,ispec2D_moho_top) = duxdxl
- dsdx_top(1,2,i,j,k,ispec2D_moho_top) = duxdyl
- dsdx_top(1,3,i,j,k,ispec2D_moho_top) = duxdzl
- dsdx_top(2,1,i,j,k,ispec2D_moho_top) = duydxl
- dsdx_top(2,2,i,j,k,ispec2D_moho_top) = duydyl
- dsdx_top(2,3,i,j,k,ispec2D_moho_top) = duydzl
- dsdx_top(3,1,i,j,k,ispec2D_moho_top) = duzdxl
- dsdx_top(3,2,i,j,k,ispec2D_moho_top) = duzdyl
- dsdx_top(3,3,i,j,k,ispec2D_moho_top) = duzdzl
- else if (is_moho_bot(ispec)) then
- dsdx_bot(1,1,i,j,k,ispec2D_moho_bot) = duxdxl
- dsdx_bot(1,2,i,j,k,ispec2D_moho_bot) = duxdyl
- dsdx_bot(1,3,i,j,k,ispec2D_moho_bot) = duxdzl
- dsdx_bot(2,1,i,j,k,ispec2D_moho_bot) = duydxl
- dsdx_bot(2,2,i,j,k,ispec2D_moho_bot) = duydyl
- dsdx_bot(2,3,i,j,k,ispec2D_moho_bot) = duydzl
- dsdx_bot(3,1,i,j,k,ispec2D_moho_bot) = duzdxl
- dsdx_bot(3,2,i,j,k,ispec2D_moho_bot) = duzdyl
- dsdx_bot(3,3,i,j,k,ispec2D_moho_bot) = duzdzl
- endif
- endif
-
- ! precompute some sums to save CPU time
- duxdxl_plus_duydyl = duxdxl + duydyl
- duxdxl_plus_duzdzl = duxdxl + duzdzl
- duydyl_plus_duzdzl = duydyl + duzdzl
- duxdyl_plus_duydxl = duxdyl + duydxl
- duzdxl_plus_duxdzl = duzdxl + duxdzl
- duzdyl_plus_duydzl = duzdyl + duydzl
-
- ! computes deviatoric strain attenuation and/or for kernel calculations
- if (COMPUTE_AND_STORE_STRAIN) then
- templ = ONE_THIRD * (duxdxl + duydyl + duzdzl)
- if( SIMULATION_TYPE == 3 ) epsilon_trace_over_3(i,j,k,ispec) = templ
- epsilondev_xx_loc(i,j,k) = duxdxl - templ
- epsilondev_yy_loc(i,j,k) = duydyl - templ
- epsilondev_xy_loc(i,j,k) = 0.5 * duxdyl_plus_duydxl
- epsilondev_xz_loc(i,j,k) = 0.5 * duzdxl_plus_duxdzl
- epsilondev_yz_loc(i,j,k) = 0.5 * duzdyl_plus_duydzl
- endif
-
- kappal = kappastore(i,j,k,ispec)
- mul = mustore(i,j,k,ispec)
-
- ! attenuation
- if(ATTENUATION) then
- ! uses scaling rule similar to Olsen et al. (2003) or mesh flag
- if(USE_OLSEN_ATTENUATION) then
- vs_val = mustore(i,j,k,ispec) / rho_vs(i,j,k,ispec)
- call get_attenuation_model_olsen( vs_val, iselected )
- else
- ! iflag from (CUBIT) mesh
- iselected = iflag_attenuation_store(i,j,k,ispec)
- endif
-
- ! use unrelaxed parameters if attenuation
- mul = mul * one_minus_sum_beta(iselected)
-
- endif
-
- ! full anisotropic case, stress calculations
- if(ANISOTROPY) then
- c11 = c11store(i,j,k,ispec)
- c12 = c12store(i,j,k,ispec)
- c13 = c13store(i,j,k,ispec)
- c14 = c14store(i,j,k,ispec)
- c15 = c15store(i,j,k,ispec)
- c16 = c16store(i,j,k,ispec)
- c22 = c22store(i,j,k,ispec)
- c23 = c23store(i,j,k,ispec)
- c24 = c24store(i,j,k,ispec)
- c25 = c25store(i,j,k,ispec)
- c26 = c26store(i,j,k,ispec)
- c33 = c33store(i,j,k,ispec)
- c34 = c34store(i,j,k,ispec)
- c35 = c35store(i,j,k,ispec)
- c36 = c36store(i,j,k,ispec)
- c44 = c44store(i,j,k,ispec)
- c45 = c45store(i,j,k,ispec)
- c46 = c46store(i,j,k,ispec)
- c55 = c55store(i,j,k,ispec)
- c56 = c56store(i,j,k,ispec)
- c66 = c66store(i,j,k,ispec)
-
- sigma_xx = c11*duxdxl + c16*duxdyl_plus_duydxl + c12*duydyl + &
- c15*duzdxl_plus_duxdzl + c14*duzdyl_plus_duydzl + c13*duzdzl
- sigma_yy = c12*duxdxl + c26*duxdyl_plus_duydxl + c22*duydyl + &
- c25*duzdxl_plus_duxdzl + c24*duzdyl_plus_duydzl + c23*duzdzl
- sigma_zz = c13*duxdxl + c36*duxdyl_plus_duydxl + c23*duydyl + &
- c35*duzdxl_plus_duxdzl + c34*duzdyl_plus_duydzl + c33*duzdzl
- sigma_xy = c16*duxdxl + c66*duxdyl_plus_duydxl + c26*duydyl + &
- c56*duzdxl_plus_duxdzl + c46*duzdyl_plus_duydzl + c36*duzdzl
- sigma_xz = c15*duxdxl + c56*duxdyl_plus_duydxl + c25*duydyl + &
- c55*duzdxl_plus_duxdzl + c45*duzdyl_plus_duydzl + c35*duzdzl
- sigma_yz = c14*duxdxl + c46*duxdyl_plus_duydxl + c24*duydyl + &
- c45*duzdxl_plus_duxdzl + c44*duzdyl_plus_duydzl + c34*duzdzl
-
- else
-
- ! isotropic case
- lambdalplus2mul = kappal + FOUR_THIRDS * mul
- lambdal = lambdalplus2mul - 2.*mul
-
- ! compute stress sigma
- sigma_xx = lambdalplus2mul*duxdxl + lambdal*duydyl_plus_duzdzl
- sigma_yy = lambdalplus2mul*duydyl + lambdal*duxdxl_plus_duzdzl
- sigma_zz = lambdalplus2mul*duzdzl + lambdal*duxdxl_plus_duydyl
-
- sigma_xy = mul*duxdyl_plus_duydxl
- sigma_xz = mul*duzdxl_plus_duxdzl
- sigma_yz = mul*duzdyl_plus_duydzl
-
- endif ! ANISOTROPY
-
- ! subtract memory variables if attenuation
- if(ATTENUATION) then
- do i_sls = 1,N_SLS
- R_xx_val = R_xx(i,j,k,ispec,i_sls)
- R_yy_val = R_yy(i,j,k,ispec,i_sls)
- sigma_xx = sigma_xx - R_xx_val
- sigma_yy = sigma_yy - R_yy_val
- sigma_zz = sigma_zz + R_xx_val + R_yy_val
- sigma_xy = sigma_xy - R_xy(i,j,k,ispec,i_sls)
- sigma_xz = sigma_xz - R_xz(i,j,k,ispec,i_sls)
- sigma_yz = sigma_yz - R_yz(i,j,k,ispec,i_sls)
- enddo
- endif
-
- ! form dot product with test vector, symmetric form
- tempx1(i,j,k) = jacobianl * (sigma_xx*xixl + sigma_xy*xiyl + sigma_xz*xizl)
- tempy1(i,j,k) = jacobianl * (sigma_xy*xixl + sigma_yy*xiyl + sigma_yz*xizl)
- tempz1(i,j,k) = jacobianl * (sigma_xz*xixl + sigma_yz*xiyl + sigma_zz*xizl)
-
- tempx2(i,j,k) = jacobianl * (sigma_xx*etaxl + sigma_xy*etayl + sigma_xz*etazl)
- tempy2(i,j,k) = jacobianl * (sigma_xy*etaxl + sigma_yy*etayl + sigma_yz*etazl)
- tempz2(i,j,k) = jacobianl * (sigma_xz*etaxl + sigma_yz*etayl + sigma_zz*etazl)
-
- tempx3(i,j,k) = jacobianl * (sigma_xx*gammaxl + sigma_xy*gammayl + sigma_xz*gammazl)
- tempy3(i,j,k) = jacobianl * (sigma_xy*gammaxl + sigma_yy*gammayl + sigma_yz*gammazl)
- tempz3(i,j,k) = jacobianl * (sigma_xz*gammaxl + sigma_yz*gammayl + sigma_zz*gammazl)
-
- enddo
- enddo
- enddo
-
- ! subroutines adapted from Deville, Fischer and Mund, High-order methods
- ! for incompressible fluid flow, Cambridge University Press (2002),
- ! pages 386 and 389 and Figure 8.3.1
- ! call mxm_m1_m2_5points(hprimewgll_xxT,tempx1,tempy1,tempz1,newtempx1,newtempy1,newtempz1)
- do j=1,m2
- do i=1,m1
- E1_m1_m2_5points(i,j) = hprimewgll_xxT(i,1)*C1_m1_m2_5points(1,j) + &
- hprimewgll_xxT(i,2)*C1_m1_m2_5points(2,j) + &
- hprimewgll_xxT(i,3)*C1_m1_m2_5points(3,j) + &
- hprimewgll_xxT(i,4)*C1_m1_m2_5points(4,j) + &
- hprimewgll_xxT(i,5)*C1_m1_m2_5points(5,j)
- E2_m1_m2_5points(i,j) = hprimewgll_xxT(i,1)*C2_m1_m2_5points(1,j) + &
- hprimewgll_xxT(i,2)*C2_m1_m2_5points(2,j) + &
- hprimewgll_xxT(i,3)*C2_m1_m2_5points(3,j) + &
- hprimewgll_xxT(i,4)*C2_m1_m2_5points(4,j) + &
- hprimewgll_xxT(i,5)*C2_m1_m2_5points(5,j)
- E3_m1_m2_5points(i,j) = hprimewgll_xxT(i,1)*C3_m1_m2_5points(1,j) + &
- hprimewgll_xxT(i,2)*C3_m1_m2_5points(2,j) + &
- hprimewgll_xxT(i,3)*C3_m1_m2_5points(3,j) + &
- hprimewgll_xxT(i,4)*C3_m1_m2_5points(4,j) + &
- hprimewgll_xxT(i,5)*C3_m1_m2_5points(5,j)
- enddo
- enddo
-
- ! call mxm_m1_m1_5points(tempx2(1,1,k),tempy2(1,1,k),tempz2(1,1,k), &
- ! hprimewgll_xx,newtempx2(1,1,k),newtempy2(1,1,k),newtempz2(1,1,k))
- do i=1,m1
- do j=1,m1
- ! for efficiency it is better to leave this loop on k inside, it leads to slightly faster code
- do k = 1,NGLLX
- newtempx2(i,j,k) = tempx2(i,1,k)*hprimewgll_xx(1,j) + &
- tempx2(i,2,k)*hprimewgll_xx(2,j) + &
- tempx2(i,3,k)*hprimewgll_xx(3,j) + &
- tempx2(i,4,k)*hprimewgll_xx(4,j) + &
- tempx2(i,5,k)*hprimewgll_xx(5,j)
- newtempy2(i,j,k) = tempy2(i,1,k)*hprimewgll_xx(1,j) + &
- tempy2(i,2,k)*hprimewgll_xx(2,j) + &
- tempy2(i,3,k)*hprimewgll_xx(3,j) + &
- tempy2(i,4,k)*hprimewgll_xx(4,j) + &
- tempy2(i,5,k)*hprimewgll_xx(5,j)
- newtempz2(i,j,k) = tempz2(i,1,k)*hprimewgll_xx(1,j) + &
- tempz2(i,2,k)*hprimewgll_xx(2,j) + &
- tempz2(i,3,k)*hprimewgll_xx(3,j) + &
- tempz2(i,4,k)*hprimewgll_xx(4,j) + &
- tempz2(i,5,k)*hprimewgll_xx(5,j)
- enddo
- enddo
- enddo
-
- ! call mxm_m2_m1_5points(tempx3,tempy3,tempz3,hprimewgll_xx,newtempx3,newtempy3,newtempz3)
- do j=1,m1
- do i=1,m2
- E1_mxm_m2_m1_5points(i,j) = C1_mxm_m2_m1_5points(i,1)*hprimewgll_xx(1,j) + &
- C1_mxm_m2_m1_5points(i,2)*hprimewgll_xx(2,j) + &
- C1_mxm_m2_m1_5points(i,3)*hprimewgll_xx(3,j) + &
- C1_mxm_m2_m1_5points(i,4)*hprimewgll_xx(4,j) + &
- C1_mxm_m2_m1_5points(i,5)*hprimewgll_xx(5,j)
- E2_mxm_m2_m1_5points(i,j) = C2_mxm_m2_m1_5points(i,1)*hprimewgll_xx(1,j) + &
- C2_mxm_m2_m1_5points(i,2)*hprimewgll_xx(2,j) + &
- C2_mxm_m2_m1_5points(i,3)*hprimewgll_xx(3,j) + &
- C2_mxm_m2_m1_5points(i,4)*hprimewgll_xx(4,j) + &
- C2_mxm_m2_m1_5points(i,5)*hprimewgll_xx(5,j)
- E3_mxm_m2_m1_5points(i,j) = C3_mxm_m2_m1_5points(i,1)*hprimewgll_xx(1,j) + &
- C3_mxm_m2_m1_5points(i,2)*hprimewgll_xx(2,j) + &
- C3_mxm_m2_m1_5points(i,3)*hprimewgll_xx(3,j) + &
- C3_mxm_m2_m1_5points(i,4)*hprimewgll_xx(4,j) + &
- C3_mxm_m2_m1_5points(i,5)*hprimewgll_xx(5,j)
- enddo
- enddo
-
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
-
- fac1 = wgllwgll_yz(j,k)
- fac2 = wgllwgll_xz(i,k)
- fac3 = wgllwgll_xy(i,j)
-
- ! sum contributions from each element to the global mesh using indirect addressing
- iglob = ibool(i,j,k,ispec)
- accel(1,iglob) = accel(1,iglob) - fac1*newtempx1(i,j,k) - &
- fac2*newtempx2(i,j,k) - fac3*newtempx3(i,j,k)
- accel(2,iglob) = accel(2,iglob) - fac1*newtempy1(i,j,k) - &
- fac2*newtempy2(i,j,k) - fac3*newtempy3(i,j,k)
- accel(3,iglob) = accel(3,iglob) - fac1*newtempz1(i,j,k) - &
- fac2*newtempz2(i,j,k) - fac3*newtempz3(i,j,k)
-
- ! update memory variables based upon the Runge-Kutta scheme
- if(ATTENUATION) then
-
- ! use Runge-Kutta scheme to march in time
- do i_sls = 1,N_SLS
-
- ! get coefficients for that standard linear solid
- if( USE_OLSEN_ATTENUATION ) then
- vs_val = mustore(i,j,k,ispec) / rho_vs(i,j,k,ispec)
- call get_attenuation_model_olsen( vs_val, iselected )
- else
- iselected = iflag_attenuation_store(i,j,k,ispec)
- endif
-
- factor_loc = mustore(i,j,k,ispec) * factor_common(iselected,i_sls)
-
- alphaval_loc = alphaval(iselected,i_sls)
- betaval_loc = betaval(iselected,i_sls)
- gammaval_loc = gammaval(iselected,i_sls)
-
- ! term in xx
- Sn = factor_loc * epsilondev_xx(i,j,k,ispec)
- Snp1 = factor_loc * epsilondev_xx_loc(i,j,k)
- R_xx(i,j,k,ispec,i_sls) = alphaval_loc * R_xx(i,j,k,ispec,i_sls) + &
- betaval_loc * Sn + gammaval_loc * Snp1
- ! term in yy
- Sn = factor_loc * epsilondev_yy(i,j,k,ispec)
- Snp1 = factor_loc * epsilondev_yy_loc(i,j,k)
- R_yy(i,j,k,ispec,i_sls) = alphaval_loc * R_yy(i,j,k,ispec,i_sls) + &
- betaval_loc * Sn + gammaval_loc * Snp1
- ! term in zz not computed since zero trace
- ! term in xy
- Sn = factor_loc * epsilondev_xy(i,j,k,ispec)
- Snp1 = factor_loc * epsilondev_xy_loc(i,j,k)
- R_xy(i,j,k,ispec,i_sls) = alphaval_loc * R_xy(i,j,k,ispec,i_sls) + &
- betaval_loc * Sn + gammaval_loc * Snp1
- ! term in xz
- Sn = factor_loc * epsilondev_xz(i,j,k,ispec)
- Snp1 = factor_loc * epsilondev_xz_loc(i,j,k)
- R_xz(i,j,k,ispec,i_sls) = alphaval_loc * R_xz(i,j,k,ispec,i_sls) + &
- betaval_loc * Sn + gammaval_loc * Snp1
- ! term in yz
- Sn = factor_loc * epsilondev_yz(i,j,k,ispec)
- Snp1 = factor_loc * epsilondev_yz_loc(i,j,k)
- R_yz(i,j,k,ispec,i_sls) = alphaval_loc * R_yz(i,j,k,ispec,i_sls) + &
- betaval_loc * Sn + gammaval_loc * Snp1
-
- enddo ! end of loop on memory variables
-
- endif ! end attenuation
-
- enddo
- enddo
- enddo
-
- ! save deviatoric strain for Runge-Kutta scheme
- if ( COMPUTE_AND_STORE_STRAIN ) then
- epsilondev_xx(:,:,:,ispec) = epsilondev_xx_loc(:,:,:)
- epsilondev_yy(:,:,:,ispec) = epsilondev_yy_loc(:,:,:)
- epsilondev_xy(:,:,:,ispec) = epsilondev_xy_loc(:,:,:)
- epsilondev_xz(:,:,:,ispec) = epsilondev_xz_loc(:,:,:)
- epsilondev_yz(:,:,:,ispec) = epsilondev_yz_loc(:,:,:)
- endif
-
- enddo ! spectral element loop
-
-end subroutine compute_forces_elastic_Dev
-
Deleted: seismo/3D/SPECFEM3D/trunk/compute_forces_elastic_noDev.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_forces_elastic_noDev.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_forces_elastic_noDev.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,514 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-subroutine compute_forces_elastic_noDev( iphase, &
- NSPEC_AB,NGLOB_AB,displ,accel,&
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
- hprime_xx,hprime_yy,hprime_zz,&
- hprimewgll_xx,hprimewgll_yy,hprimewgll_zz,&
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- kappastore,mustore,jacobian,ibool,&
- ATTENUATION,USE_OLSEN_ATTENUATION,&
- one_minus_sum_beta,factor_common,alphaval,betaval,gammaval,&
- NSPEC_ATTENUATION_AB,R_xx,R_yy,R_xy,R_xz,R_yz, &
- epsilondev_xx,epsilondev_yy,epsilondev_xy,&
- epsilondev_xz,epsilondev_yz,epsilon_trace_over_3, &
- iflag_attenuation_store,rho_vs,&
- ANISOTROPY,NSPEC_ANISO, &
- c11store,c12store,c13store,c14store,c15store,c16store,&
- c22store,c23store,c24store,c25store,c26store,c33store,&
- c34store,c35store,c36store,c44store,c45store,c46store,&
- c55store,c56store,c66store, &
- SIMULATION_TYPE,COMPUTE_AND_STORE_STRAIN,NSPEC_STRAIN_ONLY, &
- NSPEC_BOUN,NSPEC2D_MOHO,NSPEC_ADJOINT,&
- is_moho_top,is_moho_bot, &
- dsdx_top,dsdx_bot, &
- ispec2D_moho_top,ispec2D_moho_bot, &
- num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic,&
- phase_ispec_inner_elastic )
-
- use constants,only: CUSTOM_REAL,NGLLX,NGLLY,NGLLZ,NDIM, &
- NUM_REGIONS_ATTENUATION,N_SLS,SAVE_MOHO_MESH, &
- ONE_THIRD,FOUR_THIRDS
-
- implicit none
-
- !include "constants.h"
-
- integer :: NSPEC_AB,NGLOB_AB
-
-! displacement and acceleration
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: displ,accel
-
-! arrays with mesh parameters per slice
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: &
- kappastore,mustore,jacobian
-
-! array with derivatives of Lagrange polynomials and precalculated products
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx,hprimewgll_xx
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLY) :: hprime_yy,hprimewgll_yy
- real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz,hprimewgll_zz
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY) :: wgllwgll_xy
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ) :: wgllwgll_xz
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ) :: wgllwgll_yz
-
-! communication overlap
-! logical, dimension(NSPEC_AB) :: ispec_is_inner
-! logical :: phase_is_inner
-
-! memory variables and standard linear solids for attenuation
- logical :: ATTENUATION,USE_OLSEN_ATTENUATION
- logical :: COMPUTE_AND_STORE_STRAIN
- integer :: NSPEC_STRAIN_ONLY, NSPEC_ADJOINT
- integer :: NSPEC_ATTENUATION_AB
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: iflag_attenuation_store
- real(kind=CUSTOM_REAL), dimension(NUM_REGIONS_ATTENUATION) :: one_minus_sum_beta
- real(kind=CUSTOM_REAL), dimension(NUM_REGIONS_ATTENUATION,N_SLS) :: factor_common, alphaval,betaval,gammaval
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB,N_SLS) :: &
- R_xx,R_yy,R_xy,R_xz,R_yz
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_STRAIN_ONLY) :: &
- epsilondev_xx,epsilondev_yy,epsilondev_xy,epsilondev_xz,epsilondev_yz
- real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT) :: epsilon_trace_over_3
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: rho_vs
-
-! anisotropy
- logical :: ANISOTROPY
- integer :: NSPEC_ANISO
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO) :: &
- c11store,c12store,c13store,c14store,c15store,c16store, &
- c22store,c23store,c24store,c25store,c26store,c33store, &
- c34store,c35store,c36store,c44store,c45store,c46store, &
- c55store,c56store,c66store
-
-! logical,dimension(NSPEC_AB) :: ispec_is_elastic
- integer :: iphase
- integer :: num_phase_ispec_elastic,nspec_inner_elastic,nspec_outer_elastic
- integer, dimension(num_phase_ispec_elastic,2) :: phase_ispec_inner_elastic
-
-
-! adjoint simulations
- integer :: SIMULATION_TYPE
- integer :: NSPEC_BOUN,NSPEC2D_MOHO
-
- ! moho kernel
- real(kind=CUSTOM_REAL),dimension(NDIM,NDIM,NGLLX,NGLLY,NGLLZ,NSPEC2D_MOHO):: &
- dsdx_top,dsdx_bot
- logical,dimension(NSPEC_BOUN) :: is_moho_top,is_moho_bot
- integer :: ispec2D_moho_top, ispec2D_moho_bot
-
-! local parameters
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: &
- tempx1,tempx2,tempx3,tempy1,tempy2,tempy3,tempz1,tempz2,tempz3
-
- real(kind=CUSTOM_REAL) xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl,jacobianl
- real(kind=CUSTOM_REAL) duxdxl,duxdyl,duxdzl,duydxl,duydyl,duydzl,duzdxl,duzdyl,duzdzl
-
- real(kind=CUSTOM_REAL) duxdxl_plus_duydyl,duxdxl_plus_duzdzl,duydyl_plus_duzdzl
- real(kind=CUSTOM_REAL) duxdyl_plus_duydxl,duzdxl_plus_duxdzl,duzdyl_plus_duydzl
-
- real(kind=CUSTOM_REAL) sigma_xx,sigma_yy,sigma_zz,sigma_xy,sigma_xz,sigma_yz
-
- real(kind=CUSTOM_REAL) hp1,hp2,hp3
- real(kind=CUSTOM_REAL) fac1,fac2,fac3
-
- real(kind=CUSTOM_REAL) tempx1l,tempx2l,tempx3l
- real(kind=CUSTOM_REAL) tempy1l,tempy2l,tempy3l
- real(kind=CUSTOM_REAL) tempz1l,tempz2l,tempz3l
-
- real(kind=CUSTOM_REAL) lambdal,mul,lambdalplus2mul
- real(kind=CUSTOM_REAL) kappal
-
- ! local anisotropy parameters
- 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
-
- ! local attenuation parameters
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: epsilondev_xx_loc, &
- epsilondev_yy_loc, epsilondev_xy_loc, epsilondev_xz_loc, epsilondev_yz_loc
- real(kind=CUSTOM_REAL) R_xx_val,R_yy_val
- real(kind=CUSTOM_REAL) factor_loc,alphaval_loc,betaval_loc,gammaval_loc,Sn,Snp1
- real(kind=CUSTOM_REAL) templ
- real(kind=CUSTOM_REAL) vs_val
-
- integer i_SLS,iselected
- integer ispec,iglob,ispec_p,num_elements
- integer i,j,k,l
-
-
- if( iphase == 1 ) then
- num_elements = nspec_outer_elastic
- else
- num_elements = nspec_inner_elastic
- endif
-
- do ispec_p = 1,num_elements
-
- ispec = phase_ispec_inner_elastic(ispec_p,iphase)
-
- ! adjoint simulations: moho kernel
- ! note: call this only once
- if (SAVE_MOHO_MESH .and. SIMULATION_TYPE == 3) then
- if (is_moho_top(ispec)) then
- ispec2D_moho_top = ispec2D_moho_top + 1
- else if (is_moho_bot(ispec)) then
- ispec2D_moho_bot = ispec2D_moho_bot + 1
- endif
- endif
-
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
-
- tempx1l = 0.
- tempx2l = 0.
- tempx3l = 0.
-
- tempy1l = 0.
- tempy2l = 0.
- tempy3l = 0.
-
- tempz1l = 0.
- tempz2l = 0.
- tempz3l = 0.
-
- do l=1,NGLLX
- hp1 = hprime_xx(i,l)
- iglob = ibool(l,j,k,ispec)
- tempx1l = tempx1l + displ(1,iglob)*hp1
- tempy1l = tempy1l + displ(2,iglob)*hp1
- tempz1l = tempz1l + displ(3,iglob)*hp1
-
- !!! can merge these loops because NGLLX = NGLLY = NGLLZ
- hp2 = hprime_yy(j,l)
- iglob = ibool(i,l,k,ispec)
- tempx2l = tempx2l + displ(1,iglob)*hp2
- tempy2l = tempy2l + displ(2,iglob)*hp2
- tempz2l = tempz2l + displ(3,iglob)*hp2
-
- !!! can merge these loops because NGLLX = NGLLY = NGLLZ
- hp3 = hprime_zz(k,l)
- iglob = ibool(i,j,l,ispec)
- tempx3l = tempx3l + displ(1,iglob)*hp3
- tempy3l = tempy3l + displ(2,iglob)*hp3
- tempz3l = tempz3l + displ(3,iglob)*hp3
- enddo
-
- ! get derivatives of ux, uy and uz with respect to x, y and z
- xixl = xix(i,j,k,ispec)
- xiyl = xiy(i,j,k,ispec)
- xizl = xiz(i,j,k,ispec)
- etaxl = etax(i,j,k,ispec)
- etayl = etay(i,j,k,ispec)
- etazl = etaz(i,j,k,ispec)
- gammaxl = gammax(i,j,k,ispec)
- gammayl = gammay(i,j,k,ispec)
- gammazl = gammaz(i,j,k,ispec)
- jacobianl = jacobian(i,j,k,ispec)
-
- duxdxl = xixl*tempx1l + etaxl*tempx2l + gammaxl*tempx3l
- duxdyl = xiyl*tempx1l + etayl*tempx2l + gammayl*tempx3l
- duxdzl = xizl*tempx1l + etazl*tempx2l + gammazl*tempx3l
-
- duydxl = xixl*tempy1l + etaxl*tempy2l + gammaxl*tempy3l
- duydyl = xiyl*tempy1l + etayl*tempy2l + gammayl*tempy3l
- duydzl = xizl*tempy1l + etazl*tempy2l + gammazl*tempy3l
-
- duzdxl = xixl*tempz1l + etaxl*tempz2l + gammaxl*tempz3l
- duzdyl = xiyl*tempz1l + etayl*tempz2l + gammayl*tempz3l
- duzdzl = xizl*tempz1l + etazl*tempz2l + gammazl*tempz3l
-
- ! adjoint simulations: save strain on the Moho boundary
- if (SAVE_MOHO_MESH ) then
- if (is_moho_top(ispec)) then
- dsdx_top(1,1,i,j,k,ispec2D_moho_top) = duxdxl
- dsdx_top(1,2,i,j,k,ispec2D_moho_top) = duxdyl
- dsdx_top(1,3,i,j,k,ispec2D_moho_top) = duxdzl
- dsdx_top(2,1,i,j,k,ispec2D_moho_top) = duydxl
- dsdx_top(2,2,i,j,k,ispec2D_moho_top) = duydyl
- dsdx_top(2,3,i,j,k,ispec2D_moho_top) = duydzl
- dsdx_top(3,1,i,j,k,ispec2D_moho_top) = duzdxl
- dsdx_top(3,2,i,j,k,ispec2D_moho_top) = duzdyl
- dsdx_top(3,3,i,j,k,ispec2D_moho_top) = duzdzl
- else if (is_moho_bot(ispec)) then
- dsdx_bot(1,1,i,j,k,ispec2D_moho_bot) = duxdxl
- dsdx_bot(1,2,i,j,k,ispec2D_moho_bot) = duxdyl
- dsdx_bot(1,3,i,j,k,ispec2D_moho_bot) = duxdzl
- dsdx_bot(2,1,i,j,k,ispec2D_moho_bot) = duydxl
- dsdx_bot(2,2,i,j,k,ispec2D_moho_bot) = duydyl
- dsdx_bot(2,3,i,j,k,ispec2D_moho_bot) = duydzl
- dsdx_bot(3,1,i,j,k,ispec2D_moho_bot) = duzdxl
- dsdx_bot(3,2,i,j,k,ispec2D_moho_bot) = duzdyl
- dsdx_bot(3,3,i,j,k,ispec2D_moho_bot) = duzdzl
- endif
- endif
-
- ! precompute some sums to save CPU time
- duxdxl_plus_duydyl = duxdxl + duydyl
- duxdxl_plus_duzdzl = duxdxl + duzdzl
- duydyl_plus_duzdzl = duydyl + duzdzl
- duxdyl_plus_duydxl = duxdyl + duydxl
- duzdxl_plus_duxdzl = duzdxl + duxdzl
- duzdyl_plus_duydzl = duzdyl + duydzl
-
- ! computes deviatoric strain attenuation and/or for kernel calculations
- if (COMPUTE_AND_STORE_STRAIN) then
- templ = ONE_THIRD * (duxdxl + duydyl + duzdzl)
- if( SIMULATION_TYPE == 3 ) epsilon_trace_over_3(i,j,k,ispec) = templ
- epsilondev_xx_loc(i,j,k) = duxdxl - templ
- epsilondev_yy_loc(i,j,k) = duydyl - templ
- epsilondev_xy_loc(i,j,k) = 0.5 * duxdyl_plus_duydxl
- epsilondev_xz_loc(i,j,k) = 0.5 * duzdxl_plus_duxdzl
- epsilondev_yz_loc(i,j,k) = 0.5 * duzdyl_plus_duydzl
- endif
-
- kappal = kappastore(i,j,k,ispec)
- mul = mustore(i,j,k,ispec)
-
- if(ATTENUATION) then
- ! uses scaling rule similar to Olsen et al. (2003) or mesh flag
- if(USE_OLSEN_ATTENUATION) then
- vs_val = mustore(i,j,k,ispec) / rho_vs(i,j,k,ispec)
- call get_attenuation_model_olsen( vs_val, iselected )
- else
- ! iflag from (CUBIT) mesh
- iselected = iflag_attenuation_store(i,j,k,ispec)
- endif
-
- ! use unrelaxed parameters if attenuation
- mul = mul * one_minus_sum_beta(iselected)
-
- endif
-
- ! full anisotropic case, stress calculations
- if(ANISOTROPY) then
- c11 = c11store(i,j,k,ispec)
- c12 = c12store(i,j,k,ispec)
- c13 = c13store(i,j,k,ispec)
- c14 = c14store(i,j,k,ispec)
- c15 = c15store(i,j,k,ispec)
- c16 = c16store(i,j,k,ispec)
- c22 = c22store(i,j,k,ispec)
- c23 = c23store(i,j,k,ispec)
- c24 = c24store(i,j,k,ispec)
- c25 = c25store(i,j,k,ispec)
- c26 = c26store(i,j,k,ispec)
- c33 = c33store(i,j,k,ispec)
- c34 = c34store(i,j,k,ispec)
- c35 = c35store(i,j,k,ispec)
- c36 = c36store(i,j,k,ispec)
- c44 = c44store(i,j,k,ispec)
- c45 = c45store(i,j,k,ispec)
- c46 = c46store(i,j,k,ispec)
- c55 = c55store(i,j,k,ispec)
- c56 = c56store(i,j,k,ispec)
- c66 = c66store(i,j,k,ispec)
-
- sigma_xx = c11*duxdxl + c16*duxdyl_plus_duydxl + c12*duydyl + &
- c15*duzdxl_plus_duxdzl + c14*duzdyl_plus_duydzl + c13*duzdzl
- sigma_yy = c12*duxdxl + c26*duxdyl_plus_duydxl + c22*duydyl + &
- c25*duzdxl_plus_duxdzl + c24*duzdyl_plus_duydzl + c23*duzdzl
- sigma_zz = c13*duxdxl + c36*duxdyl_plus_duydxl + c23*duydyl + &
- c35*duzdxl_plus_duxdzl + c34*duzdyl_plus_duydzl + c33*duzdzl
- sigma_xy = c16*duxdxl + c66*duxdyl_plus_duydxl + c26*duydyl + &
- c56*duzdxl_plus_duxdzl + c46*duzdyl_plus_duydzl + c36*duzdzl
- sigma_xz = c15*duxdxl + c56*duxdyl_plus_duydxl + c25*duydyl + &
- c55*duzdxl_plus_duxdzl + c45*duzdyl_plus_duydzl + c35*duzdzl
- sigma_yz = c14*duxdxl + c46*duxdyl_plus_duydxl + c24*duydyl + &
- c45*duzdxl_plus_duxdzl + c44*duzdyl_plus_duydzl + c34*duzdzl
-
- else
-
- ! isotropic case
- lambdalplus2mul = kappal + FOUR_THIRDS * mul
- lambdal = lambdalplus2mul - 2.*mul
-
- ! compute stress sigma
- sigma_xx = lambdalplus2mul*duxdxl + lambdal*duydyl_plus_duzdzl
- sigma_yy = lambdalplus2mul*duydyl + lambdal*duxdxl_plus_duzdzl
- sigma_zz = lambdalplus2mul*duzdzl + lambdal*duxdxl_plus_duydyl
-
- sigma_xy = mul*duxdyl_plus_duydxl
- sigma_xz = mul*duzdxl_plus_duxdzl
- sigma_yz = mul*duzdyl_plus_duydzl
-
- endif ! ANISOTROPY
-
- ! subtract memory variables if attenuation
- if(ATTENUATION) then
- do i_sls = 1,N_SLS
- R_xx_val = R_xx(i,j,k,ispec,i_sls)
- R_yy_val = R_yy(i,j,k,ispec,i_sls)
- sigma_xx = sigma_xx - R_xx_val
- sigma_yy = sigma_yy - R_yy_val
- sigma_zz = sigma_zz + R_xx_val + R_yy_val
- sigma_xy = sigma_xy - R_xy(i,j,k,ispec,i_sls)
- sigma_xz = sigma_xz - R_xz(i,j,k,ispec,i_sls)
- sigma_yz = sigma_yz - R_yz(i,j,k,ispec,i_sls)
- enddo
- endif
-
- ! form dot product with test vector, symmetric form
- tempx1(i,j,k) = jacobianl * (sigma_xx*xixl + sigma_xy*xiyl + sigma_xz*xizl)
- tempy1(i,j,k) = jacobianl * (sigma_xy*xixl + sigma_yy*xiyl + sigma_yz*xizl)
- tempz1(i,j,k) = jacobianl * (sigma_xz*xixl + sigma_yz*xiyl + sigma_zz*xizl)
-
- tempx2(i,j,k) = jacobianl * (sigma_xx*etaxl + sigma_xy*etayl + sigma_xz*etazl)
- tempy2(i,j,k) = jacobianl * (sigma_xy*etaxl + sigma_yy*etayl + sigma_yz*etazl)
- tempz2(i,j,k) = jacobianl * (sigma_xz*etaxl + sigma_yz*etayl + sigma_zz*etazl)
-
- tempx3(i,j,k) = jacobianl * (sigma_xx*gammaxl + sigma_xy*gammayl + sigma_xz*gammazl)
- tempy3(i,j,k) = jacobianl * (sigma_xy*gammaxl + sigma_yy*gammayl + sigma_yz*gammazl)
- tempz3(i,j,k) = jacobianl * (sigma_xz*gammaxl + sigma_yz*gammayl + sigma_zz*gammazl)
-
- enddo
- enddo
- enddo
-
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
-
- tempx1l = 0.
- tempy1l = 0.
- tempz1l = 0.
-
- tempx2l = 0.
- tempy2l = 0.
- tempz2l = 0.
-
- tempx3l = 0.
- tempy3l = 0.
- tempz3l = 0.
-
- do l=1,NGLLX
- fac1 = hprimewgll_xx(l,i)
- tempx1l = tempx1l + tempx1(l,j,k)*fac1
- tempy1l = tempy1l + tempy1(l,j,k)*fac1
- tempz1l = tempz1l + tempz1(l,j,k)*fac1
-
- !!! can merge these loops because NGLLX = NGLLY = NGLLZ
- fac2 = hprimewgll_yy(l,j)
- tempx2l = tempx2l + tempx2(i,l,k)*fac2
- tempy2l = tempy2l + tempy2(i,l,k)*fac2
- tempz2l = tempz2l + tempz2(i,l,k)*fac2
-
- !!! can merge these loops because NGLLX = NGLLY = NGLLZ
- fac3 = hprimewgll_zz(l,k)
- tempx3l = tempx3l + tempx3(i,j,l)*fac3
- tempy3l = tempy3l + tempy3(i,j,l)*fac3
- tempz3l = tempz3l + tempz3(i,j,l)*fac3
- enddo
-
- fac1 = wgllwgll_yz(j,k)
- fac2 = wgllwgll_xz(i,k)
- fac3 = wgllwgll_xy(i,j)
-
- ! sum contributions from each element to the global mesh
- iglob = ibool(i,j,k,ispec)
-
- accel(1,iglob) = accel(1,iglob) - (fac1*tempx1l + fac2*tempx2l + fac3*tempx3l)
- accel(2,iglob) = accel(2,iglob) - (fac1*tempy1l + fac2*tempy2l + fac3*tempy3l)
- accel(3,iglob) = accel(3,iglob) - (fac1*tempz1l + fac2*tempz2l + fac3*tempz3l)
-
- ! update memory variables based upon the Runge-Kutta scheme
- if(ATTENUATION) then
-
- ! use Runge-Kutta scheme to march in time
- do i_sls = 1,N_SLS
-
- ! get coefficients for that standard linear solid
- if( USE_OLSEN_ATTENUATION ) then
- vs_val = mustore(i,j,k,ispec) / rho_vs(i,j,k,ispec)
- call get_attenuation_model_olsen( vs_val, iselected )
- else
- iselected = iflag_attenuation_store(i,j,k,ispec)
- endif
-
- factor_loc = mustore(i,j,k,ispec) * factor_common(iselected,i_sls)
-
- alphaval_loc = alphaval(iselected,i_sls)
- betaval_loc = betaval(iselected,i_sls)
- gammaval_loc = gammaval(iselected,i_sls)
-
- ! term in xx
- Sn = factor_loc * epsilondev_xx(i,j,k,ispec)
- Snp1 = factor_loc * epsilondev_xx_loc(i,j,k)
- R_xx(i,j,k,ispec,i_sls) = alphaval_loc * R_xx(i,j,k,ispec,i_sls) + &
- betaval_loc * Sn + gammaval_loc * Snp1
-
- ! term in yy
- Sn = factor_loc * epsilondev_yy(i,j,k,ispec)
- Snp1 = factor_loc * epsilondev_yy_loc(i,j,k)
- R_yy(i,j,k,ispec,i_sls) = alphaval_loc * R_yy(i,j,k,ispec,i_sls) + &
- betaval_loc * Sn + gammaval_loc * Snp1
-
- ! term in zz not computed since zero trace
-
- ! term in xy
- Sn = factor_loc * epsilondev_xy(i,j,k,ispec)
- Snp1 = factor_loc * epsilondev_xy_loc(i,j,k)
- R_xy(i,j,k,ispec,i_sls) = alphaval_loc * R_xy(i,j,k,ispec,i_sls) + &
- betaval_loc * Sn + gammaval_loc * Snp1
-
- ! term in xz
- Sn = factor_loc * epsilondev_xz(i,j,k,ispec)
- Snp1 = factor_loc * epsilondev_xz_loc(i,j,k)
- R_xz(i,j,k,ispec,i_sls) = alphaval_loc * R_xz(i,j,k,ispec,i_sls) + &
- betaval_loc * Sn + gammaval_loc * Snp1
-
- ! term in yz
- Sn = factor_loc * epsilondev_yz(i,j,k,ispec)
- Snp1 = factor_loc * epsilondev_yz_loc(i,j,k)
- R_yz(i,j,k,ispec,i_sls) = alphaval_loc * R_yz(i,j,k,ispec,i_sls) + &
- betaval_loc * Sn + gammaval_loc * Snp1
-
- enddo ! end of loop on memory variables
-
- endif ! end attenuation
-
-
- enddo
- enddo
- enddo
-
- ! save deviatoric strain for Runge-Kutta scheme
- if ( COMPUTE_AND_STORE_STRAIN ) then
- epsilondev_xx(:,:,:,ispec) = epsilondev_xx_loc(:,:,:)
- epsilondev_yy(:,:,:,ispec) = epsilondev_yy_loc(:,:,:)
- epsilondev_xy(:,:,:,ispec) = epsilondev_xy_loc(:,:,:)
- epsilondev_xz(:,:,:,ispec) = epsilondev_xz_loc(:,:,:)
- epsilondev_yz(:,:,:,ispec) = epsilondev_yz_loc(:,:,:)
- endif
-
- enddo ! spectral element loop
-
-
-end subroutine compute_forces_elastic_noDev
-
Deleted: seismo/3D/SPECFEM3D/trunk/compute_gradient.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_gradient.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_gradient.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,115 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-
-subroutine compute_gradient(ispec,NSPEC_AB,NGLOB_AB, &
- scalar_field, vector_field_element,&
- hprime_xx,hprime_yy,hprime_zz, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
- ibool,rhostore)
-
-! calculates gradient of given acoustic scalar (potential) field on all GLL points in one, single element
-! note:
-! displacement s = (rho)^{-1} \del \chi
-! velocity v = (rho)^{-1} \del \ddot \chi
-!
-! returns: (1/rho) times gradient vector field (vector_field_element) in specified element
-
- implicit none
- include 'constants.h'
-
- integer,intent(in) :: ispec,NSPEC_AB,NGLOB_AB
-
- real(kind=CUSTOM_REAL),dimension(NGLOB_AB),intent(in) :: scalar_field
-
- real(kind=CUSTOM_REAL),dimension(NDIM,NGLLX,NGLLY,NGLLZ),intent(out) :: vector_field_element
-
- integer,dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB):: ibool
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: rhostore
-
-! array with derivatives of Lagrange polynomials
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLY) :: hprime_yy
- real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz
-
-! local parameters
- real(kind=CUSTOM_REAL) xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl
- real(kind=CUSTOM_REAL) temp1l,temp2l,temp3l
- real(kind=CUSTOM_REAL) rho_invl
- integer :: i,j,k,l
-
-! double loop over GLL points to compute and store gradients
- vector_field_element(:,:,:,:) = 0._CUSTOM_REAL
-
- do k= 1,NGLLZ
- do j = 1,NGLLY
- do i = 1,NGLLX
-
- ! derivative along x
- temp1l = ZERO
- do l = 1,NGLLX
- temp1l = temp1l + scalar_field(ibool(l,j,k,ispec))*hprime_xx(i,l)
- enddo
-
- ! derivative along y
- temp2l = ZERO
- do l = 1,NGLLZ
- temp2l = temp2l + scalar_field(ibool(i,l,k,ispec))*hprime_yy(j,l)
- enddo
-
- ! derivative along z
- temp3l = ZERO
- do l = 1,NGLLZ
- temp3l = temp3l + scalar_field(ibool(i,j,l,ispec))*hprime_zz(k,l)
- enddo
-
- xixl = xix(i,j,k,ispec)
- xiyl = xiy(i,j,k,ispec)
- xizl = xiz(i,j,k,ispec)
- etaxl = etax(i,j,k,ispec)
- etayl = etay(i,j,k,ispec)
- etazl = etaz(i,j,k,ispec)
- gammaxl = gammax(i,j,k,ispec)
- gammayl = gammay(i,j,k,ispec)
- gammazl = gammaz(i,j,k,ispec)
-
- rho_invl = 1.0_CUSTOM_REAL / rhostore(i,j,k,ispec)
-
- ! derivatives of acoustic scalar potential field on GLL points
- vector_field_element(1,i,j,k) = (temp1l*xixl + temp2l*etaxl + temp3l*gammaxl) * rho_invl
- vector_field_element(2,i,j,k) = (temp1l*xiyl + temp2l*etayl + temp3l*gammayl) * rho_invl
- vector_field_element(3,i,j,k) = (temp1l*xizl + temp2l*etazl + temp3l*gammazl) * rho_invl
-
- enddo
- enddo
- enddo
-
-end subroutine compute_gradient
-
-
Deleted: seismo/3D/SPECFEM3D/trunk/compute_interpolated_dva.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_interpolated_dva.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_interpolated_dva.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,211 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-
-subroutine compute_interpolated_dva(displ,veloc,accel,NGLOB_AB, &
- ispec,NSPEC_AB,ibool, &
- xi_r,eta_r,gamma_r, &
- hxir,hetar,hgammar, &
- dxd,dyd,dzd,vxd,vyd,vzd,axd,ayd,azd)
-
-! returns displacement/velocity/acceleration (dxd,..,vxd,..,axd,.. ) at receiver location
-
- implicit none
- include 'constants.h'
-
- double precision,intent(out) :: dxd,dyd,dzd,vxd,vyd,vzd,axd,ayd,azd
-
- integer :: ispec
-
- integer :: NSPEC_AB,NGLOB_AB
- real(kind=CUSTOM_REAL),dimension(NDIM,NGLOB_AB) :: displ,veloc,accel
- integer,dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB):: ibool
-
- ! receiver information
- double precision :: xi_r,eta_r,gamma_r
- double precision,dimension(NGLLX) :: hxir
- double precision,dimension(NGLLY) :: hetar
- double precision,dimension(NGLLZ) :: hgammar
-
-! local parameters
- double precision :: hlagrange
- integer :: i,j,k,iglob
-
-! perform the general interpolation using Lagrange polynomials
- dxd = ZERO
- dyd = ZERO
- dzd = ZERO
- vxd = ZERO
- vyd = ZERO
- vzd = ZERO
- axd = ZERO
- ayd = ZERO
- azd = ZERO
-
-! takes closest GLL point only (no interpolation)
- if(FASTER_RECEIVERS_POINTS_ONLY) then
-
- iglob = ibool(nint(xi_r),nint(eta_r),nint(gamma_r),ispec)
-
- ! displacement
- dxd = dble(displ(1,iglob))
- dyd = dble(displ(2,iglob))
- dzd = dble(displ(3,iglob))
- ! velocity
- vxd = dble(veloc(1,iglob))
- vyd = dble(veloc(2,iglob))
- vzd = dble(veloc(3,iglob))
- ! acceleration
- axd = dble(accel(1,iglob))
- ayd = dble(accel(2,iglob))
- azd = dble(accel(3,iglob))
-
- else
-
-! interpolates seismograms at exact receiver locations
- do k = 1,NGLLZ
- do j = 1,NGLLY
- do i = 1,NGLLX
- iglob = ibool(i,j,k,ispec)
-
- hlagrange = hxir(i)*hetar(j)*hgammar(k)
-
- ! displacement
- dxd = dxd + dble(displ(1,iglob))*hlagrange
- dyd = dyd + dble(displ(2,iglob))*hlagrange
- dzd = dzd + dble(displ(3,iglob))*hlagrange
- ! velocity
- vxd = vxd + dble(veloc(1,iglob))*hlagrange
- vyd = vyd + dble(veloc(2,iglob))*hlagrange
- vzd = vzd + dble(veloc(3,iglob))*hlagrange
- ! acceleration
- axd = axd + dble(accel(1,iglob))*hlagrange
- ayd = ayd + dble(accel(2,iglob))*hlagrange
- azd = azd + dble(accel(3,iglob))*hlagrange
-
- enddo
- enddo
- enddo
-
- endif
-
-end subroutine compute_interpolated_dva
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine compute_interpolated_dva_ac(displ_element,veloc_element,&
- potential_dot_dot_acoustic,NGLOB_AB, &
- ispec,NSPEC_AB,ibool, &
- xi_r,eta_r,gamma_r, &
- hxir,hetar,hgammar, &
- dxd,dyd,dzd,vxd,vyd,vzd,axd,ayd,azd)
-
-! acoustic elements
-! returns displacement/velocity/pressure (dxd,..,vxd,..,axd,.. ) at receiver location
-
- implicit none
- include 'constants.h'
-
- double precision,intent(out) :: dxd,dyd,dzd,vxd,vyd,vzd,axd,ayd,azd
-
- integer :: ispec
-
- integer :: NSPEC_AB,NGLOB_AB
- real(kind=CUSTOM_REAL),dimension(NDIM,NGLLX,NGLLY,NGLLZ):: displ_element,veloc_element
- real(kind=CUSTOM_REAL),dimension(NGLOB_AB) :: potential_dot_dot_acoustic
-
- integer,dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB):: ibool
-
- ! receiver information
- double precision :: xi_r,eta_r,gamma_r
- double precision,dimension(NGLLX) :: hxir
- double precision,dimension(NGLLY) :: hetar
- double precision,dimension(NGLLZ) :: hgammar
-
-! local parameters
- double precision :: hlagrange
- integer :: i,j,k,iglob
-
-! perform the general interpolation using Lagrange polynomials
- dxd = ZERO
- dyd = ZERO
- dzd = ZERO
- vxd = ZERO
- vyd = ZERO
- vzd = ZERO
- axd = ZERO
- ayd = ZERO
- azd = ZERO
-
-! takes closest GLL point only (no interpolation)
- if(FASTER_RECEIVERS_POINTS_ONLY) then
-
- ! displacement
- dxd = displ_element(1,nint(xi_r),nint(eta_r),nint(gamma_r))
- dyd = displ_element(2,nint(xi_r),nint(eta_r),nint(gamma_r))
- dzd = displ_element(3,nint(xi_r),nint(eta_r),nint(gamma_r))
- ! velocity
- vxd = veloc_element(1,nint(xi_r),nint(eta_r),nint(gamma_r))
- vyd = veloc_element(2,nint(xi_r),nint(eta_r),nint(gamma_r))
- vzd = veloc_element(3,nint(xi_r),nint(eta_r),nint(gamma_r))
-
- ! pressure
- iglob = ibool(nint(xi_r),nint(eta_r),nint(gamma_r),ispec)
- axd = - potential_dot_dot_acoustic(iglob)
- ayd = - potential_dot_dot_acoustic(iglob)
- azd = - potential_dot_dot_acoustic(iglob)
-
- else
-
-! interpolates seismograms at exact receiver locations
- do k = 1,NGLLZ
- do j = 1,NGLLY
- do i = 1,NGLLX
- iglob = ibool(i,j,k,ispec)
-
- hlagrange = hxir(i)*hetar(j)*hgammar(k)
-
- ! displacement
- dxd = dxd + hlagrange*displ_element(1,i,j,k)
- dyd = dyd + hlagrange*displ_element(2,i,j,k)
- dzd = dzd + hlagrange*displ_element(3,i,j,k)
- ! velocity
- vxd = vxd + hlagrange*veloc_element(1,i,j,k)
- vyd = vxd + hlagrange*veloc_element(2,i,j,k)
- vzd = vxd + hlagrange*veloc_element(3,i,j,k)
- ! pressure
- axd = axd - hlagrange*potential_dot_dot_acoustic(iglob)
- ayd = ayd - hlagrange*potential_dot_dot_acoustic(iglob)
- azd = azd - hlagrange*potential_dot_dot_acoustic(iglob)
-
- enddo
- enddo
- enddo
-
- endif
-
-end subroutine compute_interpolated_dva_ac
Deleted: seismo/3D/SPECFEM3D/trunk/compute_kernels.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_kernels.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_kernels.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,141 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine compute_kernels()
-
-! kernel calculations
-! see e.g. Tromp et al. (2005)
-
- use specfem_par
- use specfem_par_elastic
- use specfem_par_acoustic
-
- implicit none
- ! local parameters
- real(kind=CUSTOM_REAL),dimension(NDIM,NGLLX,NGLLY,NGLLZ):: b_displ_elm,accel_elm
- real(kind=CUSTOM_REAL) :: kappal
- integer :: i,j,k,ispec,iglob
- real(kind=CUSTOM_REAL), dimension(5) :: epsilondev_loc,b_epsilondev_loc
-
- ! updates kernels
- do ispec = 1, NSPEC_AB
-
- ! elastic domains
- if( ispec_is_elastic(ispec) ) then
-
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
- iglob = ibool(i,j,k,ispec)
-
- ! isotropic kernels
- ! note: takes displacement from backward/reconstructed (forward) field b_displ
- ! and acceleration from adjoint field accel (containing adjoint sources)
- !
- ! note: : time integral summation uses deltat
- !
- ! compare with Tromp et al. (2005), eq. (14), which takes adjoint displacement
- ! and forward acceleration, that is the symmetric form of what is calculated here
- ! however, this kernel expression is symmetric with regards
- ! to interchange adjoint - forward field
- rho_kl(i,j,k,ispec) = rho_kl(i,j,k,ispec) &
- + deltat * dot_product(accel(:,iglob), b_displ(:,iglob))
-
- ! kernel for shear modulus, see e.g. Tromp et al. (2005), equation (17)
- ! note: multiplication with 2*mu(x) will be done after the time loop
- epsilondev_loc(1) = epsilondev_xx(i,j,k,ispec)
- epsilondev_loc(2) = epsilondev_yy(i,j,k,ispec)
- epsilondev_loc(3) = epsilondev_xy(i,j,k,ispec)
- epsilondev_loc(4) = epsilondev_xz(i,j,k,ispec)
- epsilondev_loc(5) = epsilondev_yz(i,j,k,ispec)
-
- b_epsilondev_loc(1) = b_epsilondev_xx(i,j,k,ispec)
- b_epsilondev_loc(2) = b_epsilondev_yy(i,j,k,ispec)
- b_epsilondev_loc(3) = b_epsilondev_xy(i,j,k,ispec)
- b_epsilondev_loc(4) = b_epsilondev_xz(i,j,k,ispec)
- b_epsilondev_loc(5) = b_epsilondev_yz(i,j,k,ispec)
-
- mu_kl(i,j,k,ispec) = mu_kl(i,j,k,ispec) &
- + deltat * (epsilondev_loc(1)*b_epsilondev_loc(1) + epsilondev_loc(2)*b_epsilondev_loc(2) &
- + (epsilondev_loc(1)+epsilondev_loc(2)) * (b_epsilondev_loc(1)+b_epsilondev_loc(2)) &
- + 2 * (epsilondev_loc(3)*b_epsilondev_loc(3) + epsilondev_loc(4)*b_epsilondev_loc(4) + &
- epsilondev_loc(5)*b_epsilondev_loc(5)) )
-
- ! kernel for bulk modulus, see e.g. Tromp et al. (2005), equation (18)
- ! note: multiplication with kappa(x) will be done after the time loop
- kappa_kl(i,j,k,ispec) = kappa_kl(i,j,k,ispec) &
- + deltat * (9 * epsilon_trace_over_3(i,j,k,ispec) &
- * b_epsilon_trace_over_3(i,j,k,ispec))
-
- enddo
- enddo
- enddo
- endif !ispec_is_elastic
-
- ! acoustic domains
- if( ispec_is_acoustic(ispec) ) then
-
- ! backward fields: displacement vector
- call compute_gradient(ispec,NSPEC_ADJOINT,NGLOB_ADJOINT, &
- b_potential_acoustic, b_displ_elm,&
- hprime_xx,hprime_yy,hprime_zz, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
- ibool,rhostore)
- ! adjoint fields: acceleration vector
- call compute_gradient(ispec,NSPEC_AB,NGLOB_AB, &
- potential_dot_dot_acoustic, accel_elm,&
- hprime_xx,hprime_yy,hprime_zz, &
- xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
- ibool,rhostore)
-
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
- iglob = ibool(i,j,k,ispec)
-
- ! density kernel
- rho_ac_kl(i,j,k,ispec) = rho_ac_kl(i,j,k,ispec) &
- - deltat * dot_product(accel_elm(:,i,j,k), b_displ_elm(:,i,j,k))
-
- ! bulk modulus kernel
- kappal = kappastore(i,j,k,ispec)
- kappa_ac_kl(i,j,k,ispec) = kappa_ac_kl(i,j,k,ispec) &
- - deltat / kappal &
- * potential_dot_dot_acoustic(iglob) &
- * b_potential_dot_dot_acoustic(iglob)
-
- enddo
- enddo
- enddo
- endif ! ispec_is_acoustic
-
- enddo
-
- ! moho kernel
- if( ELASTIC_SIMULATION .and. SAVE_MOHO_MESH ) then
- call compute_boundary_kernel()
- endif
-
- end subroutine compute_kernels
Deleted: seismo/3D/SPECFEM3D/trunk/compute_parameters.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_parameters.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_parameters.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,264 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine compute_parameters(NER,NEX_XI,NEX_ETA,NPROC_XI,NPROC_ETA, &
- NPROC,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
- NER_BOTTOM_MOHO,NER_MOHO_16,NER_16_BASEMENT,NER_BASEMENT_SEDIM,NER_SEDIM, &
- 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)
-
- implicit none
-
- include "constants.h"
-
-! parameters read from parameter file
- integer NEX_XI,NEX_ETA,NPROC_XI,NPROC_ETA
- integer NER_BOTTOM_MOHO,NER_MOHO_16,NER_16_BASEMENT,NER_BASEMENT_SEDIM,NER_SEDIM
-
-! parameters to be computed based upon parameters above read from file
- integer NPROC,NEX_PER_PROC_XI,NEX_PER_PROC_ETA,NER
-
- integer 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
-
- integer NEX_DOUBLING_SEDIM_XI,NEX_DOUBLING_SEDIM_ETA
- integer NEX_DOUBLING_SEDIM_PER_PROC_XI,NEX_DOUBLING_SEDIM_PER_PROC_ETA
- integer NSPEC2D_DOUBLING_A_XI,NSPEC2D_DOUBLING_A_ETA
- integer NSPEC2D_DOUBLING_B_XI,NSPEC2D_DOUBLING_B_ETA
- integer NSPEC_DOUBLING_AB
- integer NUM_DOUBLING_BRICKS
- integer NUM2D_DOUBLING_BRICKS_XI,NUM2D_DOUBLING_BRICKS_ETA
- integer nglob_no_doubling_volume,nglob_no_doubling_surface
- integer nblocks_xi,nblocks_eta
- integer nglob_surface_typeA,nglob_surface_typeB
- integer NSPEC1D_RADIAL_BEDROCK,NPOIN1D_RADIAL_BEDROCK
-
- integer NSPEC_NO_DOUBLING,NSPEC2D_NO_DOUBLING_XI,NSPEC2D_NO_DOUBLING_ETA
-
- logical USE_REGULAR_MESH
-
-!
-!--- case of a regular mesh
-!
- if(USE_REGULAR_MESH) then
-
-! total number of spectral elements along radius
- NER = NER_SEDIM
-
-! number of elements horizontally in each slice (i.e. per processor)
-! these two values MUST be equal in all cases
- NEX_PER_PROC_XI = NEX_XI / NPROC_XI
- NEX_PER_PROC_ETA = NEX_ETA / NPROC_ETA
-
-! total number of processors in each of the six chunks
- NPROC = NPROC_XI * NPROC_ETA
-
-! exact number of spectral elements without doubling layers
- NSPEC_NO_DOUBLING = NEX_XI*NEX_ETA*NER_SEDIM
-
-! %%%%%%%%%%%%%% surface elements %%%%%%%%%%%%%%%%%%%
-
-! exact number of surface elements for a chunk without doubling layers
-
- NSPEC2D_NO_DOUBLING_XI = NEX_PER_PROC_XI*NER_SEDIM
-
- NSPEC2D_NO_DOUBLING_ETA = NEX_PER_PROC_ETA*NER_SEDIM
-
-! exact number of spectral elements
- NSPEC_AB = NSPEC_NO_DOUBLING / NPROC
-
-! exact number of surface elements for faces A and B along XI and ETA
- NSPEC2D_A_XI = NSPEC2D_NO_DOUBLING_XI
- NSPEC2D_B_XI = NSPEC2D_NO_DOUBLING_XI
- NSPEC2D_A_ETA = NSPEC2D_NO_DOUBLING_ETA
- NSPEC2D_B_ETA = NSPEC2D_NO_DOUBLING_ETA
-
-! exact number of surface elements on the bottom and top boundaries
-! and theoretical number of spectral elements in radial direction
-
- NSPEC2D_TOP = NEX_XI*NEX_ETA / NPROC
- NSPEC2D_BOTTOM = NSPEC2D_TOP
-
- NSPEC1D_RADIAL_BEDROCK = NER
-
-! face with max number of elements is type B here
-! maximum number of surface elements on vertical boundaries of the slices
- NSPEC2DMAX_XMIN_XMAX = NSPEC2D_B_ETA
- NSPEC2DMAX_YMIN_YMAX = NSPEC2D_B_XI
-
-! 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*NGLLY*NGLLZ + 1
- NPOIN2DMAX_YMIN_YMAX = NSPEC2DMAX_YMIN_YMAX*NGLLX*NGLLZ + 1
-
-! exact number of global points
- NGLOB_AB = (NEX_PER_PROC_XI*(NGLLX-1)+1) * (NEX_PER_PROC_ETA*(NGLLY-1)+1) * (NER*(NGLLZ-1)+1)
-
-!
-!--- case of a non-regular mesh with mesh doublings
-!
- else
-
-! total number of spectral elements along radius
- NER = NER_BOTTOM_MOHO + NER_MOHO_16 + NER_16_BASEMENT + NER_BASEMENT_SEDIM + NER_SEDIM
-
-! number of elements horizontally in each slice (i.e. per processor)
-! these two values MUST be equal in all cases
- NEX_PER_PROC_XI = NEX_XI / NPROC_XI
- NEX_PER_PROC_ETA = NEX_ETA / NPROC_ETA
-
-! total number of processors in each of the six chunks
- NPROC = NPROC_XI * NPROC_ETA
-
-! number of spectral elements at the bottom of the doubling below the moho
- NEX_DOUBLING_SEDIM_XI=NEX_XI/2
- NEX_DOUBLING_SEDIM_ETA=NEX_ETA/2
- NEX_DOUBLING_SEDIM_PER_PROC_XI=NEX_PER_PROC_XI/2
- NEX_DOUBLING_SEDIM_PER_PROC_ETA=NEX_PER_PROC_ETA/2
-
-! exact number of spectral elements without doubling layers
- NSPEC_NO_DOUBLING = &
- (NEX_DOUBLING_SEDIM_XI*NEX_DOUBLING_SEDIM_ETA*(NER_BASEMENT_SEDIM/2-3) &
- +(NEX_XI/4)*(NEX_ETA/4)*(NER_16_BASEMENT/2-3) &
- +(NEX_XI/4)*(NEX_ETA/4)*(NER_MOHO_16/2) &
- +(NEX_XI/4)*(NEX_ETA/4)*(NER_BOTTOM_MOHO/4)) + NEX_XI*NEX_ETA*NER_SEDIM
-
-! exact number of spectral elements in the doubling regions
-
-! number of elementary bricks in the two regions with doubling
- NUM_DOUBLING_BRICKS = ((NEX_XI/4)*(NEX_ETA/4) &
- +NEX_DOUBLING_SEDIM_XI*NEX_DOUBLING_SEDIM_ETA)/4
-
-! for type AB, each doubling brick contains 40 elements on 3 levels
- NSPEC_DOUBLING_AB=40*NUM_DOUBLING_BRICKS
-
-! %%%%%%%%%%%%%% surface elements %%%%%%%%%%%%%%%%%%%
-
-! exact number of surface elements for a chunk without doubling layers
-
- NSPEC2D_NO_DOUBLING_XI = &
- NEX_DOUBLING_SEDIM_PER_PROC_XI*(NER_BASEMENT_SEDIM/2-3) &
- +(NEX_PER_PROC_XI/4)*(NER_16_BASEMENT/2-3) &
- +(NEX_PER_PROC_XI/4)*(NER_MOHO_16/2) &
- +(NEX_PER_PROC_XI/4)*(NER_BOTTOM_MOHO/4) + NEX_PER_PROC_XI*NER_SEDIM
-
- NSPEC2D_NO_DOUBLING_ETA = &
- NEX_DOUBLING_SEDIM_PER_PROC_ETA*(NER_BASEMENT_SEDIM/2-3) &
- +(NEX_PER_PROC_ETA/4)*(NER_16_BASEMENT/2-3) &
- +(NEX_PER_PROC_ETA/4)*(NER_MOHO_16/2) &
- +(NEX_PER_PROC_ETA/4)*(NER_BOTTOM_MOHO/4) + NEX_PER_PROC_ETA*NER_SEDIM
-
-! 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) &
- +NEX_DOUBLING_SEDIM_PER_PROC_XI)/2
-
- NUM2D_DOUBLING_BRICKS_ETA = ((NEX_PER_PROC_ETA/4) &
- +NEX_DOUBLING_SEDIM_PER_PROC_ETA)/2
-
-! for type A, each doubling brick contains 10 elements on 3 levels
- NSPEC2D_DOUBLING_A_XI=10*NUM2D_DOUBLING_BRICKS_XI
- NSPEC2D_DOUBLING_A_ETA=10*NUM2D_DOUBLING_BRICKS_ETA
-
-! for type B, each doubling brick contains 12 elements on 3 levels
- NSPEC2D_DOUBLING_B_XI=12*NUM2D_DOUBLING_BRICKS_XI
- NSPEC2D_DOUBLING_B_ETA=12*NUM2D_DOUBLING_BRICKS_ETA
-
-! exact number of spectral elements
- NSPEC_AB = (NSPEC_NO_DOUBLING + NSPEC_DOUBLING_AB) / NPROC
-
-! exact number of surface elements for faces A and B
-! along XI and ETA for doubling region
- NSPEC2D_A_XI = NSPEC2D_NO_DOUBLING_XI + NSPEC2D_DOUBLING_A_XI
- NSPEC2D_B_XI = NSPEC2D_NO_DOUBLING_XI + NSPEC2D_DOUBLING_B_XI
- NSPEC2D_A_ETA = NSPEC2D_NO_DOUBLING_ETA + NSPEC2D_DOUBLING_A_ETA
- NSPEC2D_B_ETA = NSPEC2D_NO_DOUBLING_ETA + NSPEC2D_DOUBLING_B_ETA
-
-! exact number of surface elements on the bottom and top boundaries
-! and theoretical number of spectral elements in radial direction
-
- NSPEC2D_TOP = NEX_XI*NEX_ETA / NPROC
- NSPEC2D_BOTTOM = (NEX_XI/4)*(NEX_ETA/4) / NPROC
-
- NSPEC1D_RADIAL_BEDROCK = (NER_BASEMENT_SEDIM+NER_16_BASEMENT+NER_MOHO_16)/2 + NER_BOTTOM_MOHO/4
-
-! face with max number of elements is type B here
-! maximum number of surface elements on vertical boundaries of the slices
- NSPEC2DMAX_XMIN_XMAX = NSPEC2D_B_ETA
- NSPEC2DMAX_YMIN_YMAX = NSPEC2D_B_XI
-
-! 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*NGLLY*NGLLZ + 1
- NPOIN2DMAX_YMIN_YMAX = NSPEC2DMAX_YMIN_YMAX*NGLLX*NGLLZ + 1
-
-! exact number of global points
-
-! case of the doubling regions
-! formulas computed using Mathematica for the basic 3D doubling brick
-
-! compute number of points in blocks with no doubling
-! exclude the three surfaces in contact with the doubling regions
- nglob_no_doubling_volume = (4*(NGLLX-1)+1)*(4*(NGLLX-1)+1)*((NER_BASEMENT_SEDIM/2-3 )*(NGLLX-1)-1) &
- +(2*(NGLLX-1)+1)*(2*(NGLLX-1)+1)*(((NER_16_BASEMENT/2+NER_MOHO_16/2+NER_BOTTOM_MOHO/4)-3)*(NGLLX-1)+0)
-
-! number of basic blocks in each slice
- nblocks_xi = NEX_PER_PROC_XI / 8
- nblocks_eta = NEX_PER_PROC_ETA / 8
-
- NGLOB_AB = nblocks_xi*nblocks_eta*(200*NGLLX**3 - 484*NGLLX**2 + 392*NGLLX - 106 + nglob_no_doubling_volume)
-
-! same thing for 2D surfaces for the three types of faces
- nglob_no_doubling_surface = (4*(NGLLX-1)+1)*((NER_BASEMENT_SEDIM/2-3)*(NGLLX-1)-1) &
- +(2*(NGLLX-1)+1)*(((NER_16_BASEMENT/2+NER_MOHO_16/2+NER_BOTTOM_MOHO/4)-3)*(NGLLX-1)+0)
-
- nglob_surface_typeA = 30*NGLLX**2 - 45 * NGLLX + 17
- nglob_surface_typeB = 36*NGLLX**2 - 57 * NGLLX + 23
-
-! final number of points in volume obtained by removing planes counted twice
- NGLOB_AB = NGLOB_AB &
- - (nblocks_xi-1)*nblocks_eta*(nglob_surface_typeA + nglob_no_doubling_surface) &
- - (nblocks_eta-1)*nblocks_xi*(nglob_surface_typeB + nglob_no_doubling_surface) &
- + (nblocks_eta-1)*(nblocks_xi-1)*NPOIN1D_RADIAL_BEDROCK
-
-! add number of points in the sediments
- NGLOB_AB = NGLOB_AB + (NEX_PER_PROC_XI*(NGLLX-1)+1) &
- *(NEX_PER_PROC_ETA*(NGLLY-1)+1)*(NER_SEDIM*(NGLLZ-1)+0)
-
- endif ! end of section for non-regular mesh with doublings
-
- end subroutine compute_parameters
-
Deleted: seismo/3D/SPECFEM3D/trunk/compute_stacey_acoustic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_stacey_acoustic.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_stacey_acoustic.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,133 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-! for acoustic solver
-
- subroutine compute_stacey_acoustic(NSPEC_AB,NGLOB_AB, &
- potential_dot_dot_acoustic,potential_dot_acoustic, &
- ibool,ispec_is_inner,phase_is_inner, &
- abs_boundary_jacobian2Dw,abs_boundary_ijk,abs_boundary_ispec, &
- num_abs_boundary_faces,rhostore,kappastore,ispec_is_acoustic,&
- SIMULATION_TYPE,SAVE_FORWARD,NSTEP,it,myrank,NGLOB_ADJOINT, &
- b_potential_dot_dot_acoustic,b_reclen_potential, &
- b_absorb_potential,b_num_abs_boundary_faces)
-
- implicit none
-
- include "constants.h"
-
- integer :: NSPEC_AB,NGLOB_AB
-
-! potentials
- real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: potential_dot_dot_acoustic,&
- potential_dot_acoustic
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
-! communication overlap
- logical, dimension(NSPEC_AB) :: ispec_is_inner
- logical :: phase_is_inner
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: rhostore,kappastore
- logical, dimension(NSPEC_AB) :: ispec_is_acoustic
-
-! absorbing boundary surface
- integer :: num_abs_boundary_faces
- real(kind=CUSTOM_REAL) :: abs_boundary_jacobian2Dw(NGLLSQUARE,num_abs_boundary_faces)
- integer :: abs_boundary_ijk(3,NGLLSQUARE,num_abs_boundary_faces)
- integer :: abs_boundary_ispec(num_abs_boundary_faces)
-
-! adjoint simulations
- integer:: SIMULATION_TYPE
- integer:: NSTEP,it,myrank,NGLOB_ADJOINT
- integer:: b_num_abs_boundary_faces,b_reclen_potential
- real(kind=CUSTOM_REAL),dimension(NGLOB_ADJOINT) :: b_potential_dot_dot_acoustic
- real(kind=CUSTOM_REAL),dimension(NGLLSQUARE,b_num_abs_boundary_faces):: b_absorb_potential
- logical:: SAVE_FORWARD
-
-! local parameters
- real(kind=CUSTOM_REAL) :: rhol,cpl,jacobianw
- integer :: ispec,iglob,i,j,k,iface,igll
- !adjoint locals
- integer:: reclen1,reclen2
-
-! adjoint simulations:
- if (SIMULATION_TYPE == 3 .and. num_abs_boundary_faces > 0) then
- ! the index NSTEP-it+1 is valid if b_displ is read in after the Newark scheme
- read(IOABS_AC,rec=NSTEP-it+1) reclen1,b_absorb_potential,reclen2
- if (reclen1 /= b_reclen_potential .or. reclen1 /= reclen2) &
- call exit_mpi(myrank,'Error reading absorbing contribution b_absorb_potential')
- endif !adjoint
-
-! absorbs absorbing-boundary surface using Sommerfeld condition (vanishing field in the outer-space)
- do iface=1,num_abs_boundary_faces
-
- ispec = abs_boundary_ispec(iface)
-
- if (ispec_is_inner(ispec) .eqv. phase_is_inner) then
-
- if( ispec_is_acoustic(ispec) ) then
-
- ! reference gll points on boundary face
- do igll = 1,NGLLSQUARE
-
- ! gets local indices for GLL point
- i = abs_boundary_ijk(1,igll,iface)
- j = abs_boundary_ijk(2,igll,iface)
- k = abs_boundary_ijk(3,igll,iface)
-
- ! gets global index
- iglob=ibool(i,j,k,ispec)
-
- ! determines bulk sound speed
- rhol = rhostore(i,j,k,ispec)
- cpl = sqrt( kappastore(i,j,k,ispec) / rhol )
-
- ! gets associated, weighted jacobian
- jacobianw = abs_boundary_jacobian2Dw(igll,iface)
-
- ! Sommerfeld condition
- potential_dot_dot_acoustic(iglob) = potential_dot_dot_acoustic(iglob) &
- - potential_dot_acoustic(iglob) * jacobianw / cpl / rhol
-
-
- ! adjoint simulations
- if (SIMULATION_TYPE == 3) then
- b_potential_dot_dot_acoustic(iglob) = b_potential_dot_dot_acoustic(iglob) &
- - b_absorb_potential(igll,iface)
- else if (SIMULATION_TYPE == 1 .and. SAVE_FORWARD) then
- b_absorb_potential(igll,iface) = potential_dot_acoustic(iglob) * jacobianw / cpl / rhol
- endif !adjoint
-
- enddo
-
- endif ! ispec_is_acoustic
- endif ! ispec_is_inner
- enddo ! num_abs_boundary_faces
-
- ! adjoint simulations: stores absorbed wavefield part
- if (SIMULATION_TYPE == 1 .and. SAVE_FORWARD .and. num_abs_boundary_faces > 0 ) &
- write(IOABS_AC,rec=it) b_reclen_potential,b_absorb_potential,b_reclen_potential
-
- end subroutine compute_stacey_acoustic
Deleted: seismo/3D/SPECFEM3D/trunk/compute_stacey_elastic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/compute_stacey_elastic.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/compute_stacey_elastic.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,156 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-! for elastic solver
-
-! absorbing boundary term for elastic media (Stacey conditions)
-
- subroutine compute_stacey_elastic(NSPEC_AB,NGLOB_AB,accel, &
- ibool,ispec_is_inner,phase_is_inner, &
- abs_boundary_normal,abs_boundary_jacobian2Dw, &
- abs_boundary_ijk,abs_boundary_ispec, &
- num_abs_boundary_faces, &
- veloc,rho_vp,rho_vs, &
- ispec_is_elastic,SIMULATION_TYPE,myrank,SAVE_FORWARD, &
- NSTEP,it,NGLOB_ADJOINT,b_accel, &
- b_num_abs_boundary_faces,b_reclen_field,b_absorb_field)
-
- implicit none
-
- include "constants.h"
-
- integer :: NSPEC_AB,NGLOB_AB
-
-! acceleration
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: accel
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
-! communication overlap
- logical, dimension(NSPEC_AB) :: ispec_is_inner
- logical :: phase_is_inner
-
-! Stacey conditions
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: veloc
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: rho_vp,rho_vs
-
- logical, dimension(NSPEC_AB) :: ispec_is_elastic
-
-! absorbing boundary surface
- integer :: num_abs_boundary_faces
- real(kind=CUSTOM_REAL) :: abs_boundary_normal(NDIM,NGLLSQUARE,num_abs_boundary_faces)
- real(kind=CUSTOM_REAL) :: abs_boundary_jacobian2Dw(NGLLSQUARE,num_abs_boundary_faces)
- integer :: abs_boundary_ijk(3,NGLLSQUARE,num_abs_boundary_faces)
- integer :: abs_boundary_ispec(num_abs_boundary_faces)
-
-! adjoint simulations
- integer:: SIMULATION_TYPE
- integer:: NSTEP,it,myrank,NGLOB_ADJOINT
- integer:: b_num_abs_boundary_faces,b_reclen_field
- real(kind=CUSTOM_REAL),dimension(NDIM,NGLLSQUARE,b_num_abs_boundary_faces):: b_absorb_field
-
- real(kind=CUSTOM_REAL),dimension(NDIM,NGLOB_ADJOINT):: b_accel
- logical:: SAVE_FORWARD
-
-! local parameters
- real(kind=CUSTOM_REAL) vx,vy,vz,nx,ny,nz,tx,ty,tz,vn,jacobianw
- integer :: ispec,iglob,i,j,k,iface,igll
-
- !adjoint locals
- integer:: reclen1,reclen2
-
-
-! adjoint simulations:
- if (SIMULATION_TYPE == 3 .and. num_abs_boundary_faces > 0) then
- ! the index NSTEP-it+1 is valid if b_displ is read in after the Newark scheme
- read(IOABS,rec=NSTEP-it+1) reclen1,b_absorb_field,reclen2
- if (reclen1 /= b_reclen_field .or. reclen1 /= reclen2) &
- call exit_mpi(myrank,'Error reading absorbing contribution b_absorb_field')
- endif !adjoint
-
-
-! absorbs absorbing-boundary surface using Stacey condition (Clayton & Enquist)
- do iface=1,num_abs_boundary_faces
-
- ispec = abs_boundary_ispec(iface)
-
- if (ispec_is_inner(ispec) .eqv. phase_is_inner) then
-
- if( ispec_is_elastic(ispec) ) then
-
- ! reference gll points on boundary face
- do igll = 1,NGLLSQUARE
-
- ! gets local indices for GLL point
- i = abs_boundary_ijk(1,igll,iface)
- j = abs_boundary_ijk(2,igll,iface)
- k = abs_boundary_ijk(3,igll,iface)
-
- ! gets velocity
- iglob=ibool(i,j,k,ispec)
- vx=veloc(1,iglob)
- vy=veloc(2,iglob)
- vz=veloc(3,iglob)
-
- ! gets associated normal
- nx = abs_boundary_normal(1,igll,iface)
- ny = abs_boundary_normal(2,igll,iface)
- nz = abs_boundary_normal(3,igll,iface)
-
- ! velocity component in normal direction (normal points out of element)
- vn = vx*nx + vy*ny + vz*nz
-
- ! stacey term: velocity vector component * vp * rho in normal direction + vs * rho component tangential to it
- tx = rho_vp(i,j,k,ispec)*vn*nx + rho_vs(i,j,k,ispec)*(vx-vn*nx)
- ty = rho_vp(i,j,k,ispec)*vn*ny + rho_vs(i,j,k,ispec)*(vy-vn*ny)
- tz = rho_vp(i,j,k,ispec)*vn*nz + rho_vs(i,j,k,ispec)*(vz-vn*nz)
-
- ! gets associated, weighted jacobian
- jacobianw = abs_boundary_jacobian2Dw(igll,iface)
-
- ! adds stacey term (weak form)
- accel(1,iglob) = accel(1,iglob) - tx*jacobianw
- accel(2,iglob) = accel(2,iglob) - ty*jacobianw
- accel(3,iglob) = accel(3,iglob) - tz*jacobianw
-
- ! adjoint simulations
- if (SIMULATION_TYPE == 3) then
- b_accel(:,iglob) = b_accel(:,iglob) - b_absorb_field(:,igll,iface)
- else if (SIMULATION_TYPE == 1 .and. SAVE_FORWARD) then
- b_absorb_field(1,igll,iface) = tx*jacobianw
- b_absorb_field(2,igll,iface) = ty*jacobianw
- b_absorb_field(3,igll,iface) = tz*jacobianw
- endif !adjoint
-
- enddo
- endif ! ispec_is_elastic
- endif ! ispec_is_inner
- enddo
-
- ! adjoint simulations: stores absorbed wavefield part
- if (SIMULATION_TYPE == 1 .and. SAVE_FORWARD .and. num_abs_boundary_faces > 0 ) &
- write(IOABS,rec=it) b_reclen_field,b_absorb_field,b_reclen_field
-
- end subroutine compute_stacey_elastic
-
Modified: seismo/3D/SPECFEM3D/trunk/config.h.in
===================================================================
--- seismo/3D/SPECFEM3D/trunk/config.h.in 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/config.h.in 2010-10-20 12:16:18 UTC (rev 17293)
@@ -18,7 +18,7 @@
the Fortran libraries. */
#undef FC_MAIN
-/* defined if scotch is installed */
+/* defined if Scotch is installed */
#undef HAVE_SCOTCH
/* Define to the address where bug reports for this package should be sent. */
@@ -33,5 +33,8 @@
/* Define to the one symbol short name of this package. */
#undef PACKAGE_TARNAME
+/* Define to the home page for this package. */
+#undef PACKAGE_URL
+
/* Define to the version of this package. */
#undef PACKAGE_VERSION
Modified: seismo/3D/SPECFEM3D/trunk/configure
===================================================================
--- seismo/3D/SPECFEM3D/trunk/configure 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/configure 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,62 +1,85 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.61 for Specfem 3D 1.4.0.
+# Generated by GNU Autoconf 2.65 for Specfem 3D 1.4.0.
#
# Report bugs to <jtromp AT caltech.edu>.
#
+#
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
-# 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation,
+# Inc.
+#
+#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
-## --------------------- ##
-## M4sh Initialization. ##
-## --------------------- ##
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
# Be more Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
setopt NO_GLOB_SUBST
else
- case `(set -o) 2>/dev/null` in
- *posix*) set -o posix ;;
+ case `(set -o) 2>/dev/null` in #(
+ *posix*) :
+ set -o posix ;; #(
+ *) :
+ ;;
esac
-
fi
-
-
-# PATH needs CR
-# Avoid depending upon Character Ranges.
-as_cr_letters='abcdefghijklmnopqrstuvwxyz'
-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-as_cr_Letters=$as_cr_letters$as_cr_LETTERS
-as_cr_digits='0123456789'
-as_cr_alnum=$as_cr_Letters$as_cr_digits
-
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='print -r --'
+ as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='printf %s\n'
+ as_echo_n='printf %s'
+else
+ if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+ as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+ as_echo_n='/usr/ucb/echo -n'
else
- PATH_SEPARATOR=:
+ as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+ as_echo_n_body='eval
+ arg=$1;
+ case $arg in #(
+ *"$as_nl"*)
+ expr "X$arg" : "X\\(.*\\)$as_nl";
+ arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+ esac;
+ expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+ '
+ export as_echo_n_body
+ as_echo_n='sh -c $as_echo_n_body as_echo'
fi
- rm -f conf$$.sh
+ export as_echo_body
+ as_echo='sh -c $as_echo_body as_echo'
fi
-# Support unset when possible.
-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
- as_unset=unset
-else
- as_unset=false
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ PATH_SEPARATOR=:
+ (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+ (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+ PATH_SEPARATOR=';'
+ }
fi
@@ -65,20 +88,18 @@
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
-as_nl='
-'
IFS=" "" $as_nl"
# Find who we are. Look in the path if we contain no directory separator.
-case $0 in
+case $0 in #((
*[\\/]* ) as_myself=$0 ;;
*) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+ done
IFS=$as_save_IFS
;;
@@ -89,354 +110,321 @@
as_myself=$0
fi
if test ! -f "$as_myself"; then
- echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
- { (exit 1); exit 1; }
+ $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+ exit 1
fi
-# Work around bugs in pre-3.0 UWIN ksh.
-for as_var in ENV MAIL MAILPATH
-do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there. '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '
# NLS nuisances.
-for as_var in \
- LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
- LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
- LC_TELEPHONE LC_TIME
-do
- if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
- eval $as_var=C; export $as_var
- else
- ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
- fi
-done
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
-# Required to use basename.
-if expr a : '\(a\)' >/dev/null 2>&1 &&
- test "X`expr 00001 : '.*\(...\)'`" = X001; then
- as_expr=expr
-else
- as_expr=false
-fi
-
-if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
- as_basename=basename
-else
- as_basename=false
-fi
-
-
-# Name of the executable.
-as_me=`$as_basename -- "$0" ||
-$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
- X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)' \| . 2>/dev/null ||
-echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{
- s//\1/
- q
- }
- /^X\/\(\/\/\)$/{
- s//\1/
- q
- }
- /^X\/\(\/\).*/{
- s//\1/
- q
- }
- s/.*/./; q'`
-
# CDPATH.
-$as_unset CDPATH
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
-
if test "x$CONFIG_SHELL" = x; then
- if (eval ":") 2>/dev/null; then
- as_have_required=yes
+ as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
+ emulate sh
+ NULLCMD=:
+ # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '\${1+\"\$@\"}'='\"\$@\"'
+ setopt NO_GLOB_SUBST
else
- as_have_required=no
+ case \`(set -o) 2>/dev/null\` in #(
+ *posix*) :
+ set -o posix ;; #(
+ *) :
+ ;;
+esac
fi
+"
+ as_required="as_fn_return () { (exit \$1); }
+as_fn_success () { as_fn_return 0; }
+as_fn_failure () { as_fn_return 1; }
+as_fn_ret_success () { return 0; }
+as_fn_ret_failure () { return 1; }
- if test $as_have_required = yes && (eval ":
-(as_func_return () {
- (exit \$1)
-}
-as_func_success () {
- as_func_return 0
-}
-as_func_failure () {
- as_func_return 1
-}
-as_func_ret_success () {
- return 0
-}
-as_func_ret_failure () {
- return 1
-}
-
exitcode=0
-if as_func_success; then
- :
-else
- exitcode=1
- echo as_func_success failed.
-fi
+as_fn_success || { exitcode=1; echo as_fn_success failed.; }
+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
+if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
-if as_func_failure; then
- exitcode=1
- echo as_func_failure succeeded.
-fi
-
-if as_func_ret_success; then
- :
else
- exitcode=1
- echo as_func_ret_success failed.
+ exitcode=1; echo positional parameters were not saved.
fi
-
-if as_func_ret_failure; then
- exitcode=1
- echo as_func_ret_failure succeeded.
-fi
-
-if ( set x; as_func_ret_success y && test x = \"\$1\" ); then
- :
+test x\$exitcode = x0 || exit 1"
+ as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
+ as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
+ eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
+ test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1"
+ if (eval "$as_required") 2>/dev/null; then :
+ as_have_required=yes
else
- exitcode=1
- echo positional parameters were not saved.
+ as_have_required=no
fi
+ if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :
-test \$exitcode = 0) || { (exit 1); exit 1; }
-
-(
- as_lineno_1=\$LINENO
- as_lineno_2=\$LINENO
- test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" &&
- test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; }
-") 2> /dev/null; then
- :
else
- as_candidate_shells=
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+as_found=false
for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- case $as_dir in
+ as_found=:
+ case $as_dir in #(
/*)
for as_base in sh bash ksh sh5; do
- as_candidate_shells="$as_candidate_shells $as_dir/$as_base"
+ # Try only shells that exist, to save several forks.
+ as_shell=$as_dir/$as_base
+ if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
+ { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
+ CONFIG_SHELL=$as_shell as_have_required=yes
+ if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
+ break 2
+fi
+fi
done;;
esac
+ as_found=false
done
+$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
+ { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
+ CONFIG_SHELL=$SHELL as_have_required=yes
+fi; }
IFS=$as_save_IFS
- for as_shell in $as_candidate_shells $SHELL; do
- # Try only shells that exist, to save several forks.
- if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
- { ("$as_shell") 2> /dev/null <<\_ASEOF
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
- emulate sh
- NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
- # is contrary to our usage. Disable this feature.
- alias -g '${1+"$@"}'='"$@"'
- setopt NO_GLOB_SUBST
-else
- case `(set -o) 2>/dev/null` in
- *posix*) set -o posix ;;
-esac
-
+ if test "x$CONFIG_SHELL" != x; then :
+ # We cannot yet assume a decent shell, so we have to provide a
+ # neutralization value for shells without unset; and this also
+ # works around shells that cannot unset nonexistent variables.
+ BASH_ENV=/dev/null
+ ENV=/dev/null
+ (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"}
fi
-
-:
-_ASEOF
-}; then
- CONFIG_SHELL=$as_shell
- as_have_required=yes
- if { "$as_shell" 2> /dev/null <<\_ASEOF
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
- emulate sh
- NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
- # is contrary to our usage. Disable this feature.
- alias -g '${1+"$@"}'='"$@"'
- setopt NO_GLOB_SUBST
-else
- case `(set -o) 2>/dev/null` in
- *posix*) set -o posix ;;
-esac
-
+ if test x$as_have_required = xno; then :
+ $as_echo "$0: This script requires a shell more modern than all"
+ $as_echo "$0: the shells that I found on your system."
+ if test x${ZSH_VERSION+set} = xset ; then
+ $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
+ $as_echo "$0: be upgraded to zsh 4.3.4 or later."
+ else
+ $as_echo "$0: Please tell bug-autoconf at gnu.org and jtromp AT
+$0: caltech.edu about your system, including any error
+$0: possibly output before this message. Then install a
+$0: modern shell, or manually run the script under such a
+$0: shell if you do have one."
+ fi
+ exit 1
fi
-
-
-:
-(as_func_return () {
- (exit $1)
-}
-as_func_success () {
- as_func_return 0
-}
-as_func_failure () {
- as_func_return 1
-}
-as_func_ret_success () {
- return 0
-}
-as_func_ret_failure () {
- return 1
-}
-
-exitcode=0
-if as_func_success; then
- :
-else
- exitcode=1
- echo as_func_success failed.
fi
-
-if as_func_failure; then
- exitcode=1
- echo as_func_failure succeeded.
fi
+SHELL=${CONFIG_SHELL-/bin/sh}
+export SHELL
+# Unset more variables known to interfere with behavior of common tools.
+CLICOLOR_FORCE= GREP_OPTIONS=
+unset CLICOLOR_FORCE GREP_OPTIONS
-if as_func_ret_success; then
- :
-else
- exitcode=1
- echo as_func_ret_success failed.
-fi
+## --------------------- ##
+## M4sh Shell Functions. ##
+## --------------------- ##
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+ { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
-if as_func_ret_failure; then
- exitcode=1
- echo as_func_ret_failure succeeded.
-fi
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+ return $1
+} # as_fn_set_status
-if ( set x; as_func_ret_success y && test x = "$1" ); then
- :
-else
- exitcode=1
- echo positional parameters were not saved.
-fi
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+ set +e
+ as_fn_set_status $1
+ exit $1
+} # as_fn_exit
-test $exitcode = 0) || { (exit 1); exit 1; }
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
-(
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; }
+ case $as_dir in #(
+ -*) as_dir=./$as_dir;;
+ esac
+ test -d "$as_dir" || eval $as_mkdir_p || {
+ as_dirs=
+ while :; do
+ case $as_dir in #(
+ *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+ *) as_qdir=$as_dir;;
+ esac
+ as_dirs="'$as_qdir' $as_dirs"
+ as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ test -d "$as_dir" && break
+ done
+ test -z "$as_dirs" || eval "mkdir $as_dirs"
+ } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir"
-_ASEOF
-}; then
- break
-fi
-fi
+} # as_fn_mkdir_p
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+ eval 'as_fn_append ()
+ {
+ eval $1+=\$2
+ }'
+else
+ as_fn_append ()
+ {
+ eval $1=\$$1\$2
+ }
+fi # as_fn_append
- done
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+ eval 'as_fn_arith ()
+ {
+ as_val=$(( $* ))
+ }'
+else
+ as_fn_arith ()
+ {
+ as_val=`expr "$@" || test $? -eq 1`
+ }
+fi # as_fn_arith
- if test "x$CONFIG_SHELL" != x; then
- for as_var in BASH_ENV ENV
- do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
- done
- export CONFIG_SHELL
- exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"}
-fi
+# as_fn_error ERROR [LINENO LOG_FD]
+# ---------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with status $?, using 1 if that was 0.
+as_fn_error ()
+{
+ as_status=$?; test $as_status -eq 0 && as_status=1
+ if test "$3"; then
+ as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3
+ fi
+ $as_echo "$as_me: error: $1" >&2
+ as_fn_exit $as_status
+} # as_fn_error
- if test $as_have_required = no; then
- echo This script requires a shell more modern than all the
- echo shells that I found on your system. Please install a
- echo modern shell, or manually run the script under such a
- echo shell if you do have one.
- { (exit 1); exit 1; }
-fi
-
-
-fi
-
-fi
-
-
-
-(eval "as_func_return () {
- (exit \$1)
-}
-as_func_success () {
- as_func_return 0
-}
-as_func_failure () {
- as_func_return 1
-}
-as_func_ret_success () {
- return 0
-}
-as_func_ret_failure () {
- return 1
-}
-
-exitcode=0
-if as_func_success; then
- :
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+ test "X`expr 00001 : '.*\(...\)'`" = X001; then
+ as_expr=expr
else
- exitcode=1
- echo as_func_success failed.
+ as_expr=false
fi
-if as_func_failure; then
- exitcode=1
- echo as_func_failure succeeded.
-fi
-
-if as_func_ret_success; then
- :
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+ as_basename=basename
else
- exitcode=1
- echo as_func_ret_success failed.
+ as_basename=false
fi
-if as_func_ret_failure; then
- exitcode=1
- echo as_func_ret_failure succeeded.
-fi
-
-if ( set x; as_func_ret_success y && test x = \"\$1\" ); then
- :
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+ as_dirname=dirname
else
- exitcode=1
- echo positional parameters were not saved.
+ as_dirname=false
fi
-test \$exitcode = 0") || {
- echo No shell found that supports shell functions.
- echo Please tell autoconf at gnu.org about your system,
- echo including any error possibly output before this
- echo message
-}
+as_me=`$as_basename -- "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || {
-
- # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
- # uniformly replaced by the line number. The first 'sed' inserts a
- # line-number line after each line using $LINENO; the second 'sed'
- # does the real work. The second script uses 'N' to pair each
- # line-number line with the line containing $LINENO, and appends
- # trailing '-' during substitution so that $LINENO is not a special
- # case at line end.
- # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
- # scripts with optimization help from Paolo Bonzini. Blame Lee
- # E. McMahon (1931-1989) for sed's syntax. :-)
+ as_lineno_1=$LINENO as_lineno_1a=$LINENO
+ as_lineno_2=$LINENO as_lineno_2a=$LINENO
+ eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
+ test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
+ # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-)
sed -n '
p
/[$]LINENO/=
@@ -453,8 +441,7 @@
s/-\n.*//
' >$as_me.lineno &&
chmod +x "$as_me.lineno" ||
- { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
- { (exit 1); exit 1; }; }
+ { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
# Don't try to exec as it changes $[0], causing all sort of problems
# (the dirname of $[0] is not the place where we might find the
@@ -464,49 +451,40 @@
exit
}
-
-if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
- as_dirname=dirname
-else
- as_dirname=false
-fi
-
ECHO_C= ECHO_N= ECHO_T=
-case `echo -n x` in
+case `echo -n x` in #(((((
-n*)
- case `echo 'x\c'` in
+ case `echo 'xy\c'` in
*c*) ECHO_T=' ';; # ECHO_T is single tab character.
- *) ECHO_C='\c';;
+ xy) ECHO_C='\c';;
+ *) echo `echo ksh88 bug on AIX 6.1` > /dev/null
+ ECHO_T=' ';;
esac;;
*)
ECHO_N='-n';;
esac
-if expr a : '\(a\)' >/dev/null 2>&1 &&
- test "X`expr 00001 : '.*\(...\)'`" = X001; then
- as_expr=expr
-else
- as_expr=false
-fi
-
rm -f conf$$ conf$$.exe conf$$.file
if test -d conf$$.dir; then
rm -f conf$$.dir/conf$$.file
else
rm -f conf$$.dir
- mkdir conf$$.dir
+ mkdir conf$$.dir 2>/dev/null
fi
-echo >conf$$.file
-if ln -s conf$$.file conf$$ 2>/dev/null; then
- as_ln_s='ln -s'
- # ... but there are two gotchas:
- # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
- # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
- # In both cases, we have to default to `cp -p'.
- ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+if (echo >conf$$.file) 2>/dev/null; then
+ if ln -s conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s='ln -s'
+ # ... but there are two gotchas:
+ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+ # In both cases, we have to default to `cp -p'.
+ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+ as_ln_s='cp -p'
+ elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+ else
as_ln_s='cp -p'
-elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
+ fi
else
as_ln_s='cp -p'
fi
@@ -514,7 +492,7 @@
rmdir conf$$.dir 2>/dev/null
if mkdir -p . 2>/dev/null; then
- as_mkdir_p=:
+ as_mkdir_p='mkdir -p "$as_dir"'
else
test -d ./-p && rmdir ./-p
as_mkdir_p=false
@@ -531,12 +509,12 @@
as_test_x='
eval sh -c '\''
if test -d "$1"; then
- test -d "$1/.";
+ test -d "$1/.";
else
- case $1 in
- -*)set "./$1";;
+ case $1 in #(
+ -*)set "./$1";;
esac;
- case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in
+ case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
???[sx]*):;;*)false;;esac;fi
'\'' sh
'
@@ -550,9 +528,9 @@
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+test -n "$DJDIR" || exec 7<&0 </dev/null
+exec 6>&1
-exec 7<&0 </dev/null 6>&1
-
# Name of the host.
# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
# so uname gets run too.
@@ -569,7 +547,6 @@
subdirs=
MFLAGS=
MAKEFLAGS=
-SHELL=${CONFIG_SHELL-/bin/sh}
# Identity of this package.
PACKAGE_NAME='Specfem 3D'
@@ -577,100 +554,109 @@
PACKAGE_VERSION='1.4.0'
PACKAGE_STRING='Specfem 3D 1.4.0'
PACKAGE_BUGREPORT='jtromp AT caltech.edu'
+PACKAGE_URL=''
-ac_unique_file="specfem3D.f90"
-ac_subst_vars='SHELL
-PATH_SEPARATOR
-PACKAGE_NAME
-PACKAGE_TARNAME
-PACKAGE_VERSION
-PACKAGE_STRING
-PACKAGE_BUGREPORT
-exec_prefix
-prefix
-program_transform_name
-bindir
-sbindir
-libexecdir
-datarootdir
-datadir
-sysconfdir
-sharedstatedir
-localstatedir
-includedir
-oldincludedir
-docdir
-infodir
-htmldir
-dvidir
-pdfdir
-psdir
-libdir
-localedir
-mandir
-DEFS
-ECHO_C
-ECHO_N
-ECHO_T
-LIBS
-build_alias
-host_alias
-target_alias
-COND_PYRE_TRUE
-COND_PYRE_FALSE
-COND_MPI_TRUE
-COND_MPI_FALSE
-CUSTOM_REAL
-CUSTOM_MPI_TYPE
-PYTHON
-PYTHON_VERSION
-PYTHON_PREFIX
-PYTHON_EXEC_PREFIX
-PYTHON_PLATFORM
-pythondir
-pkgpythondir
-pyexecdir
-pkgpyexecdir
-PYTHON_INCDIR
-PYTHON_BLDLIBRARY
-PYTHON_LDFLAGS
-PYTHON_LDLAST
-PYTHON_LDLIBRARY
-PYTHON_LIBDIR
-PYTHON_LIBP
-PYTHON_LIBPL
-PYTHON_LIBS
-PYTHON_LINKFORSHARED
-PYTHON_MODLIBS
-PYTHON_SYSLIBS
-PYTHON_LA_LDFLAGS
-FC
-FCFLAGS
-LDFLAGS
-ac_ct_FC
-EXEEXT
-OBJEXT
-FCENV
-FCLIBS
-CC
-CFLAGS
-CPPFLAGS
-ac_ct_CC
-FCFLAGS_f90
-SCOTCH_LIBS
-MPIFC
-MPILIBS
-MPICC
-FLAGS_CHECK
-FLAGS_NO_CHECK
-LOCAL_PATH_IS_ALSO_GLOBAL
-PYTHONPATH
-PYTHON_EGG_CFLAGS
-PYTHON_EGG_CPPFLAGS
-PYTHON_EGG_LDFLAGS
+ac_unique_file="README"
+ac_subst_vars='LTLIBOBJS
LIBOBJS
-LTLIBOBJS'
+PYTHON_EGG_LDFLAGS
+PYTHON_EGG_CPPFLAGS
+PYTHON_EGG_CFLAGS
+PYTHONPATH
+LOCAL_PATH_IS_ALSO_GLOBAL
+FLAGS_NO_CHECK
+FLAGS_CHECK
+MPICC
+MPILIBS
+MPIFC
+SCOTCH_LIBS
+FCFLAGS_f90
+ac_ct_CC
+CPPFLAGS
+CFLAGS
+CC
+FCLIBS
+FCENV
+OBJEXT
+EXEEXT
+ac_ct_FC
+LDFLAGS
+FCFLAGS
+FC
+PYTHON_LA_LDFLAGS
+PYTHON_SYSLIBS
+PYTHON_MODLIBS
+PYTHON_LINKFORSHARED
+PYTHON_LIBS
+PYTHON_LIBPL
+PYTHON_LIBP
+PYTHON_LIBDIR
+PYTHON_LDLIBRARY
+PYTHON_LDLAST
+PYTHON_LDFLAGS
+PYTHON_BLDLIBRARY
+PYTHON_INCDIR
+pkgpyexecdir
+pyexecdir
+pkgpythondir
+pythondir
+PYTHON_PLATFORM
+PYTHON_EXEC_PREFIX
+PYTHON_PREFIX
+PYTHON_VERSION
+PYTHON
+CUSTOM_MPI_TYPE
+CUSTOM_REAL
+COND_MPI_FALSE
+COND_MPI_TRUE
+COND_PYRE_FALSE
+COND_PYRE_TRUE
+target_alias
+host_alias
+build_alias
+LIBS
+ECHO_T
+ECHO_N
+ECHO_C
+DEFS
+mandir
+localedir
+libdir
+psdir
+pdfdir
+dvidir
+htmldir
+infodir
+docdir
+oldincludedir
+includedir
+localstatedir
+sharedstatedir
+sysconfdir
+datadir
+datarootdir
+libexecdir
+sbindir
+bindir
+program_transform_name
+prefix
+exec_prefix
+PACKAGE_URL
+PACKAGE_BUGREPORT
+PACKAGE_STRING
+PACKAGE_VERSION
+PACKAGE_TARNAME
+PACKAGE_NAME
+PATH_SEPARATOR
+SHELL'
ac_subst_files=''
+ac_user_opts='
+enable_option_checking
+with_pyre
+with_mpi
+enable_double_precision
+with_scotch_lib
+'
ac_precious_vars='build_alias
host_alias
target_alias
@@ -695,6 +681,8 @@
# Initialize some variables set by options.
ac_init_help=
ac_init_version=false
+ac_unrecognized_opts=
+ac_unrecognized_sep=
# The variables have the same names as the options, with
# dashes changed to underlines.
cache_file=/dev/null
@@ -793,13 +781,20 @@
datarootdir=$ac_optarg ;;
-disable-* | --disable-*)
- ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_feature" : ".*[^-._$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid feature name: $ac_feature" >&2
- { (exit 1); exit 1; }; }
- ac_feature=`echo $ac_feature | sed 's/[-.]/_/g'`
- eval enable_$ac_feature=no ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error "invalid feature name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"enable_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
+ esac
+ eval enable_$ac_useropt=no ;;
-docdir | --docdir | --docdi | --doc | --do)
ac_prev=docdir ;;
@@ -812,13 +807,20 @@
dvidir=$ac_optarg ;;
-enable-* | --enable-*)
- ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_feature" : ".*[^-._$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid feature name: $ac_feature" >&2
- { (exit 1); exit 1; }; }
- ac_feature=`echo $ac_feature | sed 's/[-.]/_/g'`
- eval enable_$ac_feature=\$ac_optarg ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error "invalid feature name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"enable_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
+ esac
+ eval enable_$ac_useropt=\$ac_optarg ;;
-exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
| --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
@@ -1009,22 +1011,36 @@
ac_init_version=: ;;
-with-* | --with-*)
- ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_package" : ".*[^-._$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid package name: $ac_package" >&2
- { (exit 1); exit 1; }; }
- ac_package=`echo $ac_package | sed 's/[-.]/_/g'`
- eval with_$ac_package=\$ac_optarg ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error "invalid package name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"with_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
+ esac
+ eval with_$ac_useropt=\$ac_optarg ;;
-without-* | --without-*)
- ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_package" : ".*[^-._$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid package name: $ac_package" >&2
- { (exit 1); exit 1; }; }
- ac_package=`echo $ac_package | sed 's/[-.]/_/g'`
- eval with_$ac_package=no ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error "invalid package name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"with_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
+ esac
+ eval with_$ac_useropt=no ;;
--x)
# Obsolete; use --with-x.
@@ -1044,25 +1060,25 @@
| --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
x_libraries=$ac_optarg ;;
- -*) { echo "$as_me: error: unrecognized option: $ac_option
-Try \`$0 --help' for more information." >&2
- { (exit 1); exit 1; }; }
+ -*) as_fn_error "unrecognized option: \`$ac_option'
+Try \`$0 --help' for more information."
;;
*=*)
ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
# Reject names that are not valid shell variable names.
- expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
- { (exit 1); exit 1; }; }
+ case $ac_envvar in #(
+ '' | [0-9]* | *[!_$as_cr_alnum]* )
+ as_fn_error "invalid variable name: \`$ac_envvar'" ;;
+ esac
eval $ac_envvar=\$ac_optarg
export $ac_envvar ;;
*)
# FIXME: should be removed in autoconf 3.0.
- echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+ $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
- echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+ $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2
: ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
;;
@@ -1071,23 +1087,36 @@
if test -n "$ac_prev"; then
ac_option=--`echo $ac_prev | sed 's/_/-/g'`
- { echo "$as_me: error: missing argument to $ac_option" >&2
- { (exit 1); exit 1; }; }
+ as_fn_error "missing argument to $ac_option"
fi
-# Be sure to have absolute directory names.
+if test -n "$ac_unrecognized_opts"; then
+ case $enable_option_checking in
+ no) ;;
+ fatal) as_fn_error "unrecognized options: $ac_unrecognized_opts" ;;
+ *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
+ esac
+fi
+
+# Check all directory arguments for consistency.
for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \
datadir sysconfdir sharedstatedir localstatedir includedir \
oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
libdir localedir mandir
do
eval ac_val=\$$ac_var
+ # Remove trailing slashes.
case $ac_val in
+ */ )
+ ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
+ eval $ac_var=\$ac_val;;
+ esac
+ # Be sure to have absolute directory names.
+ case $ac_val in
[\\/$]* | ?:[\\/]* ) continue;;
NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
esac
- { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
- { (exit 1); exit 1; }; }
+ as_fn_error "expected an absolute directory name for --$ac_var: $ac_val"
done
# There might be people who depend on the old broken behavior: `$host'
@@ -1101,7 +1130,7 @@
if test "x$host_alias" != x; then
if test "x$build_alias" = x; then
cross_compiling=maybe
- echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
+ $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
If a cross compiler is detected then cross compile mode will be used." >&2
elif test "x$build_alias" != "x$host_alias"; then
cross_compiling=yes
@@ -1117,23 +1146,21 @@
ac_pwd=`pwd` && test -n "$ac_pwd" &&
ac_ls_di=`ls -di .` &&
ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
- { echo "$as_me: error: Working directory cannot be determined" >&2
- { (exit 1); exit 1; }; }
+ as_fn_error "working directory cannot be determined"
test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
- { echo "$as_me: error: pwd does not report name of working directory" >&2
- { (exit 1); exit 1; }; }
+ as_fn_error "pwd does not report name of working directory"
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
ac_srcdir_defaulted=yes
# Try the directory containing this script, then the parent directory.
- ac_confdir=`$as_dirname -- "$0" ||
-$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$0" : 'X\(//\)[^/]' \| \
- X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)' \| . 2>/dev/null ||
-echo X"$0" |
+ ac_confdir=`$as_dirname -- "$as_myself" ||
+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_myself" : 'X\(//\)[^/]' \| \
+ X"$as_myself" : 'X\(//\)$' \| \
+ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_myself" |
sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
s//\1/
q
@@ -1160,13 +1187,11 @@
fi
if test ! -r "$srcdir/$ac_unique_file"; then
test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
- { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
- { (exit 1); exit 1; }; }
+ as_fn_error "cannot find sources ($ac_unique_file) in $srcdir"
fi
ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
ac_abs_confdir=`(
- cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2
- { (exit 1); exit 1; }; }
+ cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error "$ac_msg"
pwd)`
# When building in place, set srcdir=.
if test "$ac_abs_confdir" = "$ac_pwd"; then
@@ -1214,9 +1239,9 @@
Installation directories:
--prefix=PREFIX install architecture-independent files in PREFIX
- [$ac_default_prefix]
+ [$ac_default_prefix]
--exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
- [PREFIX]
+ [PREFIX]
By default, \`make install' will install all the files in
\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
@@ -1226,25 +1251,25 @@
For better control, use the options below.
Fine tuning of the installation directories:
- --bindir=DIR user executables [EPREFIX/bin]
- --sbindir=DIR system admin executables [EPREFIX/sbin]
- --libexecdir=DIR program executables [EPREFIX/libexec]
- --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
- --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
- --localstatedir=DIR modifiable single-machine data [PREFIX/var]
- --libdir=DIR object code libraries [EPREFIX/lib]
- --includedir=DIR C header files [PREFIX/include]
- --oldincludedir=DIR C header files for non-gcc [/usr/include]
- --datarootdir=DIR read-only arch.-independent data root [PREFIX/share]
- --datadir=DIR read-only architecture-independent data [DATAROOTDIR]
- --infodir=DIR info documentation [DATAROOTDIR/info]
- --localedir=DIR locale-dependent data [DATAROOTDIR/locale]
- --mandir=DIR man documentation [DATAROOTDIR/man]
- --docdir=DIR documentation root [DATAROOTDIR/doc/Specfem3D]
- --htmldir=DIR html documentation [DOCDIR]
- --dvidir=DIR dvi documentation [DOCDIR]
- --pdfdir=DIR pdf documentation [DOCDIR]
- --psdir=DIR ps documentation [DOCDIR]
+ --bindir=DIR user executables [EPREFIX/bin]
+ --sbindir=DIR system admin executables [EPREFIX/sbin]
+ --libexecdir=DIR program executables [EPREFIX/libexec]
+ --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data [PREFIX/var]
+ --libdir=DIR object code libraries [EPREFIX/lib]
+ --includedir=DIR C header files [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc [/usr/include]
+ --datarootdir=DIR read-only arch.-independent data root [PREFIX/share]
+ --datadir=DIR read-only architecture-independent data [DATAROOTDIR]
+ --infodir=DIR info documentation [DATAROOTDIR/info]
+ --localedir=DIR locale-dependent data [DATAROOTDIR/locale]
+ --mandir=DIR man documentation [DATAROOTDIR/man]
+ --docdir=DIR documentation root [DATAROOTDIR/doc/Specfem3D]
+ --htmldir=DIR html documentation [DOCDIR]
+ --dvidir=DIR dvi documentation [DOCDIR]
+ --pdfdir=DIR pdf documentation [DOCDIR]
+ --psdir=DIR ps documentation [DOCDIR]
_ACEOF
cat <<\_ACEOF
@@ -1258,6 +1283,7 @@
cat <<\_ACEOF
Optional Features:
+ --disable-option-checking ignore unrecognized --enable/--with options
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
--enable-double-precision
@@ -1268,7 +1294,7 @@
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
--with-pyre build Pyrized version [default=no]
--with-mpi build parallel version [default=yes]
- --with-scotch-lib tell where scotch library reside
+ --with-scotch-lib tell where Scotch library reside
Some influential environment variables:
FC Fortran compiler command
@@ -1278,7 +1304,7 @@
LIBS libraries to pass to the linker, e.g. -l<library>
CC C compiler command
CFLAGS C compiler flags
- CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I<include dir> if
+ CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if
you have headers in a nonstandard directory <include dir>
SCOTCH_LIBS extra libraries for linking Scotch
MPIFC MPI Fortran compiler command
@@ -1305,15 +1331,17 @@
if test "$ac_init_help" = "recursive"; then
# If there are subdirs, report their specific --help.
for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
- test -d "$ac_dir" || continue
+ test -d "$ac_dir" ||
+ { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
+ continue
ac_builddir=.
case "$ac_dir" in
.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
*)
- ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
# A ".." for each directory in $ac_dir_suffix.
- ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'`
+ ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
case $ac_top_builddir_sub in
"") ac_top_builddir_sub=. ac_top_build_prefix= ;;
*) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
@@ -1349,7 +1377,7 @@
echo &&
$SHELL "$ac_srcdir/configure" --help=recursive
else
- echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+ $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
fi || ac_status=$?
cd "$ac_pwd" || { ac_status=$?; break; }
done
@@ -1359,21 +1387,192 @@
if $ac_init_version; then
cat <<\_ACEOF
Specfem 3D configure 1.4.0
-generated by GNU Autoconf 2.61
+generated by GNU Autoconf 2.65
-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
-2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+Copyright (C) 2009 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
exit
fi
+
+## ------------------------ ##
+## Autoconf initialization. ##
+## ------------------------ ##
+
+# ac_fn_fc_try_compile LINENO
+# ---------------------------
+# Try to compile conftest.$ac_ext, and return whether this succeeded.
+ac_fn_fc_try_compile ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ rm -f conftest.$ac_objext
+ if { { ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_compile") 2>conftest.err
+ ac_status=$?
+ if test -s conftest.err; then
+ grep -v '^ *+' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ mv -f conftest.er1 conftest.err
+ fi
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } && {
+ test -z "$ac_fc_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=1
+fi
+ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+ as_fn_set_status $ac_retval
+
+} # ac_fn_fc_try_compile
+
+# ac_fn_c_try_compile LINENO
+# --------------------------
+# Try to compile conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_compile ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ rm -f conftest.$ac_objext
+ if { { ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_compile") 2>conftest.err
+ ac_status=$?
+ if test -s conftest.err; then
+ grep -v '^ *+' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ mv -f conftest.er1 conftest.err
+ fi
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=1
+fi
+ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+ as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_compile
+
+# ac_fn_c_try_link LINENO
+# -----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_link ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ rm -f conftest.$ac_objext conftest$ac_exeext
+ if { { ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link") 2>conftest.err
+ ac_status=$?
+ if test -s conftest.err; then
+ grep -v '^ *+' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ mv -f conftest.er1 conftest.err
+ fi
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest$ac_exeext && {
+ test "$cross_compiling" = yes ||
+ $as_test_x conftest$ac_exeext
+ }; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=1
+fi
+ # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
+ # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
+ # interfere with the next link command; also delete a directory that is
+ # left behind by Apple's compiler. We do this before executing the actions.
+ rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+ as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_link
+
+# ac_fn_fc_try_link LINENO
+# ------------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded.
+ac_fn_fc_try_link ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ rm -f conftest.$ac_objext conftest$ac_exeext
+ if { { ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link") 2>conftest.err
+ ac_status=$?
+ if test -s conftest.err; then
+ grep -v '^ *+' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ mv -f conftest.er1 conftest.err
+ fi
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } && {
+ test -z "$ac_fc_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest$ac_exeext && {
+ test "$cross_compiling" = yes ||
+ $as_test_x conftest$ac_exeext
+ }; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=1
+fi
+ # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
+ # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
+ # interfere with the next link command; also delete a directory that is
+ # left behind by Apple's compiler. We do this before executing the actions.
+ rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+ as_fn_set_status $ac_retval
+
+} # ac_fn_fc_try_link
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
It was created by Specfem 3D $as_me 1.4.0, which was
-generated by GNU Autoconf 2.61. Invocation command line was
+generated by GNU Autoconf 2.65. Invocation command line was
$ $0 $@
@@ -1409,8 +1608,8 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- echo "PATH: $as_dir"
-done
+ $as_echo "PATH: $as_dir"
+ done
IFS=$as_save_IFS
} >&5
@@ -1444,12 +1643,12 @@
| -silent | --silent | --silen | --sile | --sil)
continue ;;
*\'*)
- ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
esac
case $ac_pass in
- 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
+ 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
2)
- ac_configure_args1="$ac_configure_args1 '$ac_arg'"
+ as_fn_append ac_configure_args1 " '$ac_arg'"
if test $ac_must_keep_next = true; then
ac_must_keep_next=false # Got value, back to normal.
else
@@ -1465,13 +1664,13 @@
-* ) ac_must_keep_next=true ;;
esac
fi
- ac_configure_args="$ac_configure_args '$ac_arg'"
+ as_fn_append ac_configure_args " '$ac_arg'"
;;
esac
done
done
-$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
-$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }
+{ ac_configure_args0=; unset ac_configure_args0;}
+{ ac_configure_args1=; unset ac_configure_args1;}
# When interrupted or exit'd, cleanup temporary files, and complete
# config.log. We remove comments because anyway the quotes in there
@@ -1496,12 +1695,13 @@
case $ac_val in #(
*${as_nl}*)
case $ac_var in #(
- *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5
-echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;;
+ *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
esac
case $ac_var in #(
_ | IFS | as_nl) ;; #(
- *) $as_unset $ac_var ;;
+ BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+ *) { eval $ac_var=; unset $ac_var;} ;;
esac ;;
esac
done
@@ -1530,9 +1730,9 @@
do
eval ac_val=\$$ac_var
case $ac_val in
- *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+ *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
esac
- echo "$ac_var='\''$ac_val'\''"
+ $as_echo "$ac_var='\''$ac_val'\''"
done | sort
echo
@@ -1547,9 +1747,9 @@
do
eval ac_val=\$$ac_var
case $ac_val in
- *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+ *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
esac
- echo "$ac_var='\''$ac_val'\''"
+ $as_echo "$ac_var='\''$ac_val'\''"
done | sort
echo
fi
@@ -1565,83 +1765,88 @@
echo
fi
test "$ac_signal" != 0 &&
- echo "$as_me: caught signal $ac_signal"
- echo "$as_me: exit $exit_status"
+ $as_echo "$as_me: caught signal $ac_signal"
+ $as_echo "$as_me: exit $exit_status"
} >&5
rm -f core *.core core.conftest.* &&
rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
exit $exit_status
' 0
for ac_signal in 1 2 13 15; do
- trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
+ trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
done
ac_signal=0
# confdefs.h avoids OS command line length limits that DEFS can exceed.
rm -f -r conftest* confdefs.h
+$as_echo "/* confdefs.h */" > confdefs.h
+
# Predefined preprocessor variables.
cat >>confdefs.h <<_ACEOF
#define PACKAGE_NAME "$PACKAGE_NAME"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_VERSION "$PACKAGE_VERSION"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_STRING "$PACKAGE_STRING"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
_ACEOF
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_URL "$PACKAGE_URL"
+_ACEOF
+
# Let the site file select an alternate cache file if it wants to.
-# Prefer explicitly selected file to automatically selected ones.
+# Prefer an explicitly selected file to automatically selected ones.
+ac_site_file1=NONE
+ac_site_file2=NONE
if test -n "$CONFIG_SITE"; then
- set x "$CONFIG_SITE"
+ ac_site_file1=$CONFIG_SITE
elif test "x$prefix" != xNONE; then
- set x "$prefix/share/config.site" "$prefix/etc/config.site"
+ ac_site_file1=$prefix/share/config.site
+ ac_site_file2=$prefix/etc/config.site
else
- set x "$ac_default_prefix/share/config.site" \
- "$ac_default_prefix/etc/config.site"
+ ac_site_file1=$ac_default_prefix/share/config.site
+ ac_site_file2=$ac_default_prefix/etc/config.site
fi
-shift
-for ac_site_file
+for ac_site_file in "$ac_site_file1" "$ac_site_file2"
do
- if test -r "$ac_site_file"; then
- { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
-echo "$as_me: loading site script $ac_site_file" >&6;}
+ test "x$ac_site_file" = xNONE && continue
+ if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
+$as_echo "$as_me: loading site script $ac_site_file" >&6;}
sed 's/^/| /' "$ac_site_file" >&5
. "$ac_site_file"
fi
done
if test -r "$cache_file"; then
- # Some versions of bash will fail to source /dev/null (special
- # files actually), so we avoid doing that.
- if test -f "$cache_file"; then
- { echo "$as_me:$LINENO: loading cache $cache_file" >&5
-echo "$as_me: loading cache $cache_file" >&6;}
+ # Some versions of bash will fail to source /dev/null (special files
+ # actually), so we avoid doing that. DJGPP emulates it as a regular file.
+ if test /dev/null != "$cache_file" && test -f "$cache_file"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
+$as_echo "$as_me: loading cache $cache_file" >&6;}
case $cache_file in
[\\/]* | ?:[\\/]* ) . "$cache_file";;
*) . "./$cache_file";;
esac
fi
else
- { echo "$as_me:$LINENO: creating cache $cache_file" >&5
-echo "$as_me: creating cache $cache_file" >&6;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
+$as_echo "$as_me: creating cache $cache_file" >&6;}
>$cache_file
fi
@@ -1655,69 +1860,57 @@
eval ac_new_val=\$ac_env_${ac_var}_value
case $ac_old_set,$ac_new_set in
set,)
- { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
-echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
ac_cache_corrupted=: ;;
,set)
- { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
-echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
ac_cache_corrupted=: ;;
,);;
*)
if test "x$ac_old_val" != "x$ac_new_val"; then
- { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
-echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
- { echo "$as_me:$LINENO: former value: $ac_old_val" >&5
-echo "$as_me: former value: $ac_old_val" >&2;}
- { echo "$as_me:$LINENO: current value: $ac_new_val" >&5
-echo "$as_me: current value: $ac_new_val" >&2;}
- ac_cache_corrupted=:
+ # differences in whitespace do not lead to failure.
+ ac_old_val_w=`echo x $ac_old_val`
+ ac_new_val_w=`echo x $ac_new_val`
+ if test "$ac_old_val_w" != "$ac_new_val_w"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
+$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+ ac_cache_corrupted=:
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
+$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
+ eval $ac_var=\$ac_old_val
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5
+$as_echo "$as_me: former value: \`$ac_old_val'" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5
+$as_echo "$as_me: current value: \`$ac_new_val'" >&2;}
fi;;
esac
# Pass precious variables to config.status.
if test "$ac_new_set" = set; then
case $ac_new_val in
- *\'*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
*) ac_arg=$ac_var=$ac_new_val ;;
esac
case " $ac_configure_args " in
*" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
- *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) as_fn_append ac_configure_args " '$ac_arg'" ;;
esac
fi
done
if $ac_cache_corrupted; then
- { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
-echo "$as_me: error: changes in the environment can compromise the build" >&2;}
- { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
-echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
- { (exit 1); exit 1; }; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
+$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+ as_fn_error "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
fi
+## -------------------- ##
+## Main body of script. ##
+## -------------------- ##
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
@@ -1735,7 +1928,7 @@
# Check whether --with-pyre was given.
-if test "${with_pyre+set}" = set; then
+if test "${with_pyre+set}" = set; then :
withval=$with_pyre; want_pyre="$withval"
else
want_pyre=no
@@ -1752,7 +1945,7 @@
# Check whether --with-mpi was given.
-if test "${with_mpi+set}" = set; then
+if test "${with_mpi+set}" = set; then :
withval=$with_mpi; want_mpi="$withval"
else
want_mpi=yes
@@ -1768,7 +1961,7 @@
# Check whether --enable-double-precision was given.
-if test "${enable_double_precision+set}" = set; then
+if test "${enable_double_precision+set}" = set; then :
enableval=$enable_double_precision; want_double_precision="$enableval"
else
want_double_precision=no
@@ -1794,69 +1987,69 @@
if test -n "$PYTHON"; then
# If the user set $PYTHON, use it and don't search something else.
- { echo "$as_me:$LINENO: checking whether $PYTHON version >= 2.3" >&5
-echo $ECHO_N "checking whether $PYTHON version >= 2.3... $ECHO_C" >&6; }
- prog="import sys, string
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $PYTHON version >= 2.3" >&5
+$as_echo_n "checking whether $PYTHON version >= 2.3... " >&6; }
+ prog="import sys
# split strings by '.' and convert to numeric. Append some zeros
# because we need at least 4 digits for the hex conversion.
-minver = map(int, string.split('2.3', '.')) + [0, 0, 0]
+# map returns an iterator in Python 3.0 and a list in 2.x
+minver = list(map(int, '2.3'.split('.'))) + [0, 0, 0]
minverhex = 0
-for i in xrange(0, 4): minverhex = (minverhex << 8) + minver[i]
+# xrange is not present in Python 3.0 and range returns an iterator
+for i in list(range(0, 4)): minverhex = (minverhex << 8) + minver[i]
sys.exit(sys.hexversion < minverhex)"
if { echo "$as_me:$LINENO: $PYTHON -c "$prog"" >&5
($PYTHON -c "$prog") >&5 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
- { echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6; }
+ (exit $ac_status); }; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
else
- { { echo "$as_me:$LINENO: error: too old" >&5
-echo "$as_me: error: too old" >&2;}
- { (exit 1); exit 1; }; }
+ as_fn_error "too old" "$LINENO" 5
fi
-
am_display_PYTHON=$PYTHON
else
# Otherwise, try each interpreter until we find one that satisfies
# VERSION.
- { echo "$as_me:$LINENO: checking for a Python interpreter with version >= 2.3" >&5
-echo $ECHO_N "checking for a Python interpreter with version >= 2.3... $ECHO_C" >&6; }
-if test "${am_cv_pathless_PYTHON+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a Python interpreter with version >= 2.3" >&5
+$as_echo_n "checking for a Python interpreter with version >= 2.3... " >&6; }
+if test "${am_cv_pathless_PYTHON+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- for am_cv_pathless_PYTHON in python python2 python2.5 python2.4 python2.3 python2.2 python2.1 python2.0 python1.6 python1.5 none; do
+ for am_cv_pathless_PYTHON in python python2 python3 python3.0 python2.5 python2.4 python2.3 python2.2 python2.1 python2.0 none; do
test "$am_cv_pathless_PYTHON" = none && break
- prog="import sys, string
+ prog="import sys
# split strings by '.' and convert to numeric. Append some zeros
# because we need at least 4 digits for the hex conversion.
-minver = map(int, string.split('2.3', '.')) + [0, 0, 0]
+# map returns an iterator in Python 3.0 and a list in 2.x
+minver = list(map(int, '2.3'.split('.'))) + [0, 0, 0]
minverhex = 0
-for i in xrange(0, 4): minverhex = (minverhex << 8) + minver[i]
+# xrange is not present in Python 3.0 and range returns an iterator
+for i in list(range(0, 4)): minverhex = (minverhex << 8) + minver[i]
sys.exit(sys.hexversion < minverhex)"
if { echo "$as_me:$LINENO: $am_cv_pathless_PYTHON -c "$prog"" >&5
($am_cv_pathless_PYTHON -c "$prog") >&5 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
+ (exit $ac_status); }; then :
break
fi
-
done
fi
-{ echo "$as_me:$LINENO: result: $am_cv_pathless_PYTHON" >&5
-echo "${ECHO_T}$am_cv_pathless_PYTHON" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_pathless_PYTHON" >&5
+$as_echo "$am_cv_pathless_PYTHON" >&6; }
# Set $PYTHON to the absolute path of $am_cv_pathless_PYTHON.
if test "$am_cv_pathless_PYTHON" = none; then
PYTHON=:
else
# Extract the first word of "$am_cv_pathless_PYTHON", so it can be a program name with args.
set dummy $am_cv_pathless_PYTHON; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_path_PYTHON+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_path_PYTHON+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
case $PYTHON in
[\\/]* | ?:[\\/]*)
@@ -1868,14 +2061,14 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_path_PYTHON="$as_dir/$ac_word$ac_exec_ext"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
;;
@@ -1883,11 +2076,11 @@
fi
PYTHON=$ac_cv_path_PYTHON
if test -n "$PYTHON"; then
- { echo "$as_me:$LINENO: result: $PYTHON" >&5
-echo "${ECHO_T}$PYTHON" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PYTHON" >&5
+$as_echo "$PYTHON" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
@@ -1897,21 +2090,19 @@
if test "$PYTHON" = :; then
- { { echo "$as_me:$LINENO: error: no suitable Python interpreter found" >&5
-echo "$as_me: error: no suitable Python interpreter found" >&2;}
- { (exit 1); exit 1; }; }
+ as_fn_error "no suitable Python interpreter found" "$LINENO" 5
else
- { echo "$as_me:$LINENO: checking for $am_display_PYTHON version" >&5
-echo $ECHO_N "checking for $am_display_PYTHON version... $ECHO_C" >&6; }
-if test "${am_cv_python_version+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $am_display_PYTHON version" >&5
+$as_echo_n "checking for $am_display_PYTHON version... " >&6; }
+if test "${am_cv_python_version+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- am_cv_python_version=`$PYTHON -c "import sys; print sys.version[:3]"`
+ am_cv_python_version=`$PYTHON -c "import sys; sys.stdout.write(sys.version[:3])"`
fi
-{ echo "$as_me:$LINENO: result: $am_cv_python_version" >&5
-echo "${ECHO_T}$am_cv_python_version" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_python_version" >&5
+$as_echo "$am_cv_python_version" >&6; }
PYTHON_VERSION=$am_cv_python_version
@@ -1922,30 +2113,51 @@
- { echo "$as_me:$LINENO: checking for $am_display_PYTHON platform" >&5
-echo $ECHO_N "checking for $am_display_PYTHON platform... $ECHO_C" >&6; }
-if test "${am_cv_python_platform+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $am_display_PYTHON platform" >&5
+$as_echo_n "checking for $am_display_PYTHON platform... " >&6; }
+if test "${am_cv_python_platform+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- am_cv_python_platform=`$PYTHON -c "import sys; print sys.platform"`
+ am_cv_python_platform=`$PYTHON -c "import sys; sys.stdout.write(sys.platform)"`
fi
-{ echo "$as_me:$LINENO: result: $am_cv_python_platform" >&5
-echo "${ECHO_T}$am_cv_python_platform" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_python_platform" >&5
+$as_echo "$am_cv_python_platform" >&6; }
PYTHON_PLATFORM=$am_cv_python_platform
- { echo "$as_me:$LINENO: checking for $am_display_PYTHON script directory" >&5
-echo $ECHO_N "checking for $am_display_PYTHON script directory... $ECHO_C" >&6; }
-if test "${am_cv_python_pythondir+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $am_display_PYTHON script directory" >&5
+$as_echo_n "checking for $am_display_PYTHON script directory... " >&6; }
+if test "${am_cv_python_pythondir+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- am_cv_python_pythondir=`$PYTHON -c "from distutils import sysconfig; print sysconfig.get_python_lib(0,0,prefix='$PYTHON_PREFIX')" 2>/dev/null ||
+ if test "x$prefix" = xNONE
+ then
+ am_py_prefix=$ac_default_prefix
+ else
+ am_py_prefix=$prefix
+ fi
+ am_cv_python_pythondir=`$PYTHON -c "import sys; from distutils import sysconfig; sys.stdout.write(sysconfig.get_python_lib(0,0,prefix='$am_py_prefix'))" 2>/dev/null ||
echo "$PYTHON_PREFIX/lib/python$PYTHON_VERSION/site-packages"`
+ case $am_cv_python_pythondir in
+ $am_py_prefix*)
+ am__strip_prefix=`echo "$am_py_prefix" | sed 's|.|.|g'`
+ am_cv_python_pythondir=`echo "$am_cv_python_pythondir" | sed "s,^$am__strip_prefix,$PYTHON_PREFIX,"`
+ ;;
+ *)
+ case $am_py_prefix in
+ /usr|/System*) ;;
+ *)
+ am_cv_python_pythondir=$PYTHON_PREFIX/lib/python$PYTHON_VERSION/site-packages
+ ;;
+ esac
+ ;;
+ esac
+
fi
-{ echo "$as_me:$LINENO: result: $am_cv_python_pythondir" >&5
-echo "${ECHO_T}$am_cv_python_pythondir" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_python_pythondir" >&5
+$as_echo "$am_cv_python_pythondir" >&6; }
pythondir=$am_cv_python_pythondir
@@ -1953,16 +2165,37 @@
pkgpythondir=\${pythondir}/$PACKAGE
- { echo "$as_me:$LINENO: checking for $am_display_PYTHON extension module directory" >&5
-echo $ECHO_N "checking for $am_display_PYTHON extension module directory... $ECHO_C" >&6; }
-if test "${am_cv_python_pyexecdir+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $am_display_PYTHON extension module directory" >&5
+$as_echo_n "checking for $am_display_PYTHON extension module directory... " >&6; }
+if test "${am_cv_python_pyexecdir+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- am_cv_python_pyexecdir=`$PYTHON -c "from distutils import sysconfig; print sysconfig.get_python_lib(1,0,prefix='$PYTHON_EXEC_PREFIX')" 2>/dev/null ||
- echo "${PYTHON_EXEC_PREFIX}/lib/python${PYTHON_VERSION}/site-packages"`
+ if test "x$exec_prefix" = xNONE
+ then
+ am_py_exec_prefix=$am_py_prefix
+ else
+ am_py_exec_prefix=$exec_prefix
+ fi
+ am_cv_python_pyexecdir=`$PYTHON -c "import sys; from distutils import sysconfig; sys.stdout.write(sysconfig.get_python_lib(1,0,prefix='$am_py_exec_prefix'))" 2>/dev/null ||
+ echo "$PYTHON_EXEC_PREFIX/lib/python$PYTHON_VERSION/site-packages"`
+ case $am_cv_python_pyexecdir in
+ $am_py_exec_prefix*)
+ am__strip_prefix=`echo "$am_py_exec_prefix" | sed 's|.|.|g'`
+ am_cv_python_pyexecdir=`echo "$am_cv_python_pyexecdir" | sed "s,^$am__strip_prefix,$PYTHON_EXEC_PREFIX,"`
+ ;;
+ *)
+ case $am_py_exec_prefix in
+ /usr|/System*) ;;
+ *)
+ am_cv_python_pyexecdir=$PYTHON_EXEC_PREFIX/lib/python$PYTHON_VERSION/site-packages
+ ;;
+ esac
+ ;;
+ esac
+
fi
-{ echo "$as_me:$LINENO: result: $am_cv_python_pyexecdir" >&5
-echo "${ECHO_T}$am_cv_python_pyexecdir" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_python_pyexecdir" >&5
+$as_echo "$am_cv_python_pyexecdir" >&6; }
pyexecdir=$am_cv_python_pyexecdir
@@ -1977,8 +2210,8 @@
# $Id: cit_python.m4 16217 2010-02-02 23:44:16Z walter $
-{ echo "$as_me:$LINENO: checking $am_display_PYTHON sysconfig" >&5
-echo $ECHO_N "checking $am_display_PYTHON sysconfig... $ECHO_C" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $am_display_PYTHON sysconfig" >&5
+$as_echo_n "checking $am_display_PYTHON sysconfig... " >&6; }
cat >sysconfig.py <<END_OF_PYTHON
import os, sys
from distutils import sysconfig
@@ -2058,18 +2291,13 @@
END_OF_PYTHON
eval `$PYTHON sysconfig.py 2>/dev/null`
if test -n "$PYTHON_INCDIR"; then
- { echo "$as_me:$LINENO: result: ok" >&5
-echo "${ECHO_T}ok" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5
+$as_echo "ok" >&6; }
else
- { { echo "$as_me:$LINENO: error: \"failed
+ as_fn_error "\"failed
Run '$PYTHON sysconfig.py' to see what went wrong.
-\"" >&5
-echo "$as_me: error: \"failed
-
-Run '$PYTHON sysconfig.py' to see what went wrong.
-\"" >&2;}
- { (exit 1); exit 1; }; }
+\"" "$LINENO" 5
fi
rm -f sysconfig.py
PYTHON_INCDIR=$PYTHON_INCDIR
@@ -2118,10 +2346,10 @@
do
# Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
set dummy $ac_tool_prefix$ac_prog; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_FC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_FC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$FC"; then
ac_cv_prog_FC="$FC" # Let the user override the test.
@@ -2131,25 +2359,25 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_FC="$ac_tool_prefix$ac_prog"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
fi
fi
FC=$ac_cv_prog_FC
if test -n "$FC"; then
- { echo "$as_me:$LINENO: result: $FC" >&5
-echo "${ECHO_T}$FC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FC" >&5
+$as_echo "$FC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
@@ -2162,10 +2390,10 @@
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_ac_ct_FC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_ac_ct_FC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_FC"; then
ac_cv_prog_ac_ct_FC="$ac_ct_FC" # Let the user override the test.
@@ -2175,25 +2403,25 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_ac_ct_FC="$ac_prog"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
fi
fi
ac_ct_FC=$ac_cv_prog_ac_ct_FC
if test -n "$ac_ct_FC"; then
- { echo "$as_me:$LINENO: result: $ac_ct_FC" >&5
-echo "${ECHO_T}$ac_ct_FC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_FC" >&5
+$as_echo "$ac_ct_FC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
@@ -2205,12 +2433,8 @@
else
case $cross_compiling:$ac_tool_warned in
yes:)
-{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools
-whose name does not start with the host triplet. If you think this
-configuration is useful to you, please write to autoconf at gnu.org." >&5
-echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools
-whose name does not start with the host triplet. If you think this
-configuration is useful to you, please write to autoconf at gnu.org." >&2;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
FC=$ac_ct_FC
@@ -2219,82 +2443,69 @@
# Provide some information about the compiler.
-echo "$as_me:$LINENO: checking for Fortran compiler version" >&5
-ac_compiler=`set X $ac_compile; echo $2`
-{ (ac_try="$ac_compiler --version >&5"
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+ { { ac_try="$ac_compiler $ac_option >&5"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compiler --version >&5") 2>&5
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_compiler $ac_option >&5") 2>conftest.err
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
-{ (ac_try="$ac_compiler -v >&5"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compiler -v >&5") 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
-{ (ac_try="$ac_compiler -V >&5"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compiler -V >&5") 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
+ if test -s conftest.err; then
+ sed '10a\
+... rest of stderr output deleted ...
+ 10q' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ fi
+ rm -f conftest.er1 conftest.err
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }
+done
rm -f a.out
-cat >conftest.$ac_ext <<_ACEOF
+cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
ac_clean_files_save=$ac_clean_files
-ac_clean_files="$ac_clean_files a.out a.exe b.out"
+ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"
# Try to create an executable without -o first, disregard a.out.
# It will help us diagnose broken compilers, and finding out an intuition
# of exeext.
-{ echo "$as_me:$LINENO: checking for Fortran compiler default output file name" >&5
-echo $ECHO_N "checking for Fortran compiler default output file name... $ECHO_C" >&6; }
-ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
-#
-# List of possible output files, starting from the most likely.
-# The algorithm is not robust to junk in `.', hence go to wildcards (a.*)
-# only as a last resort. b.out is created by i960 compilers.
-ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out'
-#
-# The IRIX 6 linker writes into existing files which may not be
-# executable, retaining their permissions. Remove them first so a
-# subsequent execution test works.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the Fortran compiler works" >&5
+$as_echo_n "checking whether the Fortran compiler works... " >&6; }
+ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+
+# The possible output files:
+ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"
+
ac_rmfiles=
for ac_file in $ac_files
do
case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;;
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
* ) ac_rmfiles="$ac_rmfiles $ac_file";;
esac
done
rm -f $ac_rmfiles
-if { (ac_try="$ac_link_default"
+if { { ac_try="$ac_link_default"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
(eval "$ac_link_default") 2>&5
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; then :
# Autoconf-2.13 could set the ac_cv_exeext variable to `no'.
# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'
# in a Makefile. We should not override ac_cv_exeext if it was cached,
@@ -2304,14 +2515,14 @@
do
test -f "$ac_file" || continue
case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj )
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )
;;
[ab].out )
# We found the default executable, but exeext='' is most
# certainly right.
break;;
*.* )
- if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;
+ if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;
then :; else
ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
fi
@@ -2330,78 +2541,42 @@
else
ac_file=''
fi
-
-{ echo "$as_me:$LINENO: result: $ac_file" >&5
-echo "${ECHO_T}$ac_file" >&6; }
-if test -z "$ac_file"; then
- echo "$as_me: failed program was:" >&5
+if test -z "$ac_file"; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-{ { echo "$as_me:$LINENO: error: Fortran compiler cannot create executables
-See \`config.log' for more details." >&5
-echo "$as_me: error: Fortran compiler cannot create executables
-See \`config.log' for more details." >&2;}
- { (exit 77); exit 77; }; }
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ as_fn_set_status 77
+as_fn_error "Fortran compiler cannot create executables
+See \`config.log' for more details." "$LINENO" 5; }; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
fi
-
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran compiler default output file name" >&5
+$as_echo_n "checking for Fortran compiler default output file name... " >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5
+$as_echo "$ac_file" >&6; }
ac_exeext=$ac_cv_exeext
-# Check that the compiler produces executables we can run. If not, either
-# the compiler is broken, or we cross compile.
-{ echo "$as_me:$LINENO: checking whether the Fortran compiler works" >&5
-echo $ECHO_N "checking whether the Fortran compiler works... $ECHO_C" >&6; }
-# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
-# If not cross compiling, check that we can run a simple program.
-if test "$cross_compiling" != yes; then
- if { ac_try='./$ac_file'
- { (case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_try") 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- cross_compiling=no
- else
- if test "$cross_compiling" = maybe; then
- cross_compiling=yes
- else
- { { echo "$as_me:$LINENO: error: cannot run Fortran compiled programs.
-If you meant to cross compile, use \`--host'.
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot run Fortran compiled programs.
-If you meant to cross compile, use \`--host'.
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
- fi
- fi
-fi
-{ echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6; }
-
-rm -f a.out a.exe conftest$ac_cv_exeext b.out
+rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out
ac_clean_files=$ac_clean_files_save
-# Check that the compiler produces executables we can run. If not, either
-# the compiler is broken, or we cross compile.
-{ echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
-echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6; }
-{ echo "$as_me:$LINENO: result: $cross_compiling" >&5
-echo "${ECHO_T}$cross_compiling" >&6; }
-
-{ echo "$as_me:$LINENO: checking for suffix of executables" >&5
-echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6; }
-if { (ac_try="$ac_link"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
+$as_echo_n "checking for suffix of executables... " >&6; }
+if { { ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
(eval "$ac_link") 2>&5
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; then :
# If both `conftest.exe' and `conftest' are `present' (well, observable)
# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will
# work properly (i.e., refer to `conftest.exe'), while it won't with
@@ -2409,83 +2584,133 @@
for ac_file in conftest.exe conftest conftest.*; do
test -f "$ac_file" || continue
case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;;
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
*.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
break;;
* ) break;;
esac
done
else
- { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot compute suffix of executables: cannot compile and link
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." "$LINENO" 5; }
fi
+rm -f conftest conftest$ac_cv_exeext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
+$as_echo "$ac_cv_exeext" >&6; }
-rm -f conftest$ac_cv_exeext
-{ echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
-echo "${ECHO_T}$ac_cv_exeext" >&6; }
-
rm -f conftest.$ac_ext
EXEEXT=$ac_cv_exeext
ac_exeext=$EXEEXT
-{ echo "$as_me:$LINENO: checking for suffix of object files" >&5
-echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6; }
-if test "${ac_cv_objext+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+cat > conftest.$ac_ext <<_ACEOF
+ program main
+ open(unit=9,file='conftest.out')
+ close(unit=9)
+
+ end
+_ACEOF
+ac_clean_files="$ac_clean_files conftest.out"
+# Check that the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
+$as_echo_n "checking whether we are cross compiling... " >&6; }
+if test "$cross_compiling" != yes; then
+ { { ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }
+ if { ac_try='./conftest$ac_cv_exeext'
+ { { case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_try") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; }; then
+ cross_compiling=no
+ else
+ if test "$cross_compiling" = maybe; then
+ cross_compiling=yes
+ else
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot run Fortran compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." "$LINENO" 5; }
+ fi
+ fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
+$as_echo "$cross_compiling" >&6; }
+
+rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out
+ac_clean_files=$ac_clean_files_save
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5
+$as_echo_n "checking for suffix of object files... " >&6; }
+if test "${ac_cv_objext+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
+ cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
rm -f conftest.o conftest.obj
-if { (ac_try="$ac_compile"
+if { { ac_try="$ac_compile"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
(eval "$ac_compile") 2>&5
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; then :
for ac_file in conftest.o conftest.obj conftest.*; do
test -f "$ac_file" || continue;
case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;;
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;
*) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
break;;
esac
done
else
- echo "$as_me: failed program was:" >&5
+ $as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot compute suffix of object files: cannot compile
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." "$LINENO" 5; }
fi
-
rm -f conftest.$ac_cv_objext conftest.$ac_ext
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
-echo "${ECHO_T}$ac_cv_objext" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
+$as_echo "$ac_cv_objext" >&6; }
OBJEXT=$ac_cv_objext
ac_objext=$OBJEXT
# If we don't use `.F' as extension, the preprocessor is not run on the
# input file. (Note that this only needs to work for GNU compilers.)
ac_save_ext=$ac_ext
ac_ext=F
-{ echo "$as_me:$LINENO: checking whether we are using the GNU Fortran compiler" >&5
-echo $ECHO_N "checking whether we are using the GNU Fortran compiler... $ECHO_C" >&6; }
-if test "${ac_cv_fc_compiler_gnu+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU Fortran compiler" >&5
+$as_echo_n "checking whether we are using the GNU Fortran compiler... " >&6; }
+if test "${ac_cv_fc_compiler_gnu+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
+ cat > conftest.$ac_ext <<_ACEOF
program main
#ifndef __GNUC__
choke me
@@ -2493,84 +2718,44 @@
end
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_fc_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_fc_try_compile "$LINENO"; then :
ac_compiler_gnu=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_compiler_gnu=no
+ ac_compiler_gnu=no
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_cv_fc_compiler_gnu=$ac_compiler_gnu
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_fc_compiler_gnu" >&5
-echo "${ECHO_T}$ac_cv_fc_compiler_gnu" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_compiler_gnu" >&5
+$as_echo "$ac_cv_fc_compiler_gnu" >&6; }
ac_ext=$ac_save_ext
-ac_test_FFLAGS=${FCFLAGS+set}
-ac_save_FFLAGS=$FCFLAGS
+ac_test_FCFLAGS=${FCFLAGS+set}
+ac_save_FCFLAGS=$FCFLAGS
FCFLAGS=
-{ echo "$as_me:$LINENO: checking whether $FC accepts -g" >&5
-echo $ECHO_N "checking whether $FC accepts -g... $ECHO_C" >&6; }
-if test "${ac_cv_prog_fc_g+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $FC accepts -g" >&5
+$as_echo_n "checking whether $FC accepts -g... " >&6; }
+if test "${ac_cv_prog_fc_g+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
FCFLAGS=-g
-cat >conftest.$ac_ext <<_ACEOF
+cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_fc_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_fc_try_compile "$LINENO"; then :
ac_cv_prog_fc_g=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_cv_prog_fc_g=no
+ ac_cv_prog_fc_g=no
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_prog_fc_g" >&5
-echo "${ECHO_T}$ac_cv_prog_fc_g" >&6; }
-if test "$ac_test_FFLAGS" = set; then
- FCFLAGS=$ac_save_FFLAGS
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_fc_g" >&5
+$as_echo "$ac_cv_prog_fc_g" >&6; }
+if test "$ac_test_FCFLAGS" = set; then
+ FCFLAGS=$ac_save_FCFLAGS
elif test $ac_cv_prog_fc_g = yes; then
if test "x$ac_cv_fc_compiler_gnu" = xyes; then
FCFLAGS="-g -O2"
@@ -2599,12 +2784,10 @@
flags_guess="$SHELL flags.guess"
-{ echo "$as_me:$LINENO: running $flags_guess" >&5
-echo "$as_me: running $flags_guess" >&6;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: running $flags_guess" >&5
+$as_echo "$as_me: running $flags_guess" >&6;}
flags=`$flags_guess` ||
- { { echo "$as_me:$LINENO: error: $flags_guess failed" >&5
-echo "$as_me: error: $flags_guess failed" >&2;}
- { (exit 1); exit 1; }; }
+ as_fn_error "$flags_guess failed" "$LINENO" 5
eval $flags
@@ -2612,37 +2795,21 @@
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
-{ echo "$as_me:$LINENO: checking how to get verbose linking output from $FC" >&5
-echo $ECHO_N "checking how to get verbose linking output from $FC... $ECHO_C" >&6; }
-if test "${ac_cv_prog_fc_v+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to get verbose linking output from $FC" >&5
+$as_echo_n "checking how to get verbose linking output from $FC... " >&6; }
+if test "${ac_cv_prog_fc_v+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
+ cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_fc_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_fc_try_compile "$LINENO"; then :
ac_cv_prog_fc_v=
# Try some options frequently used verbose output
for ac_verb in -v -verbose --verbose -V -\#\#\#; do
- cat >conftest.$ac_ext <<_ACEOF
+ cat > conftest.$ac_ext <<_ACEOF
program main
end
@@ -2652,23 +2819,26 @@
# 1 to this macro) to the Fortran compiler in order to get
# "verbose" output that we can then parse for the Fortran linker
# flags.
-ac_save_FFLAGS=$FCFLAGS
+ac_save_FCFLAGS=$FCFLAGS
FCFLAGS="$FCFLAGS $ac_verb"
eval "set x $ac_link"
shift
-echo "$as_me:$LINENO: $*" >&5
-ac_fc_v_output=`eval $ac_link 5>&1 2>&1 | grep -v 'Driving:'`
-echo "$ac_fc_v_output" >&5
-FCFLAGS=$ac_save_FFLAGS
+$as_echo "$as_me:${as_lineno-$LINENO}: $*" >&5
+# gfortran 4.3 outputs lines setting COLLECT_GCC_OPTIONS, COMPILER_PATH,
+# LIBRARY_PATH; skip all such settings.
+ac_fc_v_output=`eval $ac_link 5>&1 2>&1 |
+ grep -v 'Driving:' | grep -v "^[_$as_cr_Letters][_$as_cr_alnum]*="`
+$as_echo "$ac_fc_v_output" >&5
+FCFLAGS=$ac_save_FCFLAGS
-rm -f conftest*
+rm -rf conftest*
# On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where
# /foo, /bar, and /baz are search directories for the Fortran linker.
# Here, we change these into -L/foo -L/bar -L/baz (and put it first):
ac_fc_v_output="`echo $ac_fc_v_output |
grep 'LPATH is:' |
- sed 's,.*LPATH is\(: *[^ ]*\).*,\1,;s,: */, -L/,g'` $ac_fc_v_output"
+ sed 's|.*LPATH is\(: *[^ ]*\).*|\1|;s|: */| -L/|g'` $ac_fc_v_output"
# FIXME: we keep getting bitten by quoted arguments; a more general fix
# that detects unbalanced quotes in FLIBS should be implemented
@@ -2688,9 +2858,9 @@
# Doubly-quoted arguments were reported for "PGF90/x86 Linux/x86 5.0-2".
*-cmdline\ * | *-ignore\ * | *-def\ *)
ac_fc_v_output=`echo $ac_fc_v_output | sed "\
- s/-cmdline *'[^']*'/ /g; s/-cmdline *\"[^\"]*\"/ /g
- s/-ignore *'[^']*'/ /g; s/-ignore *\"[^\"]*\"/ /g
- s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;;
+ s/-cmdline *'[^']*'/ /g; s/-cmdline *\"[^\"]*\"/ /g
+ s/-ignore *'[^']*'/ /g; s/-ignore *\"[^\"]*\"/ /g
+ s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;;
# If we are using Cray Fortran then delete quotes.
*cft90*)
@@ -2701,39 +2871,35 @@
# look for -l* and *.a constructs in the output
for ac_arg in $ac_fc_v_output; do
case $ac_arg in
- [\\/]*.a | ?:[\\/]*.a | -[lLRu]*)
- ac_cv_prog_fc_v=$ac_verb
- break 2 ;;
+ [\\/]*.a | ?:[\\/]*.a | -[lLRu]*)
+ ac_cv_prog_fc_v=$ac_verb
+ break 2 ;;
esac
done
done
if test -z "$ac_cv_prog_fc_v"; then
- { echo "$as_me:$LINENO: WARNING: cannot determine how to obtain linking information from $FC" >&5
-echo "$as_me: WARNING: cannot determine how to obtain linking information from $FC" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot determine how to obtain linking information from $FC" >&5
+$as_echo "$as_me: WARNING: cannot determine how to obtain linking information from $FC" >&2;}
fi
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- { echo "$as_me:$LINENO: WARNING: compilation failed" >&5
-echo "$as_me: WARNING: compilation failed" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: compilation failed" >&5
+$as_echo "$as_me: WARNING: compilation failed" >&2;}
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_prog_fc_v" >&5
-echo "${ECHO_T}$ac_cv_prog_fc_v" >&6; }
-{ echo "$as_me:$LINENO: checking for Fortran libraries of $FC" >&5
-echo $ECHO_N "checking for Fortran libraries of $FC... $ECHO_C" >&6; }
-if test "${ac_cv_fc_libs+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_fc_v" >&5
+$as_echo "$ac_cv_prog_fc_v" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran libraries of $FC" >&5
+$as_echo_n "checking for Fortran libraries of $FC... " >&6; }
+if test "${ac_cv_fc_libs+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test "x$FCLIBS" != "x"; then
ac_cv_fc_libs="$FCLIBS" # Let the user override the test.
else
-cat >conftest.$ac_ext <<_ACEOF
+cat > conftest.$ac_ext <<_ACEOF
program main
end
@@ -2743,23 +2909,26 @@
# 1 to this macro) to the Fortran compiler in order to get
# "verbose" output that we can then parse for the Fortran linker
# flags.
-ac_save_FFLAGS=$FCFLAGS
+ac_save_FCFLAGS=$FCFLAGS
FCFLAGS="$FCFLAGS $ac_cv_prog_fc_v"
eval "set x $ac_link"
shift
-echo "$as_me:$LINENO: $*" >&5
-ac_fc_v_output=`eval $ac_link 5>&1 2>&1 | grep -v 'Driving:'`
-echo "$ac_fc_v_output" >&5
-FCFLAGS=$ac_save_FFLAGS
+$as_echo "$as_me:${as_lineno-$LINENO}: $*" >&5
+# gfortran 4.3 outputs lines setting COLLECT_GCC_OPTIONS, COMPILER_PATH,
+# LIBRARY_PATH; skip all such settings.
+ac_fc_v_output=`eval $ac_link 5>&1 2>&1 |
+ grep -v 'Driving:' | grep -v "^[_$as_cr_Letters][_$as_cr_alnum]*="`
+$as_echo "$ac_fc_v_output" >&5
+FCFLAGS=$ac_save_FCFLAGS
-rm -f conftest*
+rm -rf conftest*
# On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where
# /foo, /bar, and /baz are search directories for the Fortran linker.
# Here, we change these into -L/foo -L/bar -L/baz (and put it first):
ac_fc_v_output="`echo $ac_fc_v_output |
grep 'LPATH is:' |
- sed 's,.*LPATH is\(: *[^ ]*\).*,\1,;s,: */, -L/,g'` $ac_fc_v_output"
+ sed 's|.*LPATH is\(: *[^ ]*\).*|\1|;s|: */| -L/|g'` $ac_fc_v_output"
# FIXME: we keep getting bitten by quoted arguments; a more general fix
# that detects unbalanced quotes in FLIBS should be implemented
@@ -2779,9 +2948,9 @@
# Doubly-quoted arguments were reported for "PGF90/x86 Linux/x86 5.0-2".
*-cmdline\ * | *-ignore\ * | *-def\ *)
ac_fc_v_output=`echo $ac_fc_v_output | sed "\
- s/-cmdline *'[^']*'/ /g; s/-cmdline *\"[^\"]*\"/ /g
- s/-ignore *'[^']*'/ /g; s/-ignore *\"[^\"]*\"/ /g
- s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;;
+ s/-cmdline *'[^']*'/ /g; s/-cmdline *\"[^\"]*\"/ /g
+ s/-ignore *'[^']*'/ /g; s/-ignore *\"[^\"]*\"/ /g
+ s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;;
# If we are using Cray Fortran then delete quotes.
*cft90*)
@@ -2800,8 +2969,8 @@
shift
ac_arg=$1
case $ac_arg in
- [\\/]*.a | ?:[\\/]*.a)
- ac_exists=false
+ [\\/]*.a | ?:[\\/]*.a)
+ ac_exists=false
for ac_i in $ac_cv_fc_libs; do
if test x"$ac_arg" = x"$ac_i"; then
ac_exists=true
@@ -2809,15 +2978,14 @@
fi
done
- if test x"$ac_exists" = xtrue; then
- :
+ if test x"$ac_exists" = xtrue; then :
+
else
ac_cv_fc_libs="$ac_cv_fc_libs $ac_arg"
fi
-
- ;;
- -bI:*)
- ac_exists=false
+ ;;
+ -bI:*)
+ ac_exists=false
for ac_i in $ac_cv_fc_libs; do
if test x"$ac_arg" = x"$ac_i"; then
ac_exists=true
@@ -2825,8 +2993,8 @@
fi
done
- if test x"$ac_exists" = xtrue; then
- :
+ if test x"$ac_exists" = xtrue; then :
+
else
if test "$ac_compiler_gnu" = yes; then
for ac_link_opt in $ac_arg; do
@@ -2836,18 +3004,18 @@
ac_cv_fc_libs="$ac_cv_fc_libs $ac_arg"
fi
fi
-
- ;;
- # Ignore these flags.
- -lang* | -lcrt*.o | -lc | -lgcc* | -lSystem | -libmil | -LANG:=* | -LIST:* | -LNO:*)
- ;;
- -lkernel32)
- test x"$CYGWIN" != xyes && ac_cv_fc_libs="$ac_cv_fc_libs $ac_arg"
- ;;
- -[LRuYz])
- # These flags, when seen by themselves, take an argument.
- # We remove the space between option and argument and re-iterate
- # unless we find an empty arg or a new option (starting with -)
+ ;;
+ # Ignore these flags.
+ -lang* | -lcrt*.o | -lc | -lgcc* | -lSystem | -libmil | -little \
+ |-LANG:=* | -LIST:* | -LNO:*)
+ ;;
+ -lkernel32)
+ test x"$CYGWIN" != xyes && ac_cv_fc_libs="$ac_cv_fc_libs $ac_arg"
+ ;;
+ -[LRuYz])
+ # These flags, when seen by themselves, take an argument.
+ # We remove the space between option and argument and re-iterate
+ # unless we find an empty arg or a new option (starting with -)
case $2 in
"" | -*);;
*)
@@ -2856,10 +3024,10 @@
set X $ac_arg "$@"
;;
esac
- ;;
- -YP,*)
- for ac_j in `echo $ac_arg | sed -e 's/-YP,/-L/;s/:/ -L/g'`; do
- ac_exists=false
+ ;;
+ -YP,*)
+ for ac_j in `$as_echo "$ac_arg" | sed -e 's/-YP,/-L/;s/:/ -L/g'`; do
+ ac_exists=false
for ac_i in $ac_cv_fc_libs; do
if test x"$ac_j" = x"$ac_i"; then
ac_exists=true
@@ -2867,17 +3035,16 @@
fi
done
- if test x"$ac_exists" = xtrue; then
- :
+ if test x"$ac_exists" = xtrue; then :
+
else
ac_arg="$ac_arg $ac_j"
- ac_cv_fc_libs="$ac_cv_fc_libs $ac_j"
+ ac_cv_fc_libs="$ac_cv_fc_libs $ac_j"
fi
-
- done
- ;;
- -[lLR]*)
- ac_exists=false
+ done
+ ;;
+ -[lLR]*)
+ ac_exists=false
for ac_i in $ac_cv_fc_libs; do
if test x"$ac_arg" = x"$ac_i"; then
ac_exists=true
@@ -2885,17 +3052,16 @@
fi
done
- if test x"$ac_exists" = xtrue; then
- :
+ if test x"$ac_exists" = xtrue; then :
+
else
ac_cv_fc_libs="$ac_cv_fc_libs $ac_arg"
fi
-
- ;;
+ ;;
-zallextract*| -zdefaultextract)
ac_cv_fc_libs="$ac_cv_fc_libs $ac_arg"
;;
- # Ignore everything else.
+ # Ignore everything else.
esac
done
# restore positional arguments
@@ -2906,10 +3072,10 @@
# must begin with a "/").
case `(uname -sr) 2>/dev/null` in
"SunOS 5"*)
- ac_ld_run_path=`echo $ac_fc_v_output |
- sed -n 's,^.*LD_RUN_PATH *= *\(/[^ ]*\).*$,-R\1,p'`
+ ac_ld_run_path=`$as_echo "$ac_fc_v_output" |
+ sed -n 's,^.*LD_RUN_PATH *= *\(/[^ ]*\).*$,-R\1,p'`
test "x$ac_ld_run_path" != x &&
- if test "$ac_compiler_gnu" = yes; then
+ if test "$ac_compiler_gnu" = yes; then
for ac_link_opt in $ac_ld_run_path; do
ac_cv_fc_libs="$ac_cv_fc_libs -Xlinker $ac_link_opt"
done
@@ -2921,8 +3087,8 @@
fi # test "x$[]_AC_LANG_PREFIX[]LIBS" = "x"
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_fc_libs" >&5
-echo "${ECHO_T}$ac_cv_fc_libs" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_libs" >&5
+$as_echo "$ac_cv_fc_libs" >&6; }
FCLIBS="$ac_cv_fc_libs"
@@ -2940,10 +3106,10 @@
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
set dummy ${ac_tool_prefix}gcc; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -2953,25 +3119,25 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_CC="${ac_tool_prefix}gcc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- { echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
@@ -2980,10 +3146,10 @@
ac_ct_CC=$CC
# Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_CC"; then
ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
@@ -2993,25 +3159,25 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_ac_ct_CC="gcc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
- { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
if test "x$ac_ct_CC" = x; then
@@ -3019,12 +3185,8 @@
else
case $cross_compiling:$ac_tool_warned in
yes:)
-{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools
-whose name does not start with the host triplet. If you think this
-configuration is useful to you, please write to autoconf at gnu.org." >&5
-echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools
-whose name does not start with the host triplet. If you think this
-configuration is useful to you, please write to autoconf at gnu.org." >&2;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
CC=$ac_ct_CC
@@ -3037,10 +3199,10 @@
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
set dummy ${ac_tool_prefix}cc; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -3050,25 +3212,25 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_CC="${ac_tool_prefix}cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- { echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
@@ -3077,10 +3239,10 @@
if test -z "$CC"; then
# Extract the first word of "cc", so it can be a program name with args.
set dummy cc; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -3091,18 +3253,18 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
ac_prog_rejected=yes
continue
fi
ac_cv_prog_CC="cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
if test $ac_prog_rejected = yes; then
@@ -3121,11 +3283,11 @@
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- { echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
@@ -3136,10 +3298,10 @@
do
# Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
set dummy $ac_tool_prefix$ac_prog; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -3149,25 +3311,25 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- { echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
@@ -3180,10 +3342,10 @@
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_CC"; then
ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
@@ -3193,25 +3355,25 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_ac_ct_CC="$ac_prog"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
- { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
@@ -3223,12 +3385,8 @@
else
case $cross_compiling:$ac_tool_warned in
yes:)
-{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools
-whose name does not start with the host triplet. If you think this
-configuration is useful to you, please write to autoconf at gnu.org." >&5
-echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools
-whose name does not start with the host triplet. If you think this
-configuration is useful to you, please write to autoconf at gnu.org." >&2;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
CC=$ac_ct_CC
@@ -3238,56 +3396,42 @@
fi
-test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
-See \`config.log' for more details." >&5
-echo "$as_me: error: no acceptable C compiler found in \$PATH
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "no acceptable C compiler found in \$PATH
+See \`config.log' for more details." "$LINENO" 5; }
# Provide some information about the compiler.
-echo "$as_me:$LINENO: checking for C compiler version" >&5
-ac_compiler=`set X $ac_compile; echo $2`
-{ (ac_try="$ac_compiler --version >&5"
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+ { { ac_try="$ac_compiler $ac_option >&5"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compiler --version >&5") 2>&5
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_compiler $ac_option >&5") 2>conftest.err
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
-{ (ac_try="$ac_compiler -v >&5"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compiler -v >&5") 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
-{ (ac_try="$ac_compiler -V >&5"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compiler -V >&5") 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
+ if test -s conftest.err; then
+ sed '10a\
+... rest of stderr output deleted ...
+ 10q' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ fi
+ rm -f conftest.er1 conftest.err
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }
+done
-{ echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
-echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6; }
-if test "${ac_cv_c_compiler_gnu+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
+$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
+if test "${ac_cv_c_compiler_gnu+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef FC_DUMMY_MAIN
@@ -3309,54 +3453,34 @@
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_compiler_gnu=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_compiler_gnu=no
+ ac_compiler_gnu=no
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_cv_c_compiler_gnu=$ac_compiler_gnu
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
-echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6; }
-GCC=`test $ac_compiler_gnu = yes && echo yes`
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
+$as_echo "$ac_cv_c_compiler_gnu" >&6; }
+if test $ac_compiler_gnu = yes; then
+ GCC=yes
+else
+ GCC=
+fi
ac_test_CFLAGS=${CFLAGS+set}
ac_save_CFLAGS=$CFLAGS
-{ echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
-echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6; }
-if test "${ac_cv_prog_cc_g+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
+$as_echo_n "checking whether $CC accepts -g... " >&6; }
+if test "${ac_cv_prog_cc_g+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
ac_save_c_werror_flag=$ac_c_werror_flag
ac_c_werror_flag=yes
ac_cv_prog_cc_g=no
CFLAGS="-g"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef FC_DUMMY_MAIN
@@ -3375,34 +3499,11 @@
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_prog_cc_g=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- CFLAGS=""
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ CFLAGS=""
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef FC_DUMMY_MAIN
@@ -3421,35 +3522,12 @@
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
- :
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+if ac_fn_c_try_compile "$LINENO"; then :
- ac_c_werror_flag=$ac_save_c_werror_flag
+else
+ ac_c_werror_flag=$ac_save_c_werror_flag
CFLAGS="-g"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef FC_DUMMY_MAIN
@@ -3468,42 +3546,18 @@
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_prog_cc_g=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_c_werror_flag=$ac_save_c_werror_flag
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
-echo "${ECHO_T}$ac_cv_prog_cc_g" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
+$as_echo "$ac_cv_prog_cc_g" >&6; }
if test "$ac_test_CFLAGS" = set; then
CFLAGS=$ac_save_CFLAGS
elif test $ac_cv_prog_cc_g = yes; then
@@ -3519,18 +3573,14 @@
CFLAGS=
fi
fi
-{ echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5
-echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; }
-if test "${ac_cv_prog_cc_c89+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }
+if test "${ac_cv_prog_cc_c89+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
ac_cv_prog_cc_c89=no
ac_save_CC=$CC
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdarg.h>
#include <stdio.h>
@@ -3595,31 +3645,9 @@
-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
do
CC="$ac_save_CC $ac_arg"
- rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+ if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_prog_cc_c89=$ac_arg
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-
fi
-
rm -f core conftest.err conftest.$ac_objext
test "x$ac_cv_prog_cc_c89" != "xno" && break
done
@@ -3630,17 +3658,19 @@
# AC_CACHE_VAL
case "x$ac_cv_prog_cc_c89" in
x)
- { echo "$as_me:$LINENO: result: none needed" >&5
-echo "${ECHO_T}none needed" >&6; } ;;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
+$as_echo "none needed" >&6; } ;;
xno)
- { echo "$as_me:$LINENO: result: unsupported" >&5
-echo "${ECHO_T}unsupported" >&6; } ;;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
+$as_echo "unsupported" >&6; } ;;
*)
CC="$CC $ac_cv_prog_cc_c89"
- { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5
-echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
esac
+if test "x$ac_cv_prog_cc_c89" != xno; then :
+fi
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
@@ -3654,10 +3684,10 @@
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
-{ echo "$as_me:$LINENO: checking for dummy main to link with Fortran libraries" >&5
-echo $ECHO_N "checking for dummy main to link with Fortran libraries... $ECHO_C" >&6; }
-if test "${ac_cv_fc_dummy_main+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dummy main to link with Fortran libraries" >&5
+$as_echo_n "checking for dummy main to link with Fortran libraries... " >&6; }
+if test "${ac_cv_fc_dummy_main+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
ac_fc_dm_save_LIBS=$LIBS
LIBS="$LIBS $FCLIBS"
@@ -3669,11 +3699,7 @@
ac_compiler_gnu=$ac_cv_c_compiler_gnu
# First, try linking without a dummy main:
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef FC_DUMMY_MAIN
@@ -3692,42 +3718,17 @@
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (ac_try="$ac_link"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_link") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest$ac_exeext &&
- $as_test_x conftest$ac_exeext; then
+if ac_fn_c_try_link "$LINENO"; then :
ac_cv_fortran_dummy_main=none
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_cv_fortran_dummy_main=unknown
+ ac_cv_fortran_dummy_main=unknown
fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
- conftest$ac_exeext conftest.$ac_ext
-
if test $ac_cv_fortran_dummy_main = unknown; then
for ac_func in MAIN__ MAIN_ __main MAIN _MAIN __MAIN main_ main__ _main; do
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#define $ac_fortran_dm_var $ac_func
#ifdef FC_DUMMY_MAIN
@@ -3746,34 +3747,11 @@
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (ac_try="$ac_link"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_link") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest$ac_exeext &&
- $as_test_x conftest$ac_exeext; then
+if ac_fn_c_try_link "$LINENO"; then :
ac_cv_fortran_dummy_main=$ac_func; break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-
fi
-
-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
done
fi
ac_ext=${ac_fc_srcext-f}
@@ -3781,14 +3759,14 @@
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
ac_cv_fc_dummy_main=$ac_cv_fortran_dummy_main
- rm -f conftest*
+ rm -rf conftest*
LIBS=$ac_fc_dm_save_LIBS
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_fc_dummy_main" >&5
-echo "${ECHO_T}$ac_cv_fc_dummy_main" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_dummy_main" >&5
+$as_echo "$ac_cv_fc_dummy_main" >&6; }
FC_DUMMY_MAIN=$ac_cv_fc_dummy_main
-if test "$FC_DUMMY_MAIN" != unknown; then
+if test "$FC_DUMMY_MAIN" != unknown; then :
if test $FC_DUMMY_MAIN != none; then
cat >>confdefs.h <<_ACEOF
@@ -3797,21 +3775,17 @@
if test "x$ac_cv_fc_dummy_main" = "x$ac_cv_f77_dummy_main"; then
-cat >>confdefs.h <<\_ACEOF
-#define FC_DUMMY_MAIN_EQ_F77 1
-_ACEOF
+$as_echo "#define FC_DUMMY_MAIN_EQ_F77 1" >>confdefs.h
fi
fi
else
- { { echo "$as_me:$LINENO: error: linking to Fortran libraries from C fails
-See \`config.log' for more details." >&5
-echo "$as_me: error: linking to Fortran libraries from C fails
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "linking to Fortran libraries from C fails
+See \`config.log' for more details." "$LINENO" 5; }
fi
-
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
@@ -3822,12 +3796,12 @@
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
-{ echo "$as_me:$LINENO: checking for Fortran name-mangling scheme" >&5
-echo $ECHO_N "checking for Fortran name-mangling scheme... $ECHO_C" >&6; }
-if test "${ac_cv_fc_mangling+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran name-mangling scheme" >&5
+$as_echo_n "checking for Fortran name-mangling scheme... " >&6; }
+if test "${ac_cv_fc_mangling+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
+ cat > conftest.$ac_ext <<_ACEOF
subroutine foobar()
return
end
@@ -3835,23 +3809,7 @@
return
end
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_fc_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_fc_try_compile "$LINENO"; then :
mv conftest.$ac_objext cfortran_test.$ac_objext
ac_save_LIBS=$LIBS
@@ -3866,11 +3824,7 @@
for ac_foobar in foobar FOOBAR; do
for ac_underscore in "" "_"; do
ac_func="$ac_foobar$ac_underscore"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
@@ -3896,34 +3850,11 @@
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (ac_try="$ac_link"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_link") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest$ac_exeext &&
- $as_test_x conftest$ac_exeext; then
+if ac_fn_c_try_link "$LINENO"; then :
ac_success=yes; break 2
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-
fi
-
-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
done
done
ac_ext=${ac_fc_srcext-f}
@@ -3951,11 +3882,7 @@
ac_success_extra=no
for ac_extra in "" "_"; do
ac_func="$ac_foo_bar$ac_underscore$ac_extra"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
@@ -3981,34 +3908,11 @@
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (ac_try="$ac_link"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_link") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest$ac_exeext &&
- $as_test_x conftest$ac_exeext; then
+if ac_fn_c_try_link "$LINENO"; then :
ac_success_extra=yes; break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-
fi
-
-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
done
ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
@@ -4017,16 +3921,16 @@
if test "$ac_success_extra" = "yes"; then
ac_cv_fc_mangling="$ac_case case"
- if test -z "$ac_underscore"; then
- ac_cv_fc_mangling="$ac_cv_fc_mangling, no underscore"
+ if test -z "$ac_underscore"; then
+ ac_cv_fc_mangling="$ac_cv_fc_mangling, no underscore"
else
- ac_cv_fc_mangling="$ac_cv_fc_mangling, underscore"
- fi
- if test -z "$ac_extra"; then
- ac_cv_fc_mangling="$ac_cv_fc_mangling, no extra underscore"
+ ac_cv_fc_mangling="$ac_cv_fc_mangling, underscore"
+ fi
+ if test -z "$ac_extra"; then
+ ac_cv_fc_mangling="$ac_cv_fc_mangling, no extra underscore"
else
- ac_cv_fc_mangling="$ac_cv_fc_mangling, extra underscore"
- fi
+ ac_cv_fc_mangling="$ac_cv_fc_mangling, extra underscore"
+ fi
else
ac_cv_fc_mangling="unknown"
fi
@@ -4035,23 +3939,19 @@
fi
LIBS=$ac_save_LIBS
- rm -f cfortran_test* conftest*
+ rm -rf conftest*
+ rm -f cfortran_test*
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- { { echo "$as_me:$LINENO: error: cannot compile a simple Fortran program
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot compile a simple Fortran program
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot compile a simple Fortran program
+See \`config.log' for more details." "$LINENO" 5; }
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_fc_mangling" >&5
-echo "${ECHO_T}$ac_cv_fc_mangling" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_mangling" >&5
+$as_echo "$ac_cv_fc_mangling" >&6; }
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
@@ -4063,85 +3963,51 @@
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
-
-
case $ac_cv_fc_mangling in
"lower case, no underscore, no extra underscore")
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC(name,NAME) name
-_ACEOF
+ $as_echo "#define FC_FUNC(name,NAME) name" >>confdefs.h
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC_(name,NAME) name
-_ACEOF
+ $as_echo "#define FC_FUNC_(name,NAME) name" >>confdefs.h
;;
"lower case, no underscore, extra underscore")
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC(name,NAME) name
-_ACEOF
+ $as_echo "#define FC_FUNC(name,NAME) name" >>confdefs.h
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC_(name,NAME) name ## _
-_ACEOF
+ $as_echo "#define FC_FUNC_(name,NAME) name ## _" >>confdefs.h
;;
"lower case, underscore, no extra underscore")
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC(name,NAME) name ## _
-_ACEOF
+ $as_echo "#define FC_FUNC(name,NAME) name ## _" >>confdefs.h
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC_(name,NAME) name ## _
-_ACEOF
+ $as_echo "#define FC_FUNC_(name,NAME) name ## _" >>confdefs.h
;;
"lower case, underscore, extra underscore")
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC(name,NAME) name ## _
-_ACEOF
+ $as_echo "#define FC_FUNC(name,NAME) name ## _" >>confdefs.h
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC_(name,NAME) name ## __
-_ACEOF
+ $as_echo "#define FC_FUNC_(name,NAME) name ## __" >>confdefs.h
;;
"upper case, no underscore, no extra underscore")
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC(name,NAME) NAME
-_ACEOF
+ $as_echo "#define FC_FUNC(name,NAME) NAME" >>confdefs.h
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC_(name,NAME) NAME
-_ACEOF
+ $as_echo "#define FC_FUNC_(name,NAME) NAME" >>confdefs.h
;;
"upper case, no underscore, extra underscore")
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC(name,NAME) NAME
-_ACEOF
+ $as_echo "#define FC_FUNC(name,NAME) NAME" >>confdefs.h
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC_(name,NAME) NAME ## _
-_ACEOF
+ $as_echo "#define FC_FUNC_(name,NAME) NAME ## _" >>confdefs.h
;;
"upper case, underscore, no extra underscore")
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC(name,NAME) NAME ## _
-_ACEOF
+ $as_echo "#define FC_FUNC(name,NAME) NAME ## _" >>confdefs.h
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC_(name,NAME) NAME ## _
-_ACEOF
+ $as_echo "#define FC_FUNC_(name,NAME) NAME ## _" >>confdefs.h
;;
"upper case, underscore, extra underscore")
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC(name,NAME) NAME ## _
-_ACEOF
+ $as_echo "#define FC_FUNC(name,NAME) NAME ## _" >>confdefs.h
- cat >>confdefs.h <<\_ACEOF
-#define FC_FUNC_(name,NAME) NAME ## __
-_ACEOF
+ $as_echo "#define FC_FUNC_(name,NAME) NAME ## __" >>confdefs.h
;;
*)
- { echo "$as_me:$LINENO: WARNING: unknown Fortran name-mangling scheme" >&5
-echo "$as_me: WARNING: unknown Fortran name-mangling scheme" >&2;}
- ;;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unknown Fortran name-mangling scheme" >&5
+$as_echo "$as_me: WARNING: unknown Fortran name-mangling scheme" >&2;}
+ ;;
esac
ac_ext=c
@@ -4159,10 +4025,10 @@
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
-{ echo "$as_me:$LINENO: checking for Fortran flag to compile .f90 files" >&5
-echo $ECHO_N "checking for Fortran flag to compile .f90 files... $ECHO_C" >&6; }
-if test "${ac_cv_fc_srcext_f90+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran flag to compile .f90 files" >&5
+$as_echo_n "checking for Fortran flag to compile .f90 files... " >&6; }
+if test "${ac_cv_fc_srcext_f90+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
ac_ext=f90
ac_fcflags_srcext_save=$ac_fcflags_srcext
@@ -4170,48 +4036,24 @@
ac_cv_fc_srcext_f90=unknown
for ac_flag in none -qsuffix=f=f90 -Tf; do
test "x$ac_flag" != xnone && ac_fcflags_srcext="$ac_flag"
- cat >conftest.$ac_ext <<_ACEOF
+ cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_fc_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_fc_try_compile "$LINENO"; then :
ac_cv_fc_srcext_f90=$ac_flag; break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
done
rm -f conftest.$ac_objext conftest.f90
ac_fcflags_srcext=$ac_fcflags_srcext_save
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_fc_srcext_f90" >&5
-echo "${ECHO_T}$ac_cv_fc_srcext_f90" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_srcext_f90" >&5
+$as_echo "$ac_cv_fc_srcext_f90" >&6; }
if test "x$ac_cv_fc_srcext_f90" = xunknown; then
- { { echo "$as_me:$LINENO: error: Fortran could not compile .f90 files" >&5
-echo "$as_me: error: Fortran could not compile .f90 files" >&2;}
- { (exit 1); exit 1; }; }
+ as_fn_error "Fortran could not compile .f90 files" "$LINENO" 5
else
ac_fc_srcext=f90
if test "x$ac_cv_fc_srcext_f90" = xnone; then
@@ -4233,62 +4075,39 @@
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
-{ echo "$as_me:$LINENO: checking for Fortran flag needed to allow free-form source" >&5
-echo $ECHO_N "checking for Fortran flag needed to allow free-form source... $ECHO_C" >&6; }
-if test "${ac_cv_fc_freeform+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran flag needed to allow free-form source" >&5
+$as_echo_n "checking for Fortran flag needed to allow free-form source... " >&6; }
+if test "${ac_cv_fc_freeform+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
ac_cv_fc_freeform=unknown
ac_fc_freeform_FCFLAGS_save=$FCFLAGS
for ac_flag in none -ffree-form -FR -free -qfree -Mfree -Mfreeform \
- -freeform "-f free"
+ -freeform "-f free"
do
test "x$ac_flag" != xnone && FCFLAGS="$ac_fc_freeform_FCFLAGS_save $ac_flag"
- cat >conftest.$ac_ext <<_ACEOF
+ cat > conftest.$ac_ext <<_ACEOF
program freeform
! FIXME: how to best confuse non-freeform compilers?
print *, 'Hello ', &
- 'world.'
+ 'world.'
end
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_fc_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_fc_try_compile "$LINENO"; then :
ac_cv_fc_freeform=$ac_flag; break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
done
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
FCFLAGS=$ac_fc_freeform_FCFLAGS_save
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_fc_freeform" >&5
-echo "${ECHO_T}$ac_cv_fc_freeform" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_freeform" >&5
+$as_echo "$ac_cv_fc_freeform" >&6; }
if test "x$ac_cv_fc_freeform" = xunknown; then
- { { echo "$as_me:$LINENO: error: Fortran does not accept free-form source" >&5
-echo "$as_me: error: Fortran does not accept free-form source" >&2;}
- { (exit 77); exit 77; }; }
+ { as_fn_set_status 77
+as_fn_error "Fortran does not accept free-form source" "$LINENO" 5; }
else
if test "x$ac_cv_fc_freeform" != xnone; then
FCFLAGS="$FCFLAGS $ac_cv_fc_freeform"
@@ -4309,10 +4128,10 @@
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
set dummy ${ac_tool_prefix}gcc; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -4322,25 +4141,25 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_CC="${ac_tool_prefix}gcc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- { echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
@@ -4349,10 +4168,10 @@
ac_ct_CC=$CC
# Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_CC"; then
ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
@@ -4362,25 +4181,25 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_ac_ct_CC="gcc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
- { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
if test "x$ac_ct_CC" = x; then
@@ -4388,12 +4207,8 @@
else
case $cross_compiling:$ac_tool_warned in
yes:)
-{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools
-whose name does not start with the host triplet. If you think this
-configuration is useful to you, please write to autoconf at gnu.org." >&5
-echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools
-whose name does not start with the host triplet. If you think this
-configuration is useful to you, please write to autoconf at gnu.org." >&2;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
CC=$ac_ct_CC
@@ -4406,10 +4221,10 @@
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
set dummy ${ac_tool_prefix}cc; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -4419,25 +4234,25 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_CC="${ac_tool_prefix}cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- { echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
@@ -4446,10 +4261,10 @@
if test -z "$CC"; then
# Extract the first word of "cc", so it can be a program name with args.
set dummy cc; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -4460,18 +4275,18 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
ac_prog_rejected=yes
continue
fi
ac_cv_prog_CC="cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
if test $ac_prog_rejected = yes; then
@@ -4490,11 +4305,11 @@
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- { echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
@@ -4505,10 +4320,10 @@
do
# Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
set dummy $ac_tool_prefix$ac_prog; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -4518,25 +4333,25 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- { echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
@@ -4549,10 +4364,10 @@
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
-{ echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_CC"; then
ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
@@ -4562,25 +4377,25 @@
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_ac_ct_CC="$ac_prog"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
IFS=$as_save_IFS
fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
- { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
@@ -4592,12 +4407,8 @@
else
case $cross_compiling:$ac_tool_warned in
yes:)
-{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools
-whose name does not start with the host triplet. If you think this
-configuration is useful to you, please write to autoconf at gnu.org." >&5
-echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools
-whose name does not start with the host triplet. If you think this
-configuration is useful to you, please write to autoconf at gnu.org." >&2;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
CC=$ac_ct_CC
@@ -4607,56 +4418,42 @@
fi
-test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
-See \`config.log' for more details." >&5
-echo "$as_me: error: no acceptable C compiler found in \$PATH
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "no acceptable C compiler found in \$PATH
+See \`config.log' for more details." "$LINENO" 5; }
# Provide some information about the compiler.
-echo "$as_me:$LINENO: checking for C compiler version" >&5
-ac_compiler=`set X $ac_compile; echo $2`
-{ (ac_try="$ac_compiler --version >&5"
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+ { { ac_try="$ac_compiler $ac_option >&5"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compiler --version >&5") 2>&5
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_compiler $ac_option >&5") 2>conftest.err
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
-{ (ac_try="$ac_compiler -v >&5"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compiler -v >&5") 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
-{ (ac_try="$ac_compiler -V >&5"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compiler -V >&5") 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
+ if test -s conftest.err; then
+ sed '10a\
+... rest of stderr output deleted ...
+ 10q' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ fi
+ rm -f conftest.er1 conftest.err
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }
+done
-{ echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
-echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6; }
-if test "${ac_cv_c_compiler_gnu+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
+$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
+if test "${ac_cv_c_compiler_gnu+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef FC_DUMMY_MAIN
@@ -4678,54 +4475,34 @@
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_compiler_gnu=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_compiler_gnu=no
+ ac_compiler_gnu=no
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_cv_c_compiler_gnu=$ac_compiler_gnu
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
-echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6; }
-GCC=`test $ac_compiler_gnu = yes && echo yes`
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
+$as_echo "$ac_cv_c_compiler_gnu" >&6; }
+if test $ac_compiler_gnu = yes; then
+ GCC=yes
+else
+ GCC=
+fi
ac_test_CFLAGS=${CFLAGS+set}
ac_save_CFLAGS=$CFLAGS
-{ echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
-echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6; }
-if test "${ac_cv_prog_cc_g+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
+$as_echo_n "checking whether $CC accepts -g... " >&6; }
+if test "${ac_cv_prog_cc_g+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
ac_save_c_werror_flag=$ac_c_werror_flag
ac_c_werror_flag=yes
ac_cv_prog_cc_g=no
CFLAGS="-g"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef FC_DUMMY_MAIN
@@ -4744,34 +4521,11 @@
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_prog_cc_g=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- CFLAGS=""
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ CFLAGS=""
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef FC_DUMMY_MAIN
@@ -4790,35 +4544,12 @@
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
- :
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+if ac_fn_c_try_compile "$LINENO"; then :
- ac_c_werror_flag=$ac_save_c_werror_flag
+else
+ ac_c_werror_flag=$ac_save_c_werror_flag
CFLAGS="-g"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef FC_DUMMY_MAIN
@@ -4837,42 +4568,18 @@
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_prog_cc_g=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_c_werror_flag=$ac_save_c_werror_flag
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
-echo "${ECHO_T}$ac_cv_prog_cc_g" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
+$as_echo "$ac_cv_prog_cc_g" >&6; }
if test "$ac_test_CFLAGS" = set; then
CFLAGS=$ac_save_CFLAGS
elif test $ac_cv_prog_cc_g = yes; then
@@ -4888,18 +4595,14 @@
CFLAGS=
fi
fi
-{ echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5
-echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; }
-if test "${ac_cv_prog_cc_c89+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }
+if test "${ac_cv_prog_cc_c89+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
ac_cv_prog_cc_c89=no
ac_save_CC=$CC
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdarg.h>
#include <stdio.h>
@@ -4964,31 +4667,9 @@
-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
do
CC="$ac_save_CC $ac_arg"
- rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+ if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_prog_cc_c89=$ac_arg
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-
fi
-
rm -f core conftest.err conftest.$ac_objext
test "x$ac_cv_prog_cc_c89" != "xno" && break
done
@@ -4999,17 +4680,19 @@
# AC_CACHE_VAL
case "x$ac_cv_prog_cc_c89" in
x)
- { echo "$as_me:$LINENO: result: none needed" >&5
-echo "${ECHO_T}none needed" >&6; } ;;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
+$as_echo "none needed" >&6; } ;;
xno)
- { echo "$as_me:$LINENO: result: unsupported" >&5
-echo "${ECHO_T}unsupported" >&6; } ;;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
+$as_echo "unsupported" >&6; } ;;
*)
CC="$CC $ac_cv_prog_cc_c89"
- { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5
-echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
esac
+if test "x$ac_cv_prog_cc_c89" != xno; then :
+fi
ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
@@ -5024,7 +4707,7 @@
# Check whether --with-scotch-lib was given.
-if test "${with_scotch_lib+set}" = set; then
+if test "${with_scotch_lib+set}" = set; then :
withval=$with_scotch_lib;
ac_scotch_libdir="$withval";
@@ -5037,71 +4720,48 @@
LDFLAGS="${LDFLAGS} -L${ac_scotch_libdir}";
fi
#AC_CHECK_LIB(scotcherr,SCOTCH_errorPrint ,[scotch_lib="yes"],[scotch_lib="no";LDFLAGS=${ac_save_ldflags}])
-{ echo "$as_me:$LINENO: checking for scotchfarchinit in -lscotch" >&5
-echo $ECHO_N "checking for scotchfarchinit in -lscotch... $ECHO_C" >&6; }
-if test "${ac_cv_lib_scotch_scotchfarchinit_+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for scotchfarchinit in -lscotch" >&5
+$as_echo_n "checking for scotchfarchinit in -lscotch... " >&6; }
+if test "${ac_cv_lib_scotch_scotchfarchinit_+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lscotch -lscotcherr $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
+cat > conftest.$ac_ext <<_ACEOF
program main
call scotchfarchinit
end
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (ac_try="$ac_link"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_link") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_fc_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest$ac_exeext &&
- $as_test_x conftest$ac_exeext; then
+if ac_fn_fc_try_link "$LINENO"; then :
ac_cv_lib_scotch_scotchfarchinit_=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_cv_lib_scotch_scotchfarchinit_=no
+ ac_cv_lib_scotch_scotchfarchinit_=no
fi
-
-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_lib_scotch_scotchfarchinit_" >&5
-echo "${ECHO_T}$ac_cv_lib_scotch_scotchfarchinit_" >&6; }
-if test $ac_cv_lib_scotch_scotchfarchinit_ = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_scotch_scotchfarchinit_" >&5
+$as_echo "$ac_cv_lib_scotch_scotchfarchinit_" >&6; }
+if test "x$ac_cv_lib_scotch_scotchfarchinit_" = x""yes; then :
scotch_lib="yes";
else
scotch_lib="no";LDFLAGS=${ac_save_ldflags}
fi
-{ echo "$as_me:$LINENO: checking whether scotch is usable" >&5
-echo $ECHO_N "checking whether scotch is usable... $ECHO_C" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether Scotch is usable" >&5
+$as_echo_n "checking whether Scotch is usable... " >&6; }
if test "x${scotch_lib}" = "xyes"; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_SCOTCH 1
-_ACEOF
+$as_echo "#define HAVE_SCOTCH 1" >>confdefs.h
SCOTCH_LIBS="-L${ac_scotch_libdir} -lscotch -lscotcherr"
- { echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
else
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
LDFLAGS=${ac_save_ldflags}
@@ -5151,66 +4811,60 @@
pyspecfem3D="$builddir/pyspecfem3D"
cd $srcdir
- { echo "$as_me:$LINENO: downloading missing Python dependencies" >&5
-echo "$as_me: downloading missing Python dependencies" >&6;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: downloading missing Python dependencies" >&5
+$as_echo "$as_me: downloading missing Python dependencies" >&6;}
if { ac_try='$pyspecfem3D setup.py install_deps -zmxd $builddir/deps >&5 2>&5'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5
(eval $ac_try) 2>&5
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- :
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; }; then :
+
else
- { { echo "$as_me:$LINENO: error: cannot download missing Python dependencies
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot download missing Python dependencies
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot download missing Python dependencies
+See \`config.log' for more details." "$LINENO" 5; }
fi
-
- { echo "$as_me:$LINENO: building Python dependencies" >&5
-echo "$as_me: building Python dependencies" >&6;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: building Python dependencies" >&5
+$as_echo "$as_me: building Python dependencies" >&6;}
if { ac_try='$pyspecfem3D setup.py develop -H None -f $builddir/deps -s $builddir -d $builddir/python >&5 2>&5'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5
(eval $ac_try) 2>&5
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- :
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; }; then :
+
else
- { { echo "$as_me:$LINENO: error: building Python dependencies
-See \`config.log' for more details." >&5
-echo "$as_me: error: building Python dependencies
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "building Python dependencies
+See \`config.log' for more details." "$LINENO" 5; }
fi
-
- { echo "$as_me:$LINENO: checking for egg-related flags" >&5
-echo $ECHO_N "checking for egg-related flags... $ECHO_C" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for egg-related flags" >&5
+$as_echo_n "checking for egg-related flags... " >&6; }
if { ac_try='$pyspecfem3D setup.py egg_flags >&5 2>&5'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5
(eval $ac_try) 2>&5
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- { echo "$as_me:$LINENO: result: ok" >&5
-echo "${ECHO_T}ok" >&6; }
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; }; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5
+$as_echo "ok" >&6; }
. egg-flags.sh
rm -f egg-flags.sh
else
- { echo "$as_me:$LINENO: result: failed" >&5
-echo "${ECHO_T}failed" >&6; }
- { { echo "$as_me:$LINENO: error: cannot scan Python eggs for flags
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot scan Python eggs for flags
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: failed" >&5
+$as_echo "failed" >&6; }
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot scan Python eggs for flags
+See \`config.log' for more details." "$LINENO" 5; }
fi
-
cd $builddir
rm -f pyspecfem3D
PYTHONPATH="$save_PYTHONPATH"
@@ -5247,9 +4901,9 @@
FC=$MPIFC
FCFLAGS="$FCFLAGS $FLAGS_NO_CHECK"
-{ echo "$as_me:$LINENO: checking whether mpif.h works" >&5
-echo $ECHO_N "checking whether mpif.h works... $ECHO_C" >&6; }
-cat >conftest.$ac_ext <<_ACEOF
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether mpif.h works" >&5
+$as_echo_n "checking whether mpif.h works... " >&6; }
+cat > conftest.$ac_ext <<_ACEOF
program main
@@ -5263,34 +4917,15 @@
end
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_fc_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_fc_try_compile "$LINENO"; then :
- { echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
cit_mpif_h=unknown
cit_mpifc_info=`$FC -compile_info 2>/dev/null`
for cit_arg in $cit_mpifc_info; do
@@ -5299,15 +4934,14 @@
esac
done
if test "$cit_mpif_h" == "unknown"; then
- { { echo "$as_me:$LINENO: error: cannot compile a trivial MPI program using $MPIFC
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot compile a trivial MPI program using $MPIFC
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot compile a trivial MPI program using $MPIFC
+See \`config.log' for more details." "$LINENO" 5; }
fi
- { echo "$as_me:$LINENO: creating $ofile" >&5
-echo "$as_me: creating $ofile" >&6;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ofile" >&5
+$as_echo "$as_me: creating $ofile" >&6;}
cat >"$cfgfile" <<END_OF_HEADER
! $ofile. Generated from $cit_mpif_h by configure.
@@ -5316,9 +4950,9 @@
mv -f "$cfgfile" "$ofile" || \
(rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile")
- { echo "$as_me:$LINENO: checking whether generated mpif.h works" >&5
-echo $ECHO_N "checking whether generated mpif.h works... $ECHO_C" >&6; }
- cat >conftest.$ac_ext <<_ACEOF
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether generated mpif.h works" >&5
+$as_echo_n "checking whether generated mpif.h works... " >&6; }
+ cat > conftest.$ac_ext <<_ACEOF
program main
@@ -5332,47 +4966,25 @@
end
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_fc_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_fc_try_compile "$LINENO"; then :
- { echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot compile a trivial MPI program using $MPIFC
+See \`config.log' for more details." "$LINENO" 5; }
- { echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6; }
- { { echo "$as_me:$LINENO: error: cannot compile a trivial MPI program using $MPIFC
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot compile a trivial MPI program using $MPIFC
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
-
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
FC=$cit_fc_save_fc
@@ -5394,10 +5006,10 @@
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
-{ echo "$as_me:$LINENO: checking for alternate main to link with Fortran libraries" >&5
-echo $ECHO_N "checking for alternate main to link with Fortran libraries... $ECHO_C" >&6; }
-if test "${ac_cv_fc_main+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for alternate main to link with Fortran libraries" >&5
+$as_echo_n "checking for alternate main to link with Fortran libraries... " >&6; }
+if test "${ac_cv_fc_main+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
ac_fc_m_save_LIBS=$LIBS
LIBS="cfortran_test.$ac_objext $LIBS"
@@ -5410,11 +5022,7 @@
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef FC_DUMMY_MAIN_EQ_F77
# undef F77_DUMMY_MAIN
@@ -5439,74 +5047,30 @@
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (ac_try="$ac_compile"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_compile") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_c_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest.$ac_objext; then
+if ac_fn_c_try_compile "$LINENO"; then :
mv conftest.$ac_objext cfortran_test.$ac_objext
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- { { echo "$as_me:$LINENO: error: cannot compile a simple C program
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot compile a simple C program
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot compile a simple C program
+See \`config.log' for more details." "$LINENO" 5; }
fi
-
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
- cat >conftest.$ac_ext <<_ACEOF
+ cat > conftest.$ac_ext <<_ACEOF
subroutine foobar()
return
end
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (ac_try="$ac_link"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
- (eval "$ac_link") 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && {
- test -z "$ac_fc_werror_flag" ||
- test ! -s conftest.err
- } && test -s conftest$ac_exeext &&
- $as_test_x conftest$ac_exeext; then
+if ac_fn_fc_try_link "$LINENO"; then :
ac_cv_fortran_main=$ac_func; break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-
fi
-
-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
rm -f cfortran_test* conftest*
done
ac_cv_fc_main=$ac_cv_fortran_main
@@ -5514,8 +5078,8 @@
LIBS=$ac_fc_m_save_LIBS
fi
-{ echo "$as_me:$LINENO: result: $ac_cv_fc_main" >&5
-echo "${ECHO_T}$ac_cv_fc_main" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_main" >&5
+$as_echo "$ac_cv_fc_main" >&6; }
cat >>confdefs.h <<_ACEOF
#define FC_MAIN $ac_cv_fc_main
@@ -5534,7 +5098,7 @@
# Checks for library functions.
-ac_config_files="$ac_config_files Makefile constants.h precision.h DATA/Par_file DATA/CMTSOLUTION DATA/STATIONS meshfem3D/Makefile meshfem3D/precision.h meshfem3D/constants.h decompose_mesh_SCOTCH/Makefile"
+ac_config_files="$ac_config_files Makefile in_data_files/Par_file in_data_files/CMTSOLUTION in_data_files/STATIONS src/meshfem3D/Makefile src/meshfem3D/constants.h src/meshfem3D/precision.h src/decompose_mesh_SCOTCH/Makefile src/specfem3D/Makefile src/generate_databases/Makefile src/shared/constants.h src/shared/precision.h"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
@@ -5563,12 +5127,13 @@
case $ac_val in #(
*${as_nl}*)
case $ac_var in #(
- *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5
-echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;;
+ *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
esac
case $ac_var in #(
_ | IFS | as_nl) ;; #(
- *) $as_unset $ac_var ;;
+ BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+ *) { eval $ac_var=; unset $ac_var;} ;;
esac ;;
esac
done
@@ -5576,8 +5141,8 @@
(set) 2>&1 |
case $as_nl`(ac_space=' '; set) 2>&1` in #(
*${as_nl}ac_space=\ *)
- # `set' does not quote correctly, so add quotes (double-quote
- # substitution turns \\\\ into \\, and sed turns \\ into \).
+ # `set' does not quote correctly, so add quotes: double-quote
+ # substitution turns \\\\ into \\, and sed turns \\ into \.
sed -n \
"s/'/'\\\\''/g;
s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
@@ -5600,12 +5165,12 @@
if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
if test -w "$cache_file"; then
test "x$cache_file" != "x/dev/null" &&
- { echo "$as_me:$LINENO: updating cache $cache_file" >&5
-echo "$as_me: updating cache $cache_file" >&6;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
+$as_echo "$as_me: updating cache $cache_file" >&6;}
cat confcache >$cache_file
else
- { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5
-echo "$as_me: not updating unwritable cache $cache_file" >&6;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
+$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
fi
fi
rm -f confcache
@@ -5621,11 +5186,11 @@
for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
# 1. Remove the extension, and $U if already installed.
ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
- ac_i=`echo "$ac_i" | sed "$ac_script"`
+ ac_i=`$as_echo "$ac_i" | sed "$ac_script"`
# 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR
# will be set to the directory where LIBOBJS objects are built.
- ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext"
- ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo'
+ as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"
+ as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'
done
LIBOBJS=$ac_libobjs
@@ -5633,26 +5198,22 @@
if test -z "${COND_PYRE_TRUE}" && test -z "${COND_PYRE_FALSE}"; then
- { { echo "$as_me:$LINENO: error: conditional \"COND_PYRE\" was never defined.
-Usually this means the macro was only invoked conditionally." >&5
-echo "$as_me: error: conditional \"COND_PYRE\" was never defined.
-Usually this means the macro was only invoked conditionally." >&2;}
- { (exit 1); exit 1; }; }
+ as_fn_error "conditional \"COND_PYRE\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
if test -z "${COND_MPI_TRUE}" && test -z "${COND_MPI_FALSE}"; then
- { { echo "$as_me:$LINENO: error: conditional \"COND_MPI\" was never defined.
-Usually this means the macro was only invoked conditionally." >&5
-echo "$as_me: error: conditional \"COND_MPI\" was never defined.
-Usually this means the macro was only invoked conditionally." >&2;}
- { (exit 1); exit 1; }; }
+ as_fn_error "conditional \"COND_MPI\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
: ${CONFIG_STATUS=./config.status}
+ac_write_fail=0
ac_clean_files_save=$ac_clean_files
ac_clean_files="$ac_clean_files $CONFIG_STATUS"
-{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
-echo "$as_me: creating $CONFIG_STATUS" >&6;}
-cat >$CONFIG_STATUS <<_ACEOF
+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
+as_write_fail=0
+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
#! $SHELL
# Generated by $as_me.
# Run this file to recreate the current configuration.
@@ -5662,59 +5223,79 @@
debug=false
ac_cs_recheck=false
ac_cs_silent=false
+
SHELL=\${CONFIG_SHELL-$SHELL}
-_ACEOF
+export SHELL
+_ASEOF
+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
-cat >>$CONFIG_STATUS <<\_ACEOF
-## --------------------- ##
-## M4sh Initialization. ##
-## --------------------- ##
-
# Be more Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
setopt NO_GLOB_SUBST
else
- case `(set -o) 2>/dev/null` in
- *posix*) set -o posix ;;
+ case `(set -o) 2>/dev/null` in #(
+ *posix*) :
+ set -o posix ;; #(
+ *) :
+ ;;
esac
-
fi
-
-
-# PATH needs CR
-# Avoid depending upon Character Ranges.
-as_cr_letters='abcdefghijklmnopqrstuvwxyz'
-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-as_cr_Letters=$as_cr_letters$as_cr_LETTERS
-as_cr_digits='0123456789'
-as_cr_alnum=$as_cr_Letters$as_cr_digits
-
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='print -r --'
+ as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='printf %s\n'
+ as_echo_n='printf %s'
+else
+ if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+ as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+ as_echo_n='/usr/ucb/echo -n'
else
- PATH_SEPARATOR=:
+ as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+ as_echo_n_body='eval
+ arg=$1;
+ case $arg in #(
+ *"$as_nl"*)
+ expr "X$arg" : "X\\(.*\\)$as_nl";
+ arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+ esac;
+ expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+ '
+ export as_echo_n_body
+ as_echo_n='sh -c $as_echo_n_body as_echo'
fi
- rm -f conf$$.sh
+ export as_echo_body
+ as_echo='sh -c $as_echo_body as_echo'
fi
-# Support unset when possible.
-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
- as_unset=unset
-else
- as_unset=false
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ PATH_SEPARATOR=:
+ (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+ (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+ PATH_SEPARATOR=';'
+ }
fi
@@ -5723,20 +5304,18 @@
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
-as_nl='
-'
IFS=" "" $as_nl"
# Find who we are. Look in the path if we contain no directory separator.
-case $0 in
+case $0 in #((
*[\\/]* ) as_myself=$0 ;;
*) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+ done
IFS=$as_save_IFS
;;
@@ -5747,32 +5326,111 @@
as_myself=$0
fi
if test ! -f "$as_myself"; then
- echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
- { (exit 1); exit 1; }
+ $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+ exit 1
fi
-# Work around bugs in pre-3.0 UWIN ksh.
-for as_var in ENV MAIL MAILPATH
-do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there. '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '
# NLS nuisances.
-for as_var in \
- LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
- LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
- LC_TELEPHONE LC_TIME
-do
- if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
- eval $as_var=C; export $as_var
- else
- ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+
+# as_fn_error ERROR [LINENO LOG_FD]
+# ---------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with status $?, using 1 if that was 0.
+as_fn_error ()
+{
+ as_status=$?; test $as_status -eq 0 && as_status=1
+ if test "$3"; then
+ as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3
fi
-done
+ $as_echo "$as_me: error: $1" >&2
+ as_fn_exit $as_status
+} # as_fn_error
-# Required to use basename.
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+ return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+ set +e
+ as_fn_set_status $1
+ exit $1
+} # as_fn_exit
+
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+ { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+ eval 'as_fn_append ()
+ {
+ eval $1+=\$2
+ }'
+else
+ as_fn_append ()
+ {
+ eval $1=\$$1\$2
+ }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+ eval 'as_fn_arith ()
+ {
+ as_val=$(( $* ))
+ }'
+else
+ as_fn_arith ()
+ {
+ as_val=`expr "$@" || test $? -eq 1`
+ }
+fi # as_fn_arith
+
+
if expr a : '\(a\)' >/dev/null 2>&1 &&
test "X`expr 00001 : '.*\(...\)'`" = X001; then
as_expr=expr
@@ -5786,13 +5444,17 @@
as_basename=false
fi
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+ as_dirname=dirname
+else
+ as_dirname=false
+fi
-# Name of the executable.
as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
X"$0" : 'X\(//\)$' \| \
X"$0" : 'X\(/\)' \| . 2>/dev/null ||
-echo X/"$0" |
+$as_echo X/"$0" |
sed '/^.*\/\([^/][^/]*\)\/*$/{
s//\1/
q
@@ -5807,104 +5469,103 @@
}
s/.*/./; q'`
-# CDPATH.
-$as_unset CDPATH
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
-
-
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || {
-
- # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
- # uniformly replaced by the line number. The first 'sed' inserts a
- # line-number line after each line using $LINENO; the second 'sed'
- # does the real work. The second script uses 'N' to pair each
- # line-number line with the line containing $LINENO, and appends
- # trailing '-' during substitution so that $LINENO is not a special
- # case at line end.
- # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
- # scripts with optimization help from Paolo Bonzini. Blame Lee
- # E. McMahon (1931-1989) for sed's syntax. :-)
- sed -n '
- p
- /[$]LINENO/=
- ' <$as_myself |
- sed '
- s/[$]LINENO.*/&-/
- t lineno
- b
- :lineno
- N
- :loop
- s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
- t loop
- s/-\n.*//
- ' >$as_me.lineno &&
- chmod +x "$as_me.lineno" ||
- { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
- { (exit 1); exit 1; }; }
-
- # Don't try to exec as it changes $[0], causing all sort of problems
- # (the dirname of $[0] is not the place where we might find the
- # original and so on. Autoconf is especially sensitive to this).
- . "./$as_me.lineno"
- # Exit status is that of the last command.
- exit
-}
-
-
-if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
- as_dirname=dirname
-else
- as_dirname=false
-fi
-
ECHO_C= ECHO_N= ECHO_T=
-case `echo -n x` in
+case `echo -n x` in #(((((
-n*)
- case `echo 'x\c'` in
+ case `echo 'xy\c'` in
*c*) ECHO_T=' ';; # ECHO_T is single tab character.
- *) ECHO_C='\c';;
+ xy) ECHO_C='\c';;
+ *) echo `echo ksh88 bug on AIX 6.1` > /dev/null
+ ECHO_T=' ';;
esac;;
*)
ECHO_N='-n';;
esac
-if expr a : '\(a\)' >/dev/null 2>&1 &&
- test "X`expr 00001 : '.*\(...\)'`" = X001; then
- as_expr=expr
-else
- as_expr=false
-fi
-
rm -f conf$$ conf$$.exe conf$$.file
if test -d conf$$.dir; then
rm -f conf$$.dir/conf$$.file
else
rm -f conf$$.dir
- mkdir conf$$.dir
+ mkdir conf$$.dir 2>/dev/null
fi
-echo >conf$$.file
-if ln -s conf$$.file conf$$ 2>/dev/null; then
- as_ln_s='ln -s'
- # ... but there are two gotchas:
- # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
- # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
- # In both cases, we have to default to `cp -p'.
- ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+if (echo >conf$$.file) 2>/dev/null; then
+ if ln -s conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s='ln -s'
+ # ... but there are two gotchas:
+ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+ # In both cases, we have to default to `cp -p'.
+ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+ as_ln_s='cp -p'
+ elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+ else
as_ln_s='cp -p'
-elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
+ fi
else
as_ln_s='cp -p'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+ case $as_dir in #(
+ -*) as_dir=./$as_dir;;
+ esac
+ test -d "$as_dir" || eval $as_mkdir_p || {
+ as_dirs=
+ while :; do
+ case $as_dir in #(
+ *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+ *) as_qdir=$as_dir;;
+ esac
+ as_dirs="'$as_qdir' $as_dirs"
+ as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ test -d "$as_dir" && break
+ done
+ test -z "$as_dirs" || eval "mkdir $as_dirs"
+ } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
if mkdir -p . 2>/dev/null; then
- as_mkdir_p=:
+ as_mkdir_p='mkdir -p "$as_dir"'
else
test -d ./-p && rmdir ./-p
as_mkdir_p=false
@@ -5921,12 +5582,12 @@
as_test_x='
eval sh -c '\''
if test -d "$1"; then
- test -d "$1/.";
+ test -d "$1/.";
else
- case $1 in
- -*)set "./$1";;
+ case $1 in #(
+ -*)set "./$1";;
esac;
- case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in
+ case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
???[sx]*):;;*)false;;esac;fi
'\'' sh
'
@@ -5941,13 +5602,19 @@
exec 6>&1
+## ----------------------------------- ##
+## Main body of $CONFIG_STATUS script. ##
+## ----------------------------------- ##
+_ASEOF
+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
-# Save the log message, to keep $[0] and so on meaningful, and to
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# Save the log message, to keep $0 and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by Specfem 3D $as_me 1.4.0, which was
-generated by GNU Autoconf 2.61. Invocation command line was
+generated by GNU Autoconf 2.65. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
CONFIG_HEADERS = $CONFIG_HEADERS
@@ -5960,29 +5627,41 @@
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
+case $ac_config_files in *"
+"*) set x $ac_config_files; shift; ac_config_files=$*;;
+esac
+
+case $ac_config_headers in *"
+"*) set x $ac_config_headers; shift; ac_config_headers=$*;;
+esac
+
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
# Files that config.status was made for.
config_files="$ac_config_files"
config_headers="$ac_config_headers"
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
ac_cs_usage="\
-\`$as_me' instantiates files from templates according to the
-current configuration.
+\`$as_me' instantiates files and other configuration actions
+from templates according to the current configuration. Unless the files
+and actions are specified as TAGs, all are instantiated by default.
-Usage: $0 [OPTIONS] [FILE]...
+Usage: $0 [OPTION]... [TAG]...
-h, --help print this help, then exit
-V, --version print version number and configuration settings, then exit
- -q, --quiet do not print progress messages
+ --config print configuration, then exit
+ -q, --quiet, --silent
+ do not print progress messages
-d, --debug don't remove temporary files
--recheck update $as_me by reconfiguring in the same conditions
- --file=FILE[:TEMPLATE]
- instantiate the configuration file FILE
- --header=FILE[:TEMPLATE]
- instantiate the configuration header FILE
+ --file=FILE[:TEMPLATE]
+ instantiate the configuration file FILE
+ --header=FILE[:TEMPLATE]
+ instantiate the configuration header FILE
Configuration files:
$config_files
@@ -5990,26 +5669,27 @@
Configuration headers:
$config_headers
-Report bugs to <bug-autoconf at gnu.org>."
+Report bugs to <jtromp AT caltech.edu>."
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
Specfem 3D config.status 1.4.0
-configured by $0, generated by GNU Autoconf 2.61,
- with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
+configured by $0, generated by GNU Autoconf 2.65,
+ with options \\"\$ac_cs_config\\"
-Copyright (C) 2006 Free Software Foundation, Inc.
+Copyright (C) 2009 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
ac_pwd='$ac_pwd'
srcdir='$srcdir'
+test -n "\$AWK" || AWK=awk
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-# If no file are specified by the user, then we need to provide default
-# value. By we need to know if files were specified by the user.
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# The default lists apply if the user does not specify any file.
ac_need_defaults=:
while test $# != 0
do
@@ -6031,34 +5711,40 @@
-recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
ac_cs_recheck=: ;;
--version | --versio | --versi | --vers | --ver | --ve | --v | -V )
- echo "$ac_cs_version"; exit ;;
+ $as_echo "$ac_cs_version"; exit ;;
+ --config | --confi | --conf | --con | --co | --c )
+ $as_echo "$ac_cs_config"; exit ;;
--debug | --debu | --deb | --de | --d | -d )
debug=: ;;
--file | --fil | --fi | --f )
$ac_shift
- CONFIG_FILES="$CONFIG_FILES $ac_optarg"
+ case $ac_optarg in
+ *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ esac
+ as_fn_append CONFIG_FILES " '$ac_optarg'"
ac_need_defaults=false;;
--header | --heade | --head | --hea )
$ac_shift
- CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
+ case $ac_optarg in
+ *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ esac
+ as_fn_append CONFIG_HEADERS " '$ac_optarg'"
ac_need_defaults=false;;
--he | --h)
# Conflict between --help and --header
- { echo "$as_me: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&2
- { (exit 1); exit 1; }; };;
+ as_fn_error "ambiguous option: \`$1'
+Try \`$0 --help' for more information.";;
--help | --hel | -h )
- echo "$ac_cs_usage"; exit ;;
+ $as_echo "$ac_cs_usage"; exit ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil | --si | --s)
ac_cs_silent=: ;;
# This is an error.
- -*) { echo "$as_me: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&2
- { (exit 1); exit 1; }; } ;;
+ -*) as_fn_error "unrecognized option: \`$1'
+Try \`$0 --help' for more information." ;;
- *) ac_config_targets="$ac_config_targets $1"
+ *) as_fn_append ac_config_targets " $1"
ac_need_defaults=false ;;
esac
@@ -6073,30 +5759,32 @@
fi
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
if \$ac_cs_recheck; then
- echo "running CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
- CONFIG_SHELL=$SHELL
+ set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+ shift
+ \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
+ CONFIG_SHELL='$SHELL'
export CONFIG_SHELL
- exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+ exec "\$@"
fi
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
exec 5>>config.log
{
echo
sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
## Running $as_me. ##
_ASBOX
- echo "$ac_log"
+ $as_echo "$ac_log"
} >&5
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Handling of arguments.
for ac_config_target in $ac_config_targets
@@ -6104,19 +5792,19 @@
case $ac_config_target in
"config.h") CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;;
"Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
- "constants.h") CONFIG_FILES="$CONFIG_FILES constants.h" ;;
- "precision.h") CONFIG_FILES="$CONFIG_FILES precision.h" ;;
- "DATA/Par_file") CONFIG_FILES="$CONFIG_FILES DATA/Par_file" ;;
- "DATA/CMTSOLUTION") CONFIG_FILES="$CONFIG_FILES DATA/CMTSOLUTION" ;;
- "DATA/STATIONS") CONFIG_FILES="$CONFIG_FILES DATA/STATIONS" ;;
- "meshfem3D/Makefile") CONFIG_FILES="$CONFIG_FILES meshfem3D/Makefile" ;;
- "meshfem3D/precision.h") CONFIG_FILES="$CONFIG_FILES meshfem3D/precision.h" ;;
- "meshfem3D/constants.h") CONFIG_FILES="$CONFIG_FILES meshfem3D/constants.h" ;;
- "decompose_mesh_SCOTCH/Makefile") CONFIG_FILES="$CONFIG_FILES decompose_mesh_SCOTCH/Makefile" ;;
+ "in_data_files/Par_file") CONFIG_FILES="$CONFIG_FILES in_data_files/Par_file" ;;
+ "in_data_files/CMTSOLUTION") CONFIG_FILES="$CONFIG_FILES in_data_files/CMTSOLUTION" ;;
+ "in_data_files/STATIONS") CONFIG_FILES="$CONFIG_FILES in_data_files/STATIONS" ;;
+ "src/meshfem3D/Makefile") CONFIG_FILES="$CONFIG_FILES src/meshfem3D/Makefile" ;;
+ "src/meshfem3D/constants.h") CONFIG_FILES="$CONFIG_FILES src/meshfem3D/constants.h" ;;
+ "src/meshfem3D/precision.h") CONFIG_FILES="$CONFIG_FILES src/meshfem3D/precision.h" ;;
+ "src/decompose_mesh_SCOTCH/Makefile") CONFIG_FILES="$CONFIG_FILES src/decompose_mesh_SCOTCH/Makefile" ;;
+ "src/specfem3D/Makefile") CONFIG_FILES="$CONFIG_FILES src/specfem3D/Makefile" ;;
+ "src/generate_databases/Makefile") CONFIG_FILES="$CONFIG_FILES src/generate_databases/Makefile" ;;
+ "src/shared/constants.h") CONFIG_FILES="$CONFIG_FILES src/shared/constants.h" ;;
+ "src/shared/precision.h") CONFIG_FILES="$CONFIG_FILES src/shared/precision.h" ;;
- *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
-echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
- { (exit 1); exit 1; }; };;
+ *) as_fn_error "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
esac
done
@@ -6142,7 +5830,7 @@
trap 'exit_status=$?
{ test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status
' 0
- trap '{ (exit 1); exit 1; }' 1 2 13 15
+ trap 'as_fn_exit 1' 1 2 13 15
}
# Create a (secure) tmp directory for tmp files.
@@ -6153,158 +5841,140 @@
{
tmp=./conf$$-$RANDOM
(umask 077 && mkdir "$tmp")
-} ||
-{
- echo "$me: cannot create a temporary directory in ." >&2
- { (exit 1); exit 1; }
-}
+} || as_fn_error "cannot create a temporary directory in ." "$LINENO" 5
-#
-# Set up the sed scripts for CONFIG_FILES section.
-#
-
-# No need to generate the scripts if there are no CONFIG_FILES.
-# This happens for instance when ./config.status config.h
+# Set up the scripts for CONFIG_FILES section.
+# No need to generate them if there are no CONFIG_FILES.
+# This happens for instance with `./config.status config.h'.
if test -n "$CONFIG_FILES"; then
-_ACEOF
+ac_cr=`echo X | tr X '\015'`
+# On cygwin, bash can eat \r inside `` if the user requested igncr.
+# But we know of no other shell where ac_cr would be empty at this
+# point, so we can use a bashism as a fallback.
+if test "x$ac_cr" = x; then
+ eval ac_cr=\$\'\\r\'
+fi
+ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`
+if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
+ ac_cs_awk_cr='\r'
+else
+ ac_cs_awk_cr=$ac_cr
+fi
+echo 'BEGIN {' >"$tmp/subs1.awk" &&
+_ACEOF
+
+{
+ echo "cat >conf$$subs.awk <<_ACEOF" &&
+ echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&
+ echo "_ACEOF"
+} >conf$$subs.sh ||
+ as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5
+ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'`
ac_delim='%!_!# '
for ac_last_try in false false false false false :; do
- cat >conf$$subs.sed <<_ACEOF
-SHELL!$SHELL$ac_delim
-PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim
-PACKAGE_NAME!$PACKAGE_NAME$ac_delim
-PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim
-PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim
-PACKAGE_STRING!$PACKAGE_STRING$ac_delim
-PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim
-exec_prefix!$exec_prefix$ac_delim
-prefix!$prefix$ac_delim
-program_transform_name!$program_transform_name$ac_delim
-bindir!$bindir$ac_delim
-sbindir!$sbindir$ac_delim
-libexecdir!$libexecdir$ac_delim
-datarootdir!$datarootdir$ac_delim
-datadir!$datadir$ac_delim
-sysconfdir!$sysconfdir$ac_delim
-sharedstatedir!$sharedstatedir$ac_delim
-localstatedir!$localstatedir$ac_delim
-includedir!$includedir$ac_delim
-oldincludedir!$oldincludedir$ac_delim
-docdir!$docdir$ac_delim
-infodir!$infodir$ac_delim
-htmldir!$htmldir$ac_delim
-dvidir!$dvidir$ac_delim
-pdfdir!$pdfdir$ac_delim
-psdir!$psdir$ac_delim
-libdir!$libdir$ac_delim
-localedir!$localedir$ac_delim
-mandir!$mandir$ac_delim
-DEFS!$DEFS$ac_delim
-ECHO_C!$ECHO_C$ac_delim
-ECHO_N!$ECHO_N$ac_delim
-ECHO_T!$ECHO_T$ac_delim
-LIBS!$LIBS$ac_delim
-build_alias!$build_alias$ac_delim
-host_alias!$host_alias$ac_delim
-target_alias!$target_alias$ac_delim
-COND_PYRE_TRUE!$COND_PYRE_TRUE$ac_delim
-COND_PYRE_FALSE!$COND_PYRE_FALSE$ac_delim
-COND_MPI_TRUE!$COND_MPI_TRUE$ac_delim
-COND_MPI_FALSE!$COND_MPI_FALSE$ac_delim
-CUSTOM_REAL!$CUSTOM_REAL$ac_delim
-CUSTOM_MPI_TYPE!$CUSTOM_MPI_TYPE$ac_delim
-PYTHON!$PYTHON$ac_delim
-PYTHON_VERSION!$PYTHON_VERSION$ac_delim
-PYTHON_PREFIX!$PYTHON_PREFIX$ac_delim
-PYTHON_EXEC_PREFIX!$PYTHON_EXEC_PREFIX$ac_delim
-PYTHON_PLATFORM!$PYTHON_PLATFORM$ac_delim
-pythondir!$pythondir$ac_delim
-pkgpythondir!$pkgpythondir$ac_delim
-pyexecdir!$pyexecdir$ac_delim
-pkgpyexecdir!$pkgpyexecdir$ac_delim
-PYTHON_INCDIR!$PYTHON_INCDIR$ac_delim
-PYTHON_BLDLIBRARY!$PYTHON_BLDLIBRARY$ac_delim
-PYTHON_LDFLAGS!$PYTHON_LDFLAGS$ac_delim
-PYTHON_LDLAST!$PYTHON_LDLAST$ac_delim
-PYTHON_LDLIBRARY!$PYTHON_LDLIBRARY$ac_delim
-PYTHON_LIBDIR!$PYTHON_LIBDIR$ac_delim
-PYTHON_LIBP!$PYTHON_LIBP$ac_delim
-PYTHON_LIBPL!$PYTHON_LIBPL$ac_delim
-PYTHON_LIBS!$PYTHON_LIBS$ac_delim
-PYTHON_LINKFORSHARED!$PYTHON_LINKFORSHARED$ac_delim
-PYTHON_MODLIBS!$PYTHON_MODLIBS$ac_delim
-PYTHON_SYSLIBS!$PYTHON_SYSLIBS$ac_delim
-PYTHON_LA_LDFLAGS!$PYTHON_LA_LDFLAGS$ac_delim
-FC!$FC$ac_delim
-FCFLAGS!$FCFLAGS$ac_delim
-LDFLAGS!$LDFLAGS$ac_delim
-ac_ct_FC!$ac_ct_FC$ac_delim
-EXEEXT!$EXEEXT$ac_delim
-OBJEXT!$OBJEXT$ac_delim
-FCENV!$FCENV$ac_delim
-FCLIBS!$FCLIBS$ac_delim
-CC!$CC$ac_delim
-CFLAGS!$CFLAGS$ac_delim
-CPPFLAGS!$CPPFLAGS$ac_delim
-ac_ct_CC!$ac_ct_CC$ac_delim
-FCFLAGS_f90!$FCFLAGS_f90$ac_delim
-SCOTCH_LIBS!$SCOTCH_LIBS$ac_delim
-MPIFC!$MPIFC$ac_delim
-MPILIBS!$MPILIBS$ac_delim
-MPICC!$MPICC$ac_delim
-FLAGS_CHECK!$FLAGS_CHECK$ac_delim
-FLAGS_NO_CHECK!$FLAGS_NO_CHECK$ac_delim
-LOCAL_PATH_IS_ALSO_GLOBAL!$LOCAL_PATH_IS_ALSO_GLOBAL$ac_delim
-PYTHONPATH!$PYTHONPATH$ac_delim
-PYTHON_EGG_CFLAGS!$PYTHON_EGG_CFLAGS$ac_delim
-PYTHON_EGG_CPPFLAGS!$PYTHON_EGG_CPPFLAGS$ac_delim
-PYTHON_EGG_LDFLAGS!$PYTHON_EGG_LDFLAGS$ac_delim
-LIBOBJS!$LIBOBJS$ac_delim
-LTLIBOBJS!$LTLIBOBJS$ac_delim
-_ACEOF
+ . ./conf$$subs.sh ||
+ as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5
- if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 91; then
+ ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`
+ if test $ac_delim_n = $ac_delim_num; then
break
elif $ac_last_try; then
- { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5
-echo "$as_me: error: could not make $CONFIG_STATUS" >&2;}
- { (exit 1); exit 1; }; }
+ as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5
else
ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
fi
done
+rm -f conf$$subs.sh
-ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed`
-if test -n "$ac_eof"; then
- ac_eof=`echo "$ac_eof" | sort -nru | sed 1q`
- ac_eof=`expr $ac_eof + 1`
-fi
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+cat >>"\$tmp/subs1.awk" <<\\_ACAWK &&
+_ACEOF
+sed -n '
+h
+s/^/S["/; s/!.*/"]=/
+p
+g
+s/^[^!]*!//
+:repl
+t repl
+s/'"$ac_delim"'$//
+t delim
+:nl
+h
+s/\(.\{148\}\)..*/\1/
+t more1
+s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/
+p
+n
+b repl
+:more1
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t nl
+:delim
+h
+s/\(.\{148\}\)..*/\1/
+t more2
+s/["\\]/\\&/g; s/^/"/; s/$/"/
+p
+b
+:more2
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t delim
+' <conf$$subs.awk | sed '
+/^[^""]/{
+ N
+ s/\n//
+}
+' >>$CONFIG_STATUS || ac_write_fail=1
+rm -f conf$$subs.awk
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+_ACAWK
+cat >>"\$tmp/subs1.awk" <<_ACAWK &&
+ for (key in S) S_is_set[key] = 1
+ FS = ""
-cat >>$CONFIG_STATUS <<_ACEOF
-cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof
-/@[a-zA-Z_][a-zA-Z_0-9]*@/!b end
+}
+{
+ line = $ 0
+ nfields = split(line, field, "@")
+ substed = 0
+ len = length(field[1])
+ for (i = 2; i < nfields; i++) {
+ key = field[i]
+ keylen = length(key)
+ if (S_is_set[key]) {
+ value = S[key]
+ line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
+ len += length(value) + length(field[++i])
+ substed = 1
+ } else
+ len += 1 + keylen
+ }
+
+ print line
+}
+
+_ACAWK
_ACEOF
-sed '
-s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g
-s/^/s,@/; s/!/@,|#_!!_#|/
-:n
-t n
-s/'"$ac_delim"'$/,g/; t
-s/$/\\/; p
-N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n
-' >>$CONFIG_STATUS <conf$$subs.sed
-rm -f conf$$subs.sed
-cat >>$CONFIG_STATUS <<_ACEOF
-:end
-s/|#_!!_#|//g
-CEOF$ac_eof
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
+ sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
+else
+ cat
+fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \
+ || as_fn_error "could not setup config files machinery" "$LINENO" 5
_ACEOF
-
# VPATH may cause trouble with some makes, so we remove $(srcdir),
# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
# trailing colons and then remove the whole line if VPATH becomes empty
@@ -6320,20 +5990,128 @@
}'
fi
-cat >>$CONFIG_STATUS <<\_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
fi # test -n "$CONFIG_FILES"
+# Set up the scripts for CONFIG_HEADERS section.
+# No need to generate them if there are no CONFIG_HEADERS.
+# This happens for instance with `./config.status Makefile'.
+if test -n "$CONFIG_HEADERS"; then
+cat >"$tmp/defines.awk" <<\_ACAWK ||
+BEGIN {
+_ACEOF
-for ac_tag in :F $CONFIG_FILES :H $CONFIG_HEADERS
+# Transform confdefs.h into an awk script `defines.awk', embedded as
+# here-document in config.status, that substitutes the proper values into
+# config.h.in to produce config.h.
+
+# Create a delimiter string that does not exist in confdefs.h, to ease
+# handling of long lines.
+ac_delim='%!_!# '
+for ac_last_try in false false :; do
+ ac_t=`sed -n "/$ac_delim/p" confdefs.h`
+ if test -z "$ac_t"; then
+ break
+ elif $ac_last_try; then
+ as_fn_error "could not make $CONFIG_HEADERS" "$LINENO" 5
+ else
+ ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
+ fi
+done
+
+# For the awk script, D is an array of macro values keyed by name,
+# likewise P contains macro parameters if any. Preserve backslash
+# newline sequences.
+
+ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*
+sed -n '
+s/.\{148\}/&'"$ac_delim"'/g
+t rset
+:rset
+s/^[ ]*#[ ]*define[ ][ ]*/ /
+t def
+d
+:def
+s/\\$//
+t bsnl
+s/["\\]/\\&/g
+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\
+D["\1"]=" \3"/p
+s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p
+d
+:bsnl
+s/["\\]/\\&/g
+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\
+D["\1"]=" \3\\\\\\n"\\/p
+t cont
+s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p
+t cont
+d
+:cont
+n
+s/.\{148\}/&'"$ac_delim"'/g
+t clear
+:clear
+s/\\$//
+t bsnlc
+s/["\\]/\\&/g; s/^/"/; s/$/"/p
+d
+:bsnlc
+s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p
+b cont
+' <confdefs.h | sed '
+s/'"$ac_delim"'/"\\\
+"/g' >>$CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ for (key in D) D_is_set[key] = 1
+ FS = ""
+}
+/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ {
+ line = \$ 0
+ split(line, arg, " ")
+ if (arg[1] == "#") {
+ defundef = arg[2]
+ mac1 = arg[3]
+ } else {
+ defundef = substr(arg[1], 2)
+ mac1 = arg[2]
+ }
+ split(mac1, mac2, "(") #)
+ macro = mac2[1]
+ prefix = substr(line, 1, index(line, defundef) - 1)
+ if (D_is_set[macro]) {
+ # Preserve the white space surrounding the "#".
+ print prefix "define", macro P[macro] D[macro]
+ next
+ } else {
+ # Replace #undef with comments. This is necessary, for example,
+ # in the case of _POSIX_SOURCE, which is predefined and required
+ # on some systems where configure will not decide to define it.
+ if (defundef == "undef") {
+ print "/*", prefix defundef, macro, "*/"
+ next
+ }
+ }
+}
+{ print }
+_ACAWK
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+ as_fn_error "could not setup config headers machinery" "$LINENO" 5
+fi # test -n "$CONFIG_HEADERS"
+
+
+eval set X " :F $CONFIG_FILES :H $CONFIG_HEADERS "
+shift
+for ac_tag
do
case $ac_tag in
:[FHLC]) ac_mode=$ac_tag; continue;;
esac
case $ac_mode$ac_tag in
:[FHL]*:*);;
- :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5
-echo "$as_me: error: Invalid tag $ac_tag." >&2;}
- { (exit 1); exit 1; }; };;
+ :L* | :C*:*) as_fn_error "invalid tag \`$ac_tag'" "$LINENO" 5;;
:[FH]-) ac_tag=-:-;;
:[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
esac
@@ -6361,26 +6139,34 @@
[\\/$]*) false;;
*) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
esac ||
- { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5
-echo "$as_me: error: cannot find input file: $ac_f" >&2;}
- { (exit 1); exit 1; }; };;
+ as_fn_error "cannot find input file: \`$ac_f'" "$LINENO" 5;;
esac
- ac_file_inputs="$ac_file_inputs $ac_f"
+ case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
+ as_fn_append ac_file_inputs " '$ac_f'"
done
# Let's still pretend it is `configure' which instantiates (i.e., don't
# use $as_me), people would be surprised to read:
# /* config.h. Generated by config.status. */
- configure_input="Generated from "`IFS=:
- echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure."
+ configure_input='Generated from '`
+ $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
+ `' by configure.'
if test x"$ac_file" != x-; then
configure_input="$ac_file. $configure_input"
- { echo "$as_me:$LINENO: creating $ac_file" >&5
-echo "$as_me: creating $ac_file" >&6;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
+$as_echo "$as_me: creating $ac_file" >&6;}
fi
+ # Neutralize special characters interpreted by sed in replacement strings.
+ case $configure_input in #(
+ *\&* | *\|* | *\\* )
+ ac_sed_conf_input=`$as_echo "$configure_input" |
+ sed 's/[\\\\&|]/\\\\&/g'`;; #(
+ *) ac_sed_conf_input=$configure_input;;
+ esac
case $ac_tag in
- *:-:* | *:-) cat >"$tmp/stdin";;
+ *:-:* | *:-) cat >"$tmp/stdin" \
+ || as_fn_error "could not create $ac_file" "$LINENO" 5 ;;
esac
;;
esac
@@ -6390,7 +6176,7 @@
X"$ac_file" : 'X\(//\)[^/]' \| \
X"$ac_file" : 'X\(//\)$' \| \
X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
-echo X"$ac_file" |
+$as_echo X"$ac_file" |
sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
s//\1/
q
@@ -6408,55 +6194,15 @@
q
}
s/.*/./; q'`
- { as_dir="$ac_dir"
- case $as_dir in #(
- -*) as_dir=./$as_dir;;
- esac
- test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || {
- as_dirs=
- while :; do
- case $as_dir in #(
- *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #(
- *) as_qdir=$as_dir;;
- esac
- as_dirs="'$as_qdir' $as_dirs"
- as_dir=`$as_dirname -- "$as_dir" ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$as_dir" : 'X\(//\)[^/]' \| \
- X"$as_dir" : 'X\(//\)$' \| \
- X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
-echo X"$as_dir" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
- s//\1/
- q
- }
- /^X\(\/\/\)[^/].*/{
- s//\1/
- q
- }
- /^X\(\/\/\)$/{
- s//\1/
- q
- }
- /^X\(\/\).*/{
- s//\1/
- q
- }
- s/.*/./; q'`
- test -d "$as_dir" && break
- done
- test -z "$as_dirs" || eval "mkdir $as_dirs"
- } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5
-echo "$as_me: error: cannot create directory $as_dir" >&2;}
- { (exit 1); exit 1; }; }; }
+ as_dir="$ac_dir"; as_fn_mkdir_p
ac_builddir=.
case "$ac_dir" in
.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
*)
- ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
# A ".." for each directory in $ac_dir_suffix.
- ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'`
+ ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
case $ac_top_builddir_sub in
"") ac_top_builddir_sub=. ac_top_build_prefix= ;;
*) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
@@ -6492,12 +6238,12 @@
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# If the template does not know about datarootdir, expand it.
# FIXME: This hack should be removed a few years after 2.60.
ac_datarootdir_hack=; ac_datarootdir_seen=
-
-case `sed -n '/datarootdir/ {
+ac_sed_dataroot='
+/datarootdir/ {
p
q
}
@@ -6505,36 +6251,37 @@
/@docdir@/p
/@infodir@/p
/@localedir@/p
-/@mandir@/p
-' $ac_file_inputs` in
+/@mandir@/p'
+case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
*datarootdir*) ac_datarootdir_seen=yes;;
*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
- { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
-echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
+$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_datarootdir_hack='
s&@datadir@&$datadir&g
s&@docdir@&$docdir&g
s&@infodir@&$infodir&g
s&@localedir@&$localedir&g
s&@mandir@&$mandir&g
- s&\\\${datarootdir}&$datarootdir&g' ;;
+ s&\\\${datarootdir}&$datarootdir&g' ;;
esac
_ACEOF
# Neutralize VPATH when `$srcdir' = `.'.
# Shell code in configure.ac might set extrasub.
# FIXME: do we really want to maintain this feature?
-cat >>$CONFIG_STATUS <<_ACEOF
- sed "$ac_vpsub
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_sed_extra="$ac_vpsub
$extrasub
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
:t
/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
-s&@configure_input@&$configure_input&;t t
+s|@configure_input@|$ac_sed_conf_input|;t t
s&@top_builddir@&$ac_top_builddir_sub&;t t
+s&@top_build_prefix@&$ac_top_build_prefix&;t t
s&@srcdir@&$ac_srcdir&;t t
s&@abs_srcdir@&$ac_abs_srcdir&;t t
s&@top_srcdir@&$ac_top_srcdir&;t t
@@ -6543,119 +6290,48 @@
s&@abs_builddir@&$ac_abs_builddir&;t t
s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
$ac_datarootdir_hack
-" $ac_file_inputs | sed -f "$tmp/subs-1.sed" >$tmp/out
+"
+eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$tmp/subs.awk" >$tmp/out \
+ || as_fn_error "could not create $ac_file" "$LINENO" 5
test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
{ ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } &&
{ ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } &&
- { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
which seems to be undefined. Please make sure it is defined." >&5
-echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
which seems to be undefined. Please make sure it is defined." >&2;}
rm -f "$tmp/stdin"
case $ac_file in
- -) cat "$tmp/out"; rm -f "$tmp/out";;
- *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;;
- esac
+ -) cat "$tmp/out" && rm -f "$tmp/out";;
+ *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";;
+ esac \
+ || as_fn_error "could not create $ac_file" "$LINENO" 5
;;
:H)
#
# CONFIG_HEADER
#
-_ACEOF
-
-# Transform confdefs.h into a sed script `conftest.defines', that
-# substitutes the proper values into config.h.in to produce config.h.
-rm -f conftest.defines conftest.tail
-# First, append a space to every undef/define line, to ease matching.
-echo 's/$/ /' >conftest.defines
-# Then, protect against being on the right side of a sed subst, or in
-# an unquoted here document, in config.status. If some macros were
-# called several times there might be several #defines for the same
-# symbol, which is useless. But do not sort them, since the last
-# AC_DEFINE must be honored.
-ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*
-# These sed commands are passed to sed as "A NAME B PARAMS C VALUE D", where
-# NAME is the cpp macro being defined, VALUE is the value it is being given.
-# PARAMS is the parameter list in the macro definition--in most cases, it's
-# just an empty string.
-ac_dA='s,^\\([ #]*\\)[^ ]*\\([ ]*'
-ac_dB='\\)[ (].*,\\1define\\2'
-ac_dC=' '
-ac_dD=' ,'
-
-uniq confdefs.h |
- sed -n '
- t rset
- :rset
- s/^[ ]*#[ ]*define[ ][ ]*//
- t ok
- d
- :ok
- s/[\\&,]/\\&/g
- s/^\('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/ '"$ac_dA"'\1'"$ac_dB"'\2'"${ac_dC}"'\3'"$ac_dD"'/p
- s/^\('"$ac_word_re"'\)[ ]*\(.*\)/'"$ac_dA"'\1'"$ac_dB$ac_dC"'\2'"$ac_dD"'/p
- ' >>conftest.defines
-
-# Remove the space that was appended to ease matching.
-# Then replace #undef with comments. This is necessary, for
-# example, in the case of _POSIX_SOURCE, which is predefined and required
-# on some systems where configure will not decide to define it.
-# (The regexp can be short, since the line contains either #define or #undef.)
-echo 's/ $//
-s,^[ #]*u.*,/* & */,' >>conftest.defines
-
-# Break up conftest.defines:
-ac_max_sed_lines=50
-
-# First sed command is: sed -f defines.sed $ac_file_inputs >"$tmp/out1"
-# Second one is: sed -f defines.sed "$tmp/out1" >"$tmp/out2"
-# Third one will be: sed -f defines.sed "$tmp/out2" >"$tmp/out1"
-# et cetera.
-ac_in='$ac_file_inputs'
-ac_out='"$tmp/out1"'
-ac_nxt='"$tmp/out2"'
-
-while :
-do
- # Write a here document:
- cat >>$CONFIG_STATUS <<_ACEOF
- # First, check the format of the line:
- cat >"\$tmp/defines.sed" <<\\CEOF
-/^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*\$/b def
-/^[ ]*#[ ]*define[ ][ ]*$ac_word_re[( ]/b def
-b
-:def
-_ACEOF
- sed ${ac_max_sed_lines}q conftest.defines >>$CONFIG_STATUS
- echo 'CEOF
- sed -f "$tmp/defines.sed"' "$ac_in >$ac_out" >>$CONFIG_STATUS
- ac_in=$ac_out; ac_out=$ac_nxt; ac_nxt=$ac_in
- sed 1,${ac_max_sed_lines}d conftest.defines >conftest.tail
- grep . conftest.tail >/dev/null || break
- rm -f conftest.defines
- mv conftest.tail conftest.defines
-done
-rm -f conftest.defines conftest.tail
-
-echo "ac_result=$ac_in" >>$CONFIG_STATUS
-cat >>$CONFIG_STATUS <<\_ACEOF
if test x"$ac_file" != x-; then
- echo "/* $configure_input */" >"$tmp/config.h"
- cat "$ac_result" >>"$tmp/config.h"
- if diff $ac_file "$tmp/config.h" >/dev/null 2>&1; then
- { echo "$as_me:$LINENO: $ac_file is unchanged" >&5
-echo "$as_me: $ac_file is unchanged" >&6;}
+ {
+ $as_echo "/* $configure_input */" \
+ && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs"
+ } >"$tmp/config.h" \
+ || as_fn_error "could not create $ac_file" "$LINENO" 5
+ if diff "$ac_file" "$tmp/config.h" >/dev/null 2>&1; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5
+$as_echo "$as_me: $ac_file is unchanged" >&6;}
else
- rm -f $ac_file
- mv "$tmp/config.h" $ac_file
+ rm -f "$ac_file"
+ mv "$tmp/config.h" "$ac_file" \
+ || as_fn_error "could not create $ac_file" "$LINENO" 5
fi
else
- echo "/* $configure_input */"
- cat "$ac_result"
+ $as_echo "/* $configure_input */" \
+ && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \
+ || as_fn_error "could not create -" "$LINENO" 5
fi
- rm -f "$tmp/out12"
;;
@@ -6664,12 +6340,14 @@
done # for ac_tag
-{ (exit 0); exit 0; }
+as_fn_exit 0
_ACEOF
-chmod +x $CONFIG_STATUS
ac_clean_files=$ac_clean_files_save
+test $ac_write_fail = 0 ||
+ as_fn_error "write failure creating $CONFIG_STATUS" "$LINENO" 5
+
# configure is writing to config.log, and then calls config.status.
# config.status does its own redirection, appending to config.log.
# Unfortunately, on DOS this fails, as config.log is still kept open
@@ -6688,8 +6366,12 @@
exec 5>>config.log
# Use ||, not &&, to avoid exiting from the if with $? = 1, which
# would make configure fail if this is the last instruction.
- $ac_cs_success || { (exit 1); exit 1; }
+ $ac_cs_success || as_fn_exit $?
fi
+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
+$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
+fi
Modified: seismo/3D/SPECFEM3D/trunk/configure.ac
===================================================================
--- seismo/3D/SPECFEM3D/trunk/configure.ac 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/configure.ac 2010-10-20 12:16:18 UTC (rev 17293)
@@ -11,7 +11,7 @@
AC_PREREQ(2.61)
AC_INIT([Specfem 3D], [1.4.0], [jtromp AT caltech.edu], [Specfem3D])
-AC_CONFIG_SRCDIR([specfem3D.f90])
+AC_CONFIG_SRCDIR([README])
AC_CONFIG_HEADER([config.h])
AC_CONFIG_MACRO_DIR([m4])
@@ -90,7 +90,7 @@
export SCOTCH_LIBS
AC_ARG_WITH([scotch-lib],
-AC_HELP_STRING([--with-scotch-lib],[tell where scotch library reside]),
+AC_HELP_STRING([--with-scotch-lib],[tell where Scotch library reside]),
[
ac_scotch_libdir="$withval";
])
@@ -103,9 +103,9 @@
#AC_CHECK_LIB(scotcherr,SCOTCH_errorPrint ,[scotch_lib="yes"],[scotch_lib="no";LDFLAGS=${ac_save_ldflags}])
AC_CHECK_LIB(scotch,scotchfarchinit ,[scotch_lib="yes";],[scotch_lib="no";LDFLAGS=${ac_save_ldflags}], -lscotcherr)
-AC_MSG_CHECKING([whether scotch is usable])
+AC_MSG_CHECKING([whether Scotch is usable])
if test "x${scotch_lib}" = "xyes"; then
- AC_DEFINE([HAVE_SCOTCH],[1],[defined if scotch is installed])
+ AC_DEFINE([HAVE_SCOTCH],[1],[defined if Scotch is installed])
SCOTCH_LIBS="-L${ac_scotch_libdir} -lscotch -lscotcherr"
AC_MSG_RESULT([yes])
else
@@ -204,7 +204,7 @@
# Checks for library functions.
-AC_CONFIG_FILES([Makefile constants.h precision.h DATA/Par_file DATA/CMTSOLUTION DATA/STATIONS meshfem3D/Makefile meshfem3D/precision.h meshfem3D/constants.h decompose_mesh_SCOTCH/Makefile])
+AC_CONFIG_FILES([Makefile in_data_files/Par_file in_data_files/CMTSOLUTION in_data_files/STATIONS src/meshfem3D/Makefile src/meshfem3D/constants.h src/meshfem3D/precision.h src/decompose_mesh_SCOTCH/Makefile src/specfem3D/Makefile src/generate_databases/Makefile src/shared/constants.h src/shared/precision.h])
AC_OUTPUT
Deleted: seismo/3D/SPECFEM3D/trunk/constants.h.in
===================================================================
--- seismo/3D/SPECFEM3D/trunk/constants.h.in 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/constants.h.in 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,333 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology July 2005
-!
-! 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.
-!
-!=====================================================================
-
-! @configure_input@
-
-!
-! solver in single or double precision depending on the machine (4 or 8 bytes)
-!
-! ALSO CHANGE FILE precision.h ACCORDINGLY
-!
- integer, parameter :: SIZE_REAL = 4
- integer, parameter :: SIZE_DOUBLE = 8
-
-! usually the size of integer and logical variables is the same as regular single-precision real variable
- integer, parameter :: SIZE_INTEGER = SIZE_REAL
- integer, parameter :: SIZE_LOGICAL = SIZE_REAL
-
-! set to SIZE_REAL to run in single precision
-! set to SIZE_DOUBLE to run in double precision (increases memory size by 2)
- integer, parameter :: CUSTOM_REAL = @CUSTOM_REAL@
-
-!----------- parameters that can be changed by the user -----------
-
-! set to .false. if running on a Beowulf-type machine with local disks
-! set to .true. if running on a shared-memory machine with common file system
-! if running on a Beowulf, also modify name of nodes in filter_machine_file.f90
- logical, parameter :: LOCAL_PATH_IS_ALSO_GLOBAL = . at LOCAL_PATH_IS_ALSO_GLOBAL@.
-
-! 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.
-
-! number of GLL points in each direction of an element (degree plus one)
- integer, parameter :: NGLLX = 5
- integer, parameter :: NGLLY = NGLLX
- integer, parameter :: NGLLZ = NGLLX
-
-! number of points per surface element
- integer, parameter :: NGLLSQUARE = NGLLX * NGLLY
-
-! for optimized routines by Deville et al. (2002)
- integer, parameter :: m1 = NGLLX, m2 = NGLLX * NGLLY
-
-! input, output and main MPI I/O files
- integer, parameter :: ISTANDARD_OUTPUT = 6
- integer, parameter :: IIN = 40,IOUT = 41
-! uncomment this to write messages to a text file
- integer, parameter :: IMAIN = 42
-! uncomment this to write messages to the screen
-! integer, parameter :: IMAIN = ISTANDARD_OUTPUT
-! I/O unit for source and receiver vtk file
- integer, parameter :: IOVTK = 98
-! I/O unit for absorbing boundary snapshots
- integer, parameter :: IOABS = 31
- integer, parameter :: IOABS_AC = 32
-! I/O unit for plotting source time function
- integer, Parameter :: IOSTF = 71
-
-! flag to print the details of source location
- logical, parameter :: SHOW_DETAILS_LOCATE_SOURCE = .false.
-
-! maximum length of station and network name for receivers
- integer, parameter :: MAX_LENGTH_STATION_NAME = 32
- integer, parameter :: MAX_LENGTH_NETWORK_NAME = 8
-
-! number of sources to be gathered by MPI_Gather
- integer, parameter :: NGATHER_SOURCES = 10000
-
-! we mimic a triangle of half duration equal to half_duration_triangle
-! using a Gaussian having a very close shape, as explained in Figure 4.2
-! of the manual. This source decay rate to mimic an equivalent triangle
-! was found by trial and error
- double precision, parameter :: SOURCE_DECAY_MIMIC_TRIANGLE = 1.628d0
-
-! decide if master process writes all the seismograms or if all processes do it in parallel
- logical, parameter :: WRITE_SEISMOGRAMS_BY_MASTER = .false.
-
-! use directory OUTPUT_FILES/ for seismogram output
- logical,parameter :: USE_OUTPUT_FILES_PATH = .true.
-
-! absorb top surface
-! (defined in mesh as 'free_surface_file')
- logical,parameter :: ABSORB_FREE_SURFACE = .false.
-
-! absorb boundaries using a PML region
-! (EXPERIMENTAL feature)
-! (only acoustic domains supported...)
-! (user parameters can be specified in PML_init.f90)
- logical,parameter :: ABSORB_USE_PML = .false.
-
-! ---------------------------------------------------------------------------------------
-! LQY -- Following 3 variables stays here temporarily,
-! we need to move them to Par_file at a proper time
-! ---------------------------------------------------------------------------------------
-! save moho mesh and compute Moho boundary kernels
- logical, parameter :: SAVE_MOHO_MESH = .false.
-
-! number of steps to save the state variables in the forward simulation,
-! to be used in the backward reconstruction in the presence of attenuation
- integer, parameter :: NSTEP_Q_SAVE = 50 ! depending on stability of reconstruction, up to 200
-
-! the scratch disk to save the state variables saved in the forward
-! simulation, this can be a global scratch disk in case you run out of
-! space on the local scratch disk
- character(len=256), parameter :: LOCAL_PATH_Q = 'DATABASES_MPI' ! or e.g. '/ibrixfs1/scratch/lqy/DATABASES_MPI_Q/'
-
-!------------------------------------------------------
-! nlegoff -- Variables that should be read/computed elsewhere.
-! Temporarily declared here.
-!------------------------------------------------------
-
-! no lagrange interpolation on seismograms (we take the value on one NGLL point)
- logical, parameter :: FASTER_RECEIVERS_POINTS_ONLY = .false.
-
-! use a force source located exactly at a grid point instead of a CMTSOLUTION source
-! this can be useful e.g. for oil industry foothills simulations or asteroid simulations
-! in which the source is a vertical force, normal force, impact etc.
- logical, parameter :: USE_FORCE_POINT_SOURCE = .false.
- double precision, parameter :: FACTOR_FORCE_SOURCE = 1.d15
- integer, parameter :: COMPONENT_FORCE_SOURCE = 3 ! takes direction in comp E/N/Z = 1/2/3
-
-! the receivers can be located inside the model
- logical, parameter :: RECVS_CAN_BE_BURIED_EXT_MESH = .true.
- logical, parameter :: SOURCES_CAN_BE_BURIED_EXT_MESH = .true.
-
-! the seismograms are normal to surface
-! Z record corresponds to the normal, while E and N are two tangent vectors
-! that completes an orthonormal.
- logical, parameter :: EXT_MESH_RECV_NORMAL = .false.
-
-! shakemaps and movies can not be generated during the same run. Mutually exclusive.
- logical, parameter :: EXTERNAL_MESH_MOVIE_SURFACE = .false.
- logical, parameter :: EXTERNAL_MESH_CREATE_SHAKEMAP = .false.
-
-! plots VTK cross-section planes instead of model surface
-! (EXPERIMENTAL feature)
-! (requires EXTERNAL_MESH_MOVIE_SURFACE set to true)
- logical, parameter :: PLOT_CROSS_SECTIONS = .false.
- real(kind=CUSTOM_REAL),parameter :: CROSS_SECTION_X = 67000.0
- real(kind=CUSTOM_REAL),parameter :: CROSS_SECTION_Y = 65500.0
- real(kind=CUSTOM_REAL),parameter :: CROSS_SECTION_Z = -30000.0
-
-! plots GIF cross-section image
-! (EXPERIMENTAL feature)
-! (cross-section plane parameters can be specified in write_PNM_GIF_data.f90)
- logical, parameter :: PNM_GIF_IMAGE = .false.
-
-! number of nodes per element as provided by the external mesh
- integer, parameter :: ESIZE = 8
-
-! geometry tolerance parameter to calculate number of independent grid points
-! sensitive to actual size of model, assumes reference sphere of radius 1
-! this is an absolute value for normalized coordinates in the Earth
- double precision, parameter :: SMALLVAL_TOL = 1.d-10
-
-!------------------------------------------------------
-!----------- do not modify anything below -------------
-!------------------------------------------------------
-
-! on some processors (e.g. Pentiums) it is necessary to suppress underflows
-! by using a small initial field instead of zero
- logical, parameter :: FIX_UNDERFLOW_PROBLEM = .true.
-
-! some useful constants
- double precision, parameter :: PI = 3.141592653589793d0
- double precision, parameter :: TWO_PI = 2.d0 * PI
-
-! 3-D simulation
- integer, parameter :: NDIM = 3
-
-! dimension of the boundaries of the slices
- integer, parameter :: NDIM2D = 2
-
-! number of nodes for 2D and 3D shape functions for hexahedra
-! we use 8-node mesh bricks, which are more stable than 27-node elements
- integer, parameter :: NGNOD = 8, NGNOD2D = 4
-
-! a few useful constants
- double precision, parameter :: ZERO = 0.d0,ONE = 1.d0,TWO = 2.d0,HALF = 0.5d0
-
- real(kind=CUSTOM_REAL), parameter :: &
- ONE_THIRD = 1._CUSTOM_REAL/3._CUSTOM_REAL, &
- FOUR_THIRDS = 4._CUSTOM_REAL/3._CUSTOM_REAL
-
-! very large and very small values
- double precision, parameter :: HUGEVAL = 1.d+30,TINYVAL = 1.d-9
-
-! very large real value declared independently of the machine
- real(kind=CUSTOM_REAL), parameter :: HUGEVAL_SNGL = 1.e+30_CUSTOM_REAL
- real(kind=CUSTOM_REAL), parameter :: TINYVAL_SNGL = 1.e-25_CUSTOM_REAL
-
-! very large integer value
- integer, parameter :: HUGEINT = 100000000
-
-! define flag for regions for attenuation
- integer, parameter :: NUM_REGIONS_ATTENUATION = 13
-
- integer, parameter :: IATTENUATION_SEDIMENTS_40 = 1
- integer, parameter :: IATTENUATION_SEDIMENTS_50 = 2
- integer, parameter :: IATTENUATION_SEDIMENTS_60 = 3
- integer, parameter :: IATTENUATION_SEDIMENTS_70 = 4
- integer, parameter :: IATTENUATION_SEDIMENTS_80 = 5
- integer, parameter :: IATTENUATION_SEDIMENTS_90 = 6
- integer, parameter :: IATTENUATION_SEDIMENTS_100 = 7
- integer, parameter :: IATTENUATION_SEDIMENTS_110 = 8
- integer, parameter :: IATTENUATION_SEDIMENTS_120 = 9
- integer, parameter :: IATTENUATION_SEDIMENTS_130 = 10
- integer, parameter :: IATTENUATION_SEDIMENTS_140 = 11
- integer, parameter :: IATTENUATION_SEDIMENTS_150 = 12
- integer, parameter :: IATTENUATION_BEDROCK = 13
-
-! Olsen's constant for Q_mu = constant * v_s attenuation rule
- real, parameter :: OLSEN_ATTENUATION_RATIO = 0.05
-
-! number of standard linear solids in parallel for attenuation
- integer, parameter :: N_SLS = 3
-
-! define flag for regions for anisotropy
- integer, parameter :: IANISOTROPY_MODEL1 = 1
- integer, parameter :: IANISOTROPY_MODEL2 = 2
-
-! smallest real number on the Pentium and the SGI = 1.1754944E-38
-! largest real number on the Pentium and the SGI = 3.4028235E+38
-! small negligible initial value to avoid very slow underflow trapping
-! but not too small to avoid trapping on velocity and acceleration in Newmark
- real(kind=CUSTOM_REAL), parameter :: VERYSMALLVAL = 1.E-24_CUSTOM_REAL
-
-! displacement threshold above which we consider the code became unstable
- real(kind=CUSTOM_REAL), parameter :: STABILITY_THRESHOLD = 1.E+25_CUSTOM_REAL
-
-! geometrical tolerance for boundary detection
- double precision, parameter :: SMALLVAL = 0.00001d0
-
-! do not use tags for MPI messages, use dummy tag instead
- integer, parameter :: itag = 0,itag2 = 0
-
-! for the Gauss-Lobatto-Legendre points and weights
- double precision, parameter :: GAUSSALPHA = 0.d0,GAUSSBETA = 0.d0
-
-! number of lines per source in CMTSOLUTION file
- integer, parameter :: NLINES_PER_CMTSOLUTION_SOURCE = 13
-
-! number of iterations to solve the system for xi and eta
- 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'
-
-! ! size of topography and bathymetry file for Piero Basini's model
-! integer, parameter :: NX_TOPO = 787, NY_TOPO = 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
-! double precision, parameter :: DEGREES_PER_CELL_TOPO = 250.d0
-! character(len=256), parameter :: TOPO_FILE = 'DATA/piero_model/dem_EV_UTM_regular_250_reordered.dat'
-
-! flag for projection from latitude/longitude to UTM, and back
- integer, parameter :: ILONGLAT2UTM = 0, IUTM2LONGLAT = 1
-
-! minimum thickness in meters to include the effect of the oceans
-! to avoid taking into account spurious oscillations in topography model
- double precision, parameter :: MINIMUM_THICKNESS_3D_OCEANS = 10.d0
-! density of sea water
- real(kind=CUSTOM_REAL), parameter :: RHO_OCEANS = 1020.0
-
-! material domain ids
- integer, parameter :: IDOMAIN_ACOUSTIC = 1
- integer, parameter :: IDOMAIN_ELASTIC = 2
- integer, parameter :: IDOMAIN_POROELASTIC = 3
-
-
-
-! unused parameters
-! -----------------
-! apply heuristic rule to modify doubling regions to balance angles -- not used anywhere
-! logical, parameter :: APPLY_HEURISTIC_RULE = .true.
-!
-!
-! deltat -- obsolete, DT set in Par_file
-! double precision, parameter :: DT_ext_mesh = 0.001d0
-!
-! NSTEP -- obsolete, set NSTEP in Par_file
-! integer, parameter :: NSTEP_ext_mesh = 100
-!
-! reference surface of the model before adding topography -- obsolete, old mesher
-! double precision, parameter :: Z_SURFACE = 0.d0
-!
-! flag for the four edges of each slice and for the bottom edge -- obsolete
-! integer, parameter :: XI_MIN = 1
-! integer, parameter :: XI_MAX = 2
-! integer, parameter :: ETA_MIN = 3
-! integer, parameter :: ETA_MAX = 4
-! integer, parameter :: BOTTOM = 5
-!
-! size of basement map file -- unused
-! integer, parameter :: NX_BASEMENT = 161,NY_BASEMENT = 144
-! double precision, parameter :: ORIG_X_BASEMENT = 316000.
-! double precision, parameter :: ORIG_Y_BASEMENT = 3655000.
-! double precision, parameter :: SPACING_X_BASEMENT = 1000.
-! double precision, parameter :: SPACING_Y_BASEMENT = 1000.
-!
-! SPECFEM3D_SESAME needs external mesh from now on...
-! whether or not an external mesh is used (provided by CUBIT for example)
-! logical, parameter :: USE_EXTERNAL_MESH = .true.
-
Deleted: seismo/3D/SPECFEM3D/trunk/constants_gocad.h
===================================================================
--- seismo/3D/SPECFEM3D/trunk/constants_gocad.h 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/constants_gocad.h 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,142 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology July 2005
-!
-! 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.
-!
-!=====================================================================
-
-! depth at which we start to honor the basement interface
- double precision, parameter :: Z_THRESHOLD_HONOR_BASEMENT = -4700.d0
-
-! min and max density in the model
- double precision, parameter :: DENSITY_MAX = 3000.d0
- double precision, parameter :: DENSITY_MIN = 2000.d0
-
-! extend model below threshold and above topography to make sure
-! there is no small gap between interpolated maps and sediments
- logical, parameter :: EXTEND_VOXET_BELOW_BASEMENT = .true.
- logical, parameter :: EXTEND_VOXET_ABOVE_TOPO = .true.
- double precision, parameter :: DISTMAX_ASSUME_SEDIMENTS = 210.d0
- integer, parameter :: NCELLS_EXTEND = 8
-
-! define flag for elements - socal model
- integer, parameter :: IFLAG_ONE_LAYER_TOPOGRAPHY = 1
- integer, parameter :: IFLAG_BASEMENT_TOPO = 2
- integer, parameter :: IFLAG_16km_BASEMENT = 3
- integer, parameter :: IFLAG_MOHO_16km = 4
- integer, parameter :: IFLAG_HALFSPACE_MOHO = 5
-
-!
-!--- larger Hauksson model for entire So-Cal, 15 km resolution
-!
-
-! number of non-constant layers
-integer, parameter :: NLAYERS_HAUKSSON = 9
-
-! depth of layers
-double precision, parameter :: Z_HAUKSSON_LAYER_1 = -1000.d0
-double precision, parameter :: Z_HAUKSSON_LAYER_2 = -4000.d0
-double precision, parameter :: Z_HAUKSSON_LAYER_3 = -6000.d0
-double precision, parameter :: Z_HAUKSSON_LAYER_4 = -10000.d0
-double precision, parameter :: Z_HAUKSSON_LAYER_5 = -15000.d0
-double precision, parameter :: Z_HAUKSSON_LAYER_6 = -17000.d0
-double precision, parameter :: Z_HAUKSSON_LAYER_7 = -22000.d0
-double precision, parameter :: Z_HAUKSSON_LAYER_8 = -31000.d0
-double precision, parameter :: Z_HAUKSSON_LAYER_9 = -33000.d0
-
-integer, parameter :: NGRID_NEW_HAUKSSON = 201
-
-! corners of new Hauksson's interpolated grid
-double precision, parameter :: UTM_X_ORIG_HAUKSSON = 122035.012d0
-double precision, parameter :: UTM_X_END_HAUKSSON = 766968.628d0
-double precision, parameter :: UTM_Y_ORIG_HAUKSSON = 3547232.986d0
-double precision, parameter :: UTM_Y_END_HAUKSSON = 4098868.501d0
-
-double precision, parameter :: SPACING_UTM_X_HAUKSSON = (UTM_X_END_HAUKSSON - UTM_X_ORIG_HAUKSSON) / (NGRID_NEW_HAUKSSON-1.d0)
-double precision, parameter :: SPACING_UTM_Y_HAUKSSON = (UTM_Y_END_HAUKSSON - UTM_Y_ORIG_HAUKSSON) / (NGRID_NEW_HAUKSSON-1.d0)
-
-!
-! new Gocad Voxets Peter July 29, 2002 - high-res and medium-res blocks
-!
-
-! size of the medium-resolution Gocad voxet
-integer, parameter :: NX_GOCAD_MR = 194, NY_GOCAD_MR = 196, NZ_GOCAD_MR = 100
-
-double precision, parameter :: ORIG_X_GOCAD_MR = 283000.
-double precision, parameter :: ORIG_Y_GOCAD_MR = 3655000.
-double precision, parameter :: ORIG_Z_GOCAD_MR = -15000.
-
-double precision, parameter :: SPACING_X_GOCAD_MR = 1000.
-double precision, parameter :: SPACING_Y_GOCAD_MR = 1000.
-double precision, parameter :: SPACING_Z_GOCAD_MR = 200.
-
-! maximum size of model for tapering of transition between Hauksson and MR
-double precision, parameter :: END_X_GOCAD_MR = ORIG_X_GOCAD_MR + SPACING_X_GOCAD_MR * (NX_GOCAD_MR - 1)
-double precision, parameter :: END_Y_GOCAD_MR = ORIG_Y_GOCAD_MR + SPACING_Y_GOCAD_MR * (NY_GOCAD_MR - 1)
-
-! size of the high-resolution Gocad voxet
-integer, parameter :: NX_GOCAD_HR = 185, NY_GOCAD_HR = 196, NZ_GOCAD_HR = 100
-
-double precision, parameter :: ORIG_X_GOCAD_HR = 371052.25
-double precision, parameter :: ORIG_Y_GOCAD_HR = 3725250.
-double precision, parameter :: ORIG_Z_GOCAD_HR = -9500.
-
-double precision, parameter :: SPACING_X_GOCAD_HR = 250.
-double precision, parameter :: SPACING_Y_GOCAD_HR = 250.
-double precision, parameter :: SPACING_Z_GOCAD_HR = 100.
-
-! maximum size of model for tapering of transition between HR and MR
-double precision, parameter :: END_X_GOCAD_HR = ORIG_X_GOCAD_HR + SPACING_X_GOCAD_HR * (NX_GOCAD_HR - 1)
-double precision, parameter :: END_Y_GOCAD_HR = ORIG_Y_GOCAD_HR + SPACING_Y_GOCAD_HR * (NY_GOCAD_HR - 1)
-
-! implement smooth transition between Hauksson, HR and MR Gocad blocks
-logical, parameter :: TAPER_GOCAD_TRANSITIONS = .true.
-
-! 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
-
-! unused parameters
-!--------------------------
-! size of Lupei Zhu's Moho map file for Southern California -- unused
-! integer, parameter :: NX_MOHO = 71,NY_MOHO = 51
-! double precision, parameter :: ORIG_LAT_MOHO = 32.d0
-! double precision, parameter :: ORIG_LONG_MOHO = -121.d0
-! double precision, parameter :: DEGREES_PER_CELL_MOHO = 0.1d0
-!
-! layers in the So-Cal regional model -- unused
-! DEPTH_MOHO_SOCAL = -35 km was based on Dreger and Helmberger (1990)
-! and is (July 2007) the preferred Moho depth for Dreger.
-! The depth of 32 km is used in the standard processing (Wald et al., 1995)
-! of SoCal events and is the value in the original Kanamori-Hadley (1975) model.
-! double precision, parameter :: DEPTH_5p5km_SOCAL = -5500.d0
-! double precision, parameter :: DEPTH_16km_SOCAL = -16000.d0
-! double precision, parameter :: DEPTH_MOHO_SOCAL = -32000.d0
-!
-! magic ratio for heuristic rule -- unused
-! this gives 120 degree angles in doubling
-! standard value 0.5 gives 135-135-90, which is not optimal
-! double precision, parameter :: MAGIC_RATIO = 0.6056d0
Deleted: seismo/3D/SPECFEM3D/trunk/convolve_source_timefunction.csh
===================================================================
--- seismo/3D/SPECFEM3D/trunk/convolve_source_timefunction.csh 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/convolve_source_timefunction.csh 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,25 +0,0 @@
-#!/bin/csh
-
-# we mimic a triangle of half duration equal to half_duration_triangle
-# using a Gaussian having a very close shape, as explained in Figure 4.2
-# of the manual
-
-set half_duration_triangle = 11.2
-
-foreach file ( $* )
-
-set nlines = `wc -l $file `
-echo $nlines > input_convolve_code.txt
-echo $half_duration_triangle >> input_convolve_code.txt
-# use .true. for a triangle and .false. for a Gaussian
-#echo ".true." >> input_convolve_code.txt
-echo ".false." >> input_convolve_code.txt
-
-echo convolving $file with half_duration_triangle = $half_duration_triangle using lines $nlines
-
-./xconvolve_source_timefunction < $file > ${file}.convolved
-
-rm input_convolve_code.txt
-
-end
-
Deleted: seismo/3D/SPECFEM3D/trunk/convolve_source_timefunction.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/convolve_source_timefunction.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/convolve_source_timefunction.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,133 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- program convolve_source_time_function
-
-!
-! convolve seismograms computed for a Heaviside with given source time function
-!
-
-! we mimic a triangle of half duration equal to half_duration_triangle
-! using a Gaussian having a very close shape, as explained in Figure 4.2
-! of the manual
-
- implicit none
-
- include "constants.h"
-
- integer :: i,j,N_j,number_remove,nlines
-
- double precision :: alpha,dt,tau_j,source,exponent,t1,t2,displ1,displ2,gamma,height,half_duration_triangle
-
- logical :: triangle
-
- double precision, dimension(:), allocatable :: time,sem,sem_fil
-
-! read file with number of lines in input
- open(unit=33,file='input_convolve_code.txt',status='old',action='read')
- read(33,*) nlines
- read(33,*) half_duration_triangle
- read(33,*) triangle
- close(33)
-
-! allocate arrays
- allocate(time(nlines),sem(nlines),sem_fil(nlines))
-
-! read the input seismogram
- do i = 1,nlines
- read(5,*) time(i),sem(i)
- enddo
-
-! define a Gaussian with the right exponent to mimic a triangle of equivalent half duration
- alpha = SOURCE_DECAY_MIMIC_TRIANGLE/half_duration_triangle
-
-! compute the time step
- dt = time(2) - time(1)
-
-! number of integers for which the source wavelet is different from zero
- if(triangle) then
- N_j = ceiling(half_duration_triangle/dt)
- else
- N_j = ceiling(1.5d0*half_duration_triangle/dt)
- endif
-
- do i = 1,nlines
-
- sem_fil(i) = 0.d0
-
- do j = -N_j,N_j
-
- if(i > j .and. i-j <= nlines) then
-
- tau_j = dble(j)*dt
-
-! convolve with a triangle
- if(triangle) then
- height = 1.d0 / half_duration_triangle
- if(abs(tau_j) > half_duration_triangle) then
- source = 0.d0
- else if (tau_j < 0.d0) then
- t1 = - N_j * dt
- displ1 = 0.d0
- t2 = 0.d0
- displ2 = height
- gamma = (tau_j - t1) / (t2 - t1)
- source= (1.d0 - gamma) * displ1 + gamma * displ2
- else
- t1 = 0.d0
- displ1 = height
- t2 = + N_j * dt
- displ2 = 0.d0
- gamma = (tau_j - t1) / (t2 - t1)
- source= (1.d0 - gamma) * displ1 + gamma * displ2
- endif
-
- else
-
-! convolve with a Gaussian
- exponent = alpha**2 * tau_j**2
- if(exponent < 50.d0) then
- source = alpha*exp(-exponent)/sqrt(PI)
- else
- source = 0.d0
- endif
-
- endif
-
- sem_fil(i) = sem_fil(i) + sem(i-j)*source*dt
-
- endif
-
- enddo
- enddo
-
-! compute number of samples to remove from end of seismograms
- number_remove = N_j + 1
- do i=1,nlines - number_remove
- write(*,*) sngl(time(i)),' ',sngl(sem_fil(i))
- enddo
-
- end program convolve_source_time_function
-
Deleted: seismo/3D/SPECFEM3D/trunk/create_header_file.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/create_header_file.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/create_header_file.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,91 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-! create file OUTPUT_FILES/values_from_mesher.h based upon DATA/Par_file
-! in order to compile the solver with the right array sizes
-
- subroutine create_header_file
-
- implicit none
-
- include "constants.h"
-
- integer NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,UTM_PROJECTION_ZONE,SIMULATION_TYPE
- integer NSOURCES,NTSTEP_BETWEEN_READ_ADJSRC
-
-! parameters to be computed based upon parameters above read from file
- integer NPROC
-
- integer NSPEC_AB, NGLOB_AB
- ! NPOIN2DMAX_XMIN_XMAX,NPOIN2DMAX_YMIN_YMAX,
-
- double precision DT,HDUR_MOVIE
-
- logical ATTENUATION,USE_OLSEN_ATTENUATION, &
- OCEANS,ABSORBING_CONDITIONS,SAVE_FORWARD
- logical ANISOTROPY,SAVE_AVS_DX_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION
-
- logical MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
- USE_HIGHRES_FOR_MOVIES,SUPPRESS_UTM_PROJECTION
- integer NTSTEP_BETWEEN_FRAMES,NTSTEP_BETWEEN_OUTPUT_INFO
-
- character(len=256) LOCAL_PATH,HEADER_FILE
-
-! ************** PROGRAM STARTS HERE **************
-
- call get_value_string(HEADER_FILE, 'solver.HEADER_FILE', 'OUTPUT_FILES/values_from_mesher.h')
- print *
- print *,'creating file ', trim(HEADER_FILE), ' to compile solver with correct values'
-
-! read the parameter file
- call read_parameter_file( NPROC,NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,DT, &
- UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION, &
- ATTENUATION,USE_OLSEN_ATTENUATION,LOCAL_PATH,NSOURCES, &
- OCEANS,ANISOTROPY,ABSORBING_CONDITIONS, &
- MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
- NTSTEP_BETWEEN_FRAMES,USE_HIGHRES_FOR_MOVIES,HDUR_MOVIE, &
- SAVE_AVS_DX_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION, &
- NTSTEP_BETWEEN_OUTPUT_INFO,SIMULATION_TYPE,SAVE_FORWARD, &
- NTSTEP_BETWEEN_READ_ADJSRC)
-
-! create include file for the solver
- call save_header_file(NSPEC_AB,NGLOB_AB,NPROC, &
- ATTENUATION,ANISOTROPY,NSTEP,DT, &
- SIMULATION_TYPE,0.d0,0)
- print *
- print *,'edit file OUTPUT_FILES/values_from_mesher.h to see some statistics about the mesh'
- print *
-!! DK DK May 2009: removed this because now each slice of a CUBIT + SCOTCH mesh
-!! DK DK May 2009: has a different number of spectral elements and therefore the
-!! DK DK May 2009: value below should be the max() for all the slices
-! print *,'on NEC SX, make sure "loopcnt=" parameter'
-! print *,'in Makefile is greater than max vector length = ',NGLOB_AB
-
- print *
- print *,'done'
- print *
-
- end subroutine create_header_file
-
Deleted: seismo/3D/SPECFEM3D/trunk/create_mass_matrices.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/create_mass_matrices.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/create_mass_matrices.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,265 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine create_mass_matrices(nglob,nspec,ibool)
-
-! returns precomputed mass matrix in rmass array
-
- use create_regions_mesh_ext_par
- implicit none
-
-! number of spectral elements in each block
- integer :: nspec
- integer :: nglob
-
-! arrays with the mesh global indices
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
-
-! local parameters
- double precision :: weight
- real(kind=CUSTOM_REAL) :: jacobianl
- integer :: ispec,i,j,k,iglob,ier
-
-! allocates memory
- allocate(rmass(nglob),stat=ier); if(ier /= 0) stop 'error in allocate'
- allocate(rmass_acoustic(nglob),stat=ier); if(ier /= 0) stop 'error in allocate'
- allocate(rmass_solid_poroelastic(nglob),stat=ier); if(ier /= 0) stop 'error in allocate'
- allocate(rmass_fluid_poroelastic(nglob),stat=ier); if(ier /= 0) stop 'error in allocate'
-
-! creates mass matrix
- rmass(:) = 0._CUSTOM_REAL
- rmass_acoustic(:) = 0._CUSTOM_REAL
- rmass_solid_poroelastic(:) = 0._CUSTOM_REAL
- rmass_fluid_poroelastic(:) = 0._CUSTOM_REAL
-
- do ispec=1,nspec
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
-
- weight = wxgll(i)*wygll(j)*wzgll(k)
- jacobianl = jacobianstore(i,j,k,ispec)
-
-! acoustic mass matrix
- if( ispec_is_acoustic(ispec) ) then
- ! distinguish between single and double precision for reals
- if(CUSTOM_REAL == SIZE_REAL) then
- rmass_acoustic(iglob) = rmass_acoustic(iglob) + &
- sngl( dble(jacobianl) * weight / dble(kappastore(i,j,k,ispec)) )
- else
- rmass_acoustic(iglob) = rmass_acoustic(iglob) + &
- jacobianl * weight / kappastore(i,j,k,ispec)
- endif
- endif
-
-! elastic mass matrix
- if( ispec_is_elastic(ispec) ) then
- if(CUSTOM_REAL == SIZE_REAL) then
- rmass(iglob) = rmass(iglob) + &
- sngl( dble(jacobianl) * weight * dble(rhostore(i,j,k,ispec)) )
- else
- rmass(iglob) = rmass(iglob) + &
- jacobianl * weight * rhostore(i,j,k,ispec)
- endif
- endif
-
-! poroelastic mass matrices
- if( ispec_is_poroelastic(ispec) ) then
-
- stop 'poroelastic mass matrices not implemented yet'
-
- !rho_solid = density(1,kmato(ispec))
- !rho_fluid = density(2,kmato(ispec))
- !phi = porosity(kmato(ispec))
- !tort = tortuosity(kmato(ispec))
- !rho_bar = (1._CUSTOM_REAL-phil)*rhol_s + phil*rhol_f
- !
- !if(CUSTOM_REAL == SIZE_REAL) then
- ! ! for the solid mass matrix
- ! rmass_solid_poroelastic(iglob) = rmass_solid_poroelastic(iglob) + &
- ! sngl( dble(jacobianl) * weight * dble(rho_bar - phi*rho_fluid/tort) )
- !
- ! ! for the fluid mass matrix
- ! rmass_fluid_poroelastic(iglob) = rmass_fluid_poroelastic(iglob) + &
- ! sngl( dble(jacobianl) * weight * dble(rho_bar*rho_fluid*tort - &
- ! phi*rho_fluid*rho_fluid)/dble(rho_bar*phi) )
- !else
- ! rmass_solid_poroelastic(iglob) = rmass_solid_poroelastic(iglob) + &
- ! jacobianl * weight * (rho_bar - phi*rho_fluid/tort)
- !
- ! rmass_fluid_poroelastic(iglob) = rmass_fluid_poroelastic(iglob) + &
- ! jacobianl * weight * (rho_bar*rho_fluid*tort - &
- ! phi*rho_fluid*rho_fluid) / (rho_bar*phi)
- !endif
- endif
-
- enddo
- enddo
- enddo
- enddo ! nspec
-
- end subroutine create_mass_matrices
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine create_mass_matrices_ocean_load(nglob,nspec,ibool,OCEANS,&
- UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION,NX_TOPO,NY_TOPO, &
- ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO, &
- itopo_bathy)
-
-! returns precomputed mass matrix in rmass array
-
- use create_regions_mesh_ext_par
- implicit none
-
-! number of spectral elements in each block
- integer :: nspec
- integer :: nglob
-
-! arrays with the mesh global indices
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
- logical :: OCEANS
-
-! 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 :: 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
-
-! creates ocean load mass matrix
- if(OCEANS) then
-
- ! adding ocean load mass matrix at ocean bottom
- NGLOB_OCEAN = nglob
- allocate(rmass_ocean_load(NGLOB_OCEAN))
-
- ! create ocean load mass matrix for degrees of freedom at ocean bottom
- rmass_ocean_load(:) = 0._CUSTOM_REAL
-
- ! add contribution of the oceans for surface elements exactly at ocean bottom
- do ispec2D = 1,num_free_surface_faces
-
- ispec_oceans = free_surface_ispec(ispec2D)
-
- ! only adds contribution if top boundary is elastic, no need to add this approximate calculation
- ! if top is already acoustic/poroelastic
- if( ispec_is_elastic(ispec_oceans) ) then
-
- do igll=1,NGLLSQUARE
- ix_oceans = free_surface_ijk(1,igll,ispec2D)
- iy_oceans = free_surface_ijk(1,igll,ispec2D)
- iz_oceans = free_surface_ijk(1,igll,ispec2D)
-
- iglobnum=ibool(ix_oceans,iy_oceans,iz_oceans,ispec_oceans)
-
- ! compute local height of oceans
-
- ! 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
-
- ! suppress positive elevation, which means no oceans
- if(elevation >= - MINIMUM_THICKNESS_3D_OCEANS) then
- height_oceans = 0.d0
- else
- height_oceans = dabs(elevation)
- endif
-
- ! take into account inertia of water column
- weight = dble( free_surface_jacobian2Dw(igll,ispec2D)) &
- * dble(RHO_OCEANS) * height_oceans
-
- ! distinguish between single and double precision for reals
- if(CUSTOM_REAL == SIZE_REAL) then
- rmass_ocean_load(iglobnum) = rmass_ocean_load(iglobnum) + sngl(weight)
- else
- rmass_ocean_load(iglobnum) = rmass_ocean_load(iglobnum) + weight
- endif
-
- enddo ! igll
- endif ! ispec_is_elastic
- enddo ! num_free_surface_faces
-
- ! add regular mass matrix to ocean load contribution
- rmass_ocean_load(:) = rmass_ocean_load(:) + rmass(:)
-
- else
-
- ! allocate dummy array if no oceans
- NGLOB_OCEAN = 1
- allocate(rmass_ocean_load(NGLOB_OCEAN))
-
- endif
-
- end subroutine create_mass_matrices_ocean_load
-
-
Deleted: seismo/3D/SPECFEM3D/trunk/create_movie_shakemap_AVS_DX_GMT.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/create_movie_shakemap_AVS_DX_GMT.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/create_movie_shakemap_AVS_DX_GMT.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,1040 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-!
-!--- create a movie of the vertical component of surface displacement or velocity
-!--- or a ShakeMap(R) (i.e. map of the maximum absolute value of the two horizontal components
-!--- of the velocity vector) in AVS, OpenDX or GMT format
-!
-
- program create_movie_shakemap
-
- implicit none
-
- include "constants.h"
- include "OUTPUT_FILES/surface_from_mesher.h"
-
-!-------------------------------------------------------------------------------------------------
-! user parameters
-! threshold in percent of the maximum below which we cut the amplitude
- logical, parameter :: APPLY_THRESHOLD = .false.
- real(kind=CUSTOM_REAL), parameter :: THRESHOLD = 1._CUSTOM_REAL / 100._CUSTOM_REAL
-
-! coefficient of power law used for non linear scaling
- logical, parameter :: NONLINEAR_SCALING = .false.
- real(kind=CUSTOM_REAL), parameter :: POWER_SCALING = 0.13_CUSTOM_REAL
-
-!-------------------------------------------------------------------------------------------------
-
- ! number of points in each AVS or OpenDX quadrangular cell for movies
- integer, parameter :: NGNOD2D_AVS_DX = 4
-
- integer it,it1,it2,ivalue,nspectot_AVS_max,ispec
- integer iformat,nframes,iframe,inumber,inorm,iscaling_shake
- integer ibool_number,ibool_number1,ibool_number2,ibool_number3,ibool_number4
-
- logical USE_OPENDX,USE_AVS,USE_GMT,plot_shaking_map
-
- real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: x,y,z,display
- real(kind=CUSTOM_REAL) xcoord,ycoord,zcoord
- real(kind=CUSTOM_REAL) vectorx,vectory,vectorz
-
- double precision min_field_current,max_field_current,max_absol
-
- character(len=256) outputname
-
- integer ipoin
-
- ! GMT
- double precision lat,long
-
- ! for sorting routine
- integer npointot,ilocnum,nglob,i,j,ielm,ieoff,ispecloc
- integer, dimension(:), allocatable :: iglob,loc,ireorder
- logical, dimension(:), allocatable :: ifseg,mask_point
- double precision, dimension(:), allocatable :: xp,yp,zp,xp_save,yp_save,zp_save,field_display
-
- ! movie files stored by solver
- real(kind=CUSTOM_REAL), dimension(:), allocatable :: &
- store_val_x,store_val_y,store_val_z, &
- store_val_ux,store_val_uy,store_val_uz
-
- ! parameters read from parameter file
- integer NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,UTM_PROJECTION_ZONE,SIMULATION_TYPE
- integer NSOURCES,NTSTEP_BETWEEN_READ_ADJSRC
- logical MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
- USE_HIGHRES_FOR_MOVIES,SUPPRESS_UTM_PROJECTION
- integer NTSTEP_BETWEEN_FRAMES,NTSTEP_BETWEEN_OUTPUT_INFO
- double precision DT
- double precision HDUR_MOVIE
- logical ATTENUATION,USE_OLSEN_ATTENUATION, &
- OCEANS
- logical ABSORBING_CONDITIONS,SAVE_FORWARD
- logical ANISOTROPY,SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION
- character(len=256) OUTPUT_FILES,LOCAL_PATH
- integer NPROC
- integer ier
-
-
-!--------------------------------------------
-!!!! NL NL for external meshes
-!--------------------------------------------
- ! muting source region
- real(kind=CUSTOM_REAL), parameter :: RADIUS_TO_MUTE = 1000._CUSTOM_REAL
- logical, parameter :: MUTE_SOURCE = .true.
- real(kind=CUSTOM_REAL), parameter :: X_SOURCE_EXT_MESH = -9023.021484375
- real(kind=CUSTOM_REAL), parameter :: Y_SOURCE_EXT_MESH = 6123.611328125
- real(kind=CUSTOM_REAL), parameter :: Z_SOURCE_EXT_MESH = 17.96331405639648
-!--------------------------------------------
-!!!! NL NL
-
- ! order of points representing the 2D square element
- integer,dimension(NGNOD2D_AVS_DX),parameter :: iorder = (/1,3,2,4/)
-
-
-! ************** PROGRAM STARTS HERE **************
-
- print *
- print *,'Recombining all movie frames to create a movie'
- print *
-
- print *
- print *,'reading parameter file'
- print *
-
- ! read the parameter file
- call read_parameter_file(NPROC,NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,DT, &
- UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION, &
- ATTENUATION,USE_OLSEN_ATTENUATION,LOCAL_PATH,NSOURCES, &
- OCEANS,ANISOTROPY,ABSORBING_CONDITIONS, &
- MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
- 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)
-
- ! get the base pathname for output files
- call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
-
- ! only one global array for movie data, but stored for all surfaces defined
- ! in file 'surface_from_mesher.h'
- if(USE_HIGHRES_FOR_MOVIES) then
- ilocnum = NSPEC_SURFACE_EXT_MESH*NGLLSQUARE
- else
- ilocnum = NSPEC_SURFACE_EXT_MESH*NGNOD2D_AVS_DX
- endif
- print*,' moviedata element surfaces: ',NSPEC_SURFACE_EXT_MESH
- print*,' moviedata total elements all: ',ilocnum
- print *
-
- if(SAVE_DISPLACEMENT) then
- print *,'Vertical displacement will be shown in movie'
- else
- print *,'Vertical velocity will be shown in movie'
- endif
- print *
-
-
- ! user input
- print *,'1 = create files in OpenDX format'
- print *,'2 = create files in AVS UCD format'
- print *,'3 = create files in GMT xyz Ascii long/lat/Uz format'
- print *,'any other value = exit'
- print *
- print *,'enter value:'
- read(5,*) iformat
- if(iformat < 1 .or. iformat > 3) stop 'exiting...'
-
- plot_shaking_map = .false.
- print *,'movie frames have been saved every ',NTSTEP_BETWEEN_FRAMES,' time steps'
- print *
- print *,'enter first time step of movie (e.g. 1, enter -1 for shaking map)'
- read(5,*) it1
- if(it1 == 0 ) it1 = 1
- if(it1 == -1) plot_shaking_map = .true.
- if(.not. plot_shaking_map) then
- print *,'enter last time step of movie (e.g. ',NSTEP,')'
- read(5,*) it2
- print *
- print *,'1 = define file names using frame number'
- print *,'2 = define file names using time step number'
- print *,'any other value = exit'
- print *
- print *,'enter value:'
- read(5,*) inumber
- if(inumber<1 .or. inumber>2) stop 'exiting...'
- print *
- print *,'looping from ',it1,' to ',it2,' every ',NTSTEP_BETWEEN_FRAMES,' time steps'
- ! count number of movie frames
- nframes = 0
- do it = it1,it2
- if(mod(it,NTSTEP_BETWEEN_FRAMES) == 0) nframes = nframes + 1
- enddo
- else
- ! only one frame if shaking map
- nframes = 1
- it1 = 1
- it2 = 1
- endif
- print *
- print *,'total number of frames will be ',nframes
- if(nframes == 0) stop 'null number of frames'
-
- iscaling_shake = 0
- if(plot_shaking_map) then
- print *
- print *,'norm to display in shaking map:'
- print *,'1=displacement 2=velocity 3=acceleration'
- print *
- read(5,*) inorm
- if(inorm < 1 .or. inorm > 3) stop 'incorrect value of inorm'
- print *
- print *,'apply non-linear scaling to shaking map:'
- print *,'1=non-linear 2=no scaling'
- print *
- read(5,*) iscaling_shake
- if(iscaling_shake < 1 .or. iscaling_shake > 2) stop 'incorrect value of iscaling_shake'
- else
- print *
- print *,'movie data:'
- print *,'1= norm of velocity 2=velocity x-comp 3=velocity y-comp 4=velocity z-comp'
- print *
- read(5,*) inorm
- if(inorm < 1 .or. inorm > 4) stop 'incorrect value of inorm'
- endif
-
-! file format flags
- if(iformat == 1) then
- USE_OPENDX = .true.
- USE_AVS = .false.
- USE_GMT = .false.
- else if(iformat == 2) then
- USE_OPENDX = .false.
- USE_AVS = .true.
- USE_GMT = .false.
- else
- USE_OPENDX = .false.
- USE_AVS = .false.
- USE_GMT = .true.
- endif
-
- ! define the total number of elements at the surface
- if(USE_HIGHRES_FOR_MOVIES) then
- nspectot_AVS_max = NSPEC_SURFACE_EXT_MESH * (NGLLX-1) * (NGLLY-1)
- else
- nspectot_AVS_max = NSPEC_SURFACE_EXT_MESH
- endif
-
- ! maximum theoretical number of points at the surface
- npointot = NGNOD2D_AVS_DX * nspectot_AVS_max
-
- ! allocate arrays for sorting routine
- allocate(iglob(npointot),loc(npointot))
- allocate(ifseg(npointot))
- allocate(xp(npointot),yp(npointot),zp(npointot))
- allocate(xp_save(npointot),yp_save(npointot),zp_save(npointot))
- allocate(field_display(npointot))
- allocate(mask_point(npointot))
- allocate(ireorder(npointot))
-
- ! allocates data arrays
- allocate(store_val_x(ilocnum))
- allocate(store_val_y(ilocnum))
- allocate(store_val_z(ilocnum))
- allocate(store_val_ux(ilocnum))
- allocate(store_val_uy(ilocnum))
- allocate(store_val_uz(ilocnum))
-
- if(USE_HIGHRES_FOR_MOVIES) then
- allocate(x(NGLLX,NGLLY))
- allocate(y(NGLLX,NGLLY))
- allocate(z(NGLLX,NGLLY))
- allocate(display(NGLLX,NGLLY))
- endif
-
- ! user output
- print *
- print *,'there are a total of ',nspectot_AVS_max,' elements at the surface'
- print *
- print *
- if(APPLY_THRESHOLD .and. .not. plot_shaking_map) &
- print *,'Will apply a threshold to amplitude below ',100.*THRESHOLD,' %'
- if(NONLINEAR_SCALING .and. (.not. plot_shaking_map .or. iscaling_shake == 1)) &
- print *,'Will apply a non linear scaling with coef ',POWER_SCALING
-
-
- iframe = 0
-
-! loop on all the time steps in the range entered
- do it = it1,it2
-
- ! check if time step corresponds to a movie frame
- if(mod(it,NTSTEP_BETWEEN_FRAMES) == 0 .or. plot_shaking_map) then
-
- iframe = iframe + 1
-
- print *
- if(plot_shaking_map) then
- print *,'reading shaking map snapshot'
- else
- print *,'reading snapshot time step ',it,' out of ',NSTEP
- endif
- print *
-
- ! read all the elements from the same file
- if(plot_shaking_map) then
- write(outputname,"('/shakingdata')")
- else
- write(outputname,"('/moviedata',i6.6)") it
- endif
- open(unit=IOUT,file=trim(OUTPUT_FILES)//trim(outputname),status='old', &
- action='read',form='unformatted',iostat=ier)
- if( ier /= 0 ) then
- print*,'error: ',trim(OUTPUT_FILES)//trim(outputname)
- stop 'error opening moviedata file'
- endif
-
- read(IOUT) store_val_x
- read(IOUT) store_val_y
- read(IOUT) store_val_z
- read(IOUT) store_val_ux
- read(IOUT) store_val_uy
- read(IOUT) store_val_uz
- close(IOUT)
-
- ! clear number of elements kept
- ispec = 0
-
- ! reset point number
- ipoin = 0
-
- do ispecloc = 1, NSPEC_SURFACE_EXT_MESH
-
- if(USE_HIGHRES_FOR_MOVIES) then
- ! assign the OpenDX "elements"
- do j = 1,NGLLY
- do i = 1,NGLLX
- ipoin = ipoin + 1
-
- ! x,y,z coordinates
- xcoord = store_val_x(ipoin)
- ycoord = store_val_y(ipoin)
- zcoord = store_val_z(ipoin)
-
- ! note:
- ! for shakemaps: ux = norm displacement, uy = norm velocity, uz = norm acceleration
- ! for movies: ux = velocity x-component, uy = velocity y-component, uz = velocity z-component
- vectorx = store_val_ux(ipoin)
- vectory = store_val_uy(ipoin)
- vectorz = store_val_uz(ipoin)
-
- x(i,j) = xcoord
- y(i,j) = ycoord
- z(i,j) = zcoord
-
- ! shakemap
- if(plot_shaking_map) then
- !!!! NL NL mute value near source
- if ( (sqrt(((x(i,j) - (X_SOURCE_EXT_MESH))**2 + &
- (y(i,j) - (Y_SOURCE_EXT_MESH))**2 + &
- (z(i,j) - (Z_SOURCE_EXT_MESH))**2)) < RADIUS_TO_MUTE) &
- .and. MUTE_SOURCE) then
-
- display(i,j) = 0.
- else
- ! chooses norm
- if(inorm == 1) then
- ! norm displacement
- display(i,j) = vectorx
- else if(inorm == 2) then
- ! norm velocity
- display(i,j) = vectory
- else
- ! norm acceleration
- display(i,j) = vectorz
- endif
- endif
- else
- ! movie
- if(inorm == 1) then
- ! norm of velocity
- display(i,j) = sqrt(vectorz**2+vectory**2+vectorx**2)
- else if( inorm == 2 ) then
- ! velocity x-component
- display(i,j) = vectorx
- else if( inorm == 3 ) then
- ! velocity y-component
- display(i,j) = vectory
- else if( inorm == 4 ) then
- ! velocity z-component
- display(i,j) = vectorz
- endif
- endif
-
- enddo
- enddo
-
- ! assign the values of the corners of the OpenDX "elements"
- ispec = ispec + 1
- ielm = (NGLLX-1)*(NGLLY-1)*(ispec-1)
-
- do j = 1,NGLLY-1
- do i = 1,NGLLX-1
- ieoff = NGNOD2D_AVS_DX*(ielm+(i-1)+(j-1)*(NGLLX-1))
- do ilocnum = 1,NGNOD2D_AVS_DX
- ! do k = 1,NGNOD2D_AVS_DX
-
-
- if(ilocnum == 1) then
- xp(ieoff+ilocnum) = dble(x(i,j))
- yp(ieoff+ilocnum) = dble(y(i,j))
- zp(ieoff+ilocnum) = dble(z(i,j))
- field_display(ieoff+ilocnum) = dble(display(i,j))
- elseif(ilocnum == 2) then
-
- ! accounts for different ordering of square points
- xp(ieoff+ilocnum) = dble(x(i+1,j+1))
- yp(ieoff+ilocnum) = dble(y(i+1,j+1))
- zp(ieoff+ilocnum) = dble(z(i+1,j+1))
- field_display(ieoff+ilocnum) = dble(display(i+1,j+1))
-
- ! xp(ieoff+ilocnum) = dble(x(i+1,j))
- ! yp(ieoff+ilocnum) = dble(y(i+1,j))
- ! zp(ieoff+ilocnum) = dble(z(i+1,j))
- ! field_display(ieoff+ilocnum) = dble(display(i+1,j))
-
- elseif(ilocnum == 3) then
-
- ! accounts for different ordering of square points
- xp(ieoff+ilocnum) = dble(x(i+1,j))
- yp(ieoff+ilocnum) = dble(y(i+1,j))
- zp(ieoff+ilocnum) = dble(z(i+1,j))
- field_display(ieoff+ilocnum) = dble(display(i+1,j))
-
- ! xp(ieoff+ilocnum) = dble(x(i+1,j+1))
- ! yp(ieoff+ilocnum) = dble(y(i+1,j+1))
- ! zp(ieoff+ilocnum) = dble(z(i+1,j+1))
- ! field_display(ieoff+ilocnum) = dble(display(i+1,j+1))
- else
- xp(ieoff+ilocnum) = dble(x(i,j+1))
- yp(ieoff+ilocnum) = dble(y(i,j+1))
- zp(ieoff+ilocnum) = dble(z(i,j+1))
- field_display(ieoff+ilocnum) = dble(display(i,j+1))
- endif
-
- enddo
-
- !if( j==1 .and. ispec==1) then
- !print*,'p1',xp(ieoff+1),yp(ieoff+1),zp(ieoff+1)
- !print*,'p2',xp(ieoff+2),yp(ieoff+2),zp(ieoff+2)
- !print*,'p3',xp(ieoff+3),yp(ieoff+3),zp(ieoff+3)
- !print*,'p4',xp(ieoff+4),yp(ieoff+4),zp(ieoff+4)
- !endif
-
- enddo
- enddo
-
- else
- ! low-resolution (only spectral element corners)
- ispec = ispec + 1
- ieoff = NGNOD2D_AVS_DX*(ispec-1)
-
- ! four points for each element
- do i = 1,NGNOD2D_AVS_DX
-
- ! accounts for different ordering of square points
- ilocnum = iorder(i)
-
- ipoin = ipoin + 1
-
- xcoord = store_val_x(ipoin)
- ycoord = store_val_y(ipoin)
- zcoord = store_val_z(ipoin)
-
- vectorx = store_val_ux(ipoin)
- vectory = store_val_uy(ipoin)
- vectorz = store_val_uz(ipoin)
-
-
- xp(ilocnum+ieoff) = dble(xcoord)
- yp(ilocnum+ieoff) = dble(ycoord)
- zp(ilocnum+ieoff) = dble(zcoord)
-
- ! shakemap
- if(plot_shaking_map) then
- !!!! NL NL mute value near source
- if ( (sqrt(((dble(xcoord) - (X_SOURCE_EXT_MESH))**2 + &
- (dble(ycoord) - (Y_SOURCE_EXT_MESH))**2 + &
- (dble(zcoord) - (Z_SOURCE_EXT_MESH))**2)) < RADIUS_TO_MUTE) &
- .and. MUTE_SOURCE) then
- field_display(ilocnum+ieoff) = 0.
- else
- if(inorm == 1) then
- ! norm of displacement
- field_display(ilocnum+ieoff) = dble(vectorx)
- else if(inorm == 2) then
- ! norm of velocity
- field_display(ilocnum+ieoff) = dble(vectory)
- else
- ! norm of acceleration
- field_display(ilocnum+ieoff) = dble(vectorz)
- endif
- endif
- else
- ! movie
- if(inorm == 1) then
- ! norm of velocity
- field_display(ilocnum+ieoff) = sqrt(vectorz**2+vectory**2+vectorx**2)
- else if( inorm == 2 ) then
- ! velocity x-component
- field_display(ilocnum+ieoff) = vectorx
- else if( inorm == 3 ) then
- ! velocity y-component
- field_display(ilocnum+ieoff) = vectory
- else
- ! velocity z-component
- field_display(ilocnum+ieoff) = vectorz
- endif
- ! takes norm of velocity vector
- !field_display(ilocnum+ieoff) =sqrt(vectorz**2+vectory**2+vectorx**2)
- endif
-
- enddo
- endif ! USE_HIGHRES_FOR_MOVIES
- enddo ! NSPEC_SURFACE_EXT_MESH
-
- ! copy coordinate arrays since the sorting routine does not preserve them
- xp_save(:) = xp(:)
- yp_save(:) = yp(:)
- zp_save(:) = zp(:)
-
- ! sort the list based upon coordinates to get rid of multiples
- print *,'sorting list of points'
- call get_global_AVS(nspectot_AVS_max,xp,yp,zp,iglob,loc,ifseg,nglob,npointot, &
- dble(minval(store_val_x(:))),dble(maxval(store_val_x(:))))
-
- ! print total number of points found
- print *
- print *,'found a total of ',nglob,' points'
- print *,'initial number of points (with multiples) was ',npointot
-
-
- ! normalize and scale vector field
-
- ! compute min and max of data value to normalize
- min_field_current = minval(field_display(:))
- max_field_current = maxval(field_display(:))
-
- ! print minimum and maximum amplitude in current snapshot
- print *
- print *,'minimum amplitude in current snapshot = ',min_field_current
- print *,'maximum amplitude in current snapshot = ',max_field_current
- print *
-
- if(plot_shaking_map) then
- ! compute min and max of data value to normalize
- min_field_current = minval(field_display(:))
- max_field_current = maxval(field_display(:))
- ! print minimum and maximum amplitude in current snapshot
- print *
- print *,'minimum amplitude in current snapshot after removal = ',min_field_current
- print *,'maximum amplitude in current snapshot after removal = ',max_field_current
- print *
- endif
-
- ! apply scaling in all cases for movies
- if(.not. plot_shaking_map) then
-
- ! make sure range is always symmetric and center is in zero
- ! this assumption works only for fields that can be negative
- ! would not work for norm of vector for instance
- ! (we would lose half of the color palette if no negative values)
- max_absol = max(abs(min_field_current),abs(max_field_current))
- min_field_current = - max_absol
- max_field_current = + max_absol
-
- ! normalize field to [0:1]
- if( abs(max_field_current - min_field_current) > TINYVAL ) &
- field_display(:) = (field_display(:) - min_field_current) / (max_field_current - min_field_current)
-
- ! rescale to [-1,1]
- field_display(:) = 2.*field_display(:) - 1.
-
- ! apply threshold to normalized field
- if(APPLY_THRESHOLD) &
- where(abs(field_display(:)) <= THRESHOLD) field_display = 0.
-
- ! apply non linear scaling to normalized field if needed
- if(NONLINEAR_SCALING) then
- where(field_display(:) >= 0.)
- field_display = field_display ** POWER_SCALING
- elsewhere
- field_display = - abs(field_display) ** POWER_SCALING
- endwhere
- endif
-
- ! map back to [0,1]
- field_display(:) = (field_display(:) + 1.) / 2.
-
- ! map field to [0:255] for AVS color scale
- field_display(:) = 255. * field_display(:)
-
-
- ! apply scaling only if selected for shaking map
- else if(NONLINEAR_SCALING .and. iscaling_shake == 1) then
-
- ! normalize field to [0:1]
- if( abs(max_field_current) > TINYVAL ) &
- field_display(:) = field_display(:) / max_field_current
-
- ! apply non linear scaling to normalized field
- field_display = field_display ** POWER_SCALING
-
- ! map field to [0:255] for AVS color scale
- field_display(:) = 255. * field_display(:)
-
- endif
-
- !--- ****** create AVS file using sorted list ******
-
- if(.not. plot_shaking_map) then
- if(inumber == 1) then
- ivalue = iframe
- else
- ivalue = it
- endif
- endif
-
- ! create file name and open file
- if(plot_shaking_map) then
-
- if(USE_OPENDX) then
- write(outputname,"('/DX_shaking_map.dx')")
- open(unit=11,file=trim(OUTPUT_FILES)//outputname,status='unknown')
- write(11,*) 'object 1 class array type float rank 1 shape 3 items ',nglob,' data follows'
- else if(USE_AVS) then
- write(outputname,"('/AVS_shaking_map.inp')")
- open(unit=11,file=trim(OUTPUT_FILES)//outputname,status='unknown')
- write(11,*) nglob,' ',nspectot_AVS_max,' 1 0 0'
- else if(USE_GMT) then
- write(outputname,"('/gmt_shaking_map.xyz')")
- open(unit=11,file=trim(OUTPUT_FILES)//outputname,status='unknown')
- else
- stop 'wrong output format selected'
- endif
-
- else
-
- if(USE_OPENDX) then
- write(outputname,"('/DX_movie_',i6.6,'.dx')") ivalue
- open(unit=11,file=trim(OUTPUT_FILES)//outputname,status='unknown')
- write(11,*) 'object 1 class array type float rank 1 shape 3 items ',nglob,' data follows'
- else if(USE_AVS) then
- write(outputname,"('/AVS_movie_',i6.6,'.inp')") ivalue
- open(unit=11,file=trim(OUTPUT_FILES)//outputname,status='unknown')
- write(11,*) nglob,' ',nspectot_AVS_max,' 1 0 0'
- else if(USE_GMT) then
- write(outputname,"('/gmt_movie_',i6.6,'.xyz')") ivalue
- open(unit=11,file=trim(OUTPUT_FILES)//outputname,status='unknown')
- else
- stop 'wrong output format selected'
- endif
-
- endif
-
-
- if(USE_GMT) then
-
-! output list of points
- mask_point = .false.
- do ispec=1,nspectot_AVS_max
- ieoff = NGNOD2D_AVS_DX*(ispec-1)
-! four points for each element
- do ilocnum = 1,NGNOD2D_AVS_DX
- ibool_number = iglob(ilocnum+ieoff)
- if(.not. mask_point(ibool_number)) then
- call utm_geo(long,lat,xp_save(ilocnum+ieoff),yp_save(ilocnum+ieoff), &
- UTM_PROJECTION_ZONE,IUTM2LONGLAT,SUPPRESS_UTM_PROJECTION)
- write(11,*) long,lat,field_display(ilocnum+ieoff)
- endif
- mask_point(ibool_number) = .true.
- enddo
- enddo
-
- else
-
- ! output list of points
- mask_point = .false.
- ipoin = 0
- do ispec=1,nspectot_AVS_max
- ieoff = NGNOD2D_AVS_DX*(ispec-1)
- ! four points for each element
- do ilocnum = 1,NGNOD2D_AVS_DX
- ibool_number = iglob(ilocnum+ieoff)
- if(.not. mask_point(ibool_number)) then
- ipoin = ipoin + 1
- ireorder(ibool_number) = ipoin
- if(USE_OPENDX) then
- write(11,*) xp_save(ilocnum+ieoff),yp_save(ilocnum+ieoff),zp_save(ilocnum+ieoff)
- else if(USE_AVS) then
- write(11,'(i9,3f16.6)') ireorder(ibool_number),xp_save(ilocnum+ieoff), &
- yp_save(ilocnum+ieoff),zp_save(ilocnum+ieoff)
- endif
- endif
- mask_point(ibool_number) = .true.
- enddo
- enddo
-
- if(USE_OPENDX) &
- write(11,*) 'object 2 class array type int rank 1 shape 4 items ',nspectot_AVS_max,' data follows'
-
- ! output list of elements
- do ispec=1,nspectot_AVS_max
- ieoff = NGNOD2D_AVS_DX*(ispec-1)
- ! four points for each element
- ibool_number1 = iglob(ieoff + 1)
- ibool_number2 = iglob(ieoff + 2)
- ibool_number3 = iglob(ieoff + 3)
- ibool_number4 = iglob(ieoff + 4)
- if(USE_OPENDX) then
- ! point order in OpenDX is 1,4,2,3 *not* 1,2,3,4 as in AVS
- write(11,"(i10,1x,i10,1x,i10,1x,i10)") ireorder(ibool_number1)-1, &
- ireorder(ibool_number4)-1,ireorder(ibool_number2)-1,ireorder(ibool_number3)-1
- else
- write(11,"(i10,' 1 quad ',i10,1x,i10,1x,i10,1x,i10)") ispec,ireorder(ibool_number1), &
- ireorder(ibool_number4),ireorder(ibool_number2),ireorder(ibool_number3)
- endif
- enddo
-
- if(USE_OPENDX) then
- write(11,*) 'attribute "element type" string "quads"'
- write(11,*) 'attribute "ref" string "positions"'
- write(11,*) 'object 3 class array type float rank 0 items ',nglob,' data follows'
- else
- ! dummy text for labels
- write(11,*) '1 1'
- write(11,*) 'a, b'
- endif
-
- ! output data values
- mask_point = .false.
- do ispec=1,nspectot_AVS_max
- ieoff = NGNOD2D_AVS_DX*(ispec-1)
- ! four points for each element
- do ilocnum = 1,NGNOD2D_AVS_DX
- ibool_number = iglob(ilocnum+ieoff)
- if(.not. mask_point(ibool_number)) then
- if(USE_OPENDX) then
- if(plot_shaking_map) then
- write(11,*) sngl(field_display(ilocnum+ieoff))
- else
- write(11,"(f7.2)") field_display(ilocnum+ieoff)
- endif
- else
- if(plot_shaking_map) then
- write(11,*) ireorder(ibool_number),field_display(ilocnum+ieoff)
- else
- write(11,"(i10,1x,f7.2)") ireorder(ibool_number),field_display(ilocnum+ieoff)
- endif
- endif
- endif
- mask_point(ibool_number) = .true.
- enddo
- enddo
-
- ! define OpenDX field
- if(USE_OPENDX) then
- write(11,*) 'attribute "dep" string "positions"'
- write(11,*) 'object "irregular positions irregular connections" class field'
- write(11,*) 'component "positions" value 1'
- write(11,*) 'component "connections" value 2'
- write(11,*) 'component "data" value 3'
- write(11,*) 'end'
- endif
-
- ! end of test for GMT format
- endif
-
- close(11)
-
- ! end of loop and test on all the time steps for all the movie images
- endif
-enddo ! it
-
- print *
- print *,'done creating movie or shaking map'
- print *
- if(USE_OPENDX) print *,'DX files are stored in ', trim(OUTPUT_FILES), '/DX_*.dx'
- if(USE_AVS) print *,'AVS files are stored in ', trim(OUTPUT_FILES), '/AVS_*.inp'
- if(USE_GMT) print *,'GMT files are stored in ', trim(OUTPUT_FILES), '/gmt_*.xyz'
- print *
-
-
- deallocate(store_val_x)
- deallocate(store_val_y)
- deallocate(store_val_z)
- deallocate(store_val_ux)
- deallocate(store_val_uy)
- deallocate(store_val_uz)
-
- ! deallocate arrays for sorting routine
- deallocate(iglob,loc)
- deallocate(ifseg)
- deallocate(xp,yp,zp)
- deallocate(xp_save,yp_save,zp_save)
- deallocate(field_display)
- deallocate(mask_point)
- deallocate(ireorder)
-
- if(USE_HIGHRES_FOR_MOVIES) then
- deallocate(x)
- deallocate(y)
- deallocate(z)
- deallocate(display)
- endif
-
- end program create_movie_shakemap
-
-!
-!=====================================================================
-!
-
- subroutine get_global_AVS(nspec,xp,yp,zp,iglob,loc,ifseg,nglob,npointot,UTM_X_MIN,UTM_X_MAX)
-
-! this routine MUST be in double precision to avoid sensitivity
-! to roundoff errors in the coordinates of the points
-
-! leave sorting subroutines in same source file to allow for inlining
-
- implicit none
-
- include "constants.h"
-
-! number of points in each AVS or OpenDX quadrangular cell for movies
- integer, parameter :: NGNOD2D_AVS_DX = 4
-
-! geometry tolerance parameter to calculate number of independent grid points
-! small value for double precision and to avoid sensitivity to roundoff
- double precision SMALLVALTOL
-
- integer npointot
- integer iglob(npointot),loc(npointot)
- logical ifseg(npointot)
- double precision xp(npointot),yp(npointot),zp(npointot)
- integer nspec,nglob
-
- integer ispec,i,j
- integer ieoff,ilocnum,nseg,ioff,iseg,ig
-
- integer, dimension(:), allocatable :: ind,ninseg,iwork
- double precision, dimension(:), allocatable :: work
-
- double precision UTM_X_MIN,UTM_X_MAX
-
-! define geometrical tolerance based upon typical size of the model
- SMALLVALTOL = 1.d-10 * dabs(UTM_X_MAX - UTM_X_MIN)
- print *, 'UTM_X_MAX', UTM_X_MAX
- print *, 'UTM_X_MIN', UTM_X_MIN
- print *, 'SMALLVALTOL', SMALLVALTOL
-
-! dynamically allocate arrays
- allocate(ind(npointot))
- allocate(ninseg(npointot))
- allocate(iwork(npointot))
- allocate(work(npointot))
-
-! establish initial pointers
- do ispec=1,nspec
- ieoff=NGNOD2D_AVS_DX*(ispec-1)
- do ilocnum=1,NGNOD2D_AVS_DX
- loc(ilocnum+ieoff)=ilocnum+ieoff
- enddo
- enddo
-
- ifseg(:)=.false.
-
- nseg=1
- ifseg(1)=.true.
- ninseg(1)=npointot
-
- do j=1,NDIM
-
-! sort within each segment
- ioff=1
- do iseg=1,nseg
- if(j == 1) then
- call rank(xp(ioff),ind,ninseg(iseg))
- else if(j == 2) then
- call rank(yp(ioff),ind,ninseg(iseg))
- else
- call rank(zp(ioff),ind,ninseg(iseg))
- endif
- call swap_all(loc(ioff),xp(ioff),yp(ioff),zp(ioff),iwork,work,ind,ninseg(iseg))
- ioff=ioff+ninseg(iseg)
- enddo
-
-! check for jumps in current coordinate
-! compare the coordinates of the points within a small tolerance
- if(j == 1) then
- do i=2,npointot
- if(dabs(xp(i)-xp(i-1)) > SMALLVALTOL) ifseg(i)=.true.
- enddo
- else if(j == 2) then
- do i=2,npointot
- if(dabs(yp(i)-yp(i-1)) > SMALLVALTOL) ifseg(i)=.true.
- enddo
- else
- do i=2,npointot
- if(dabs(zp(i)-zp(i-1)) > SMALLVALTOL) ifseg(i)=.true.
- enddo
- endif
-
-! count up number of different segments
- nseg=0
- do i=1,npointot
- if(ifseg(i)) then
- nseg=nseg+1
- ninseg(nseg)=1
- else
- ninseg(nseg)=ninseg(nseg)+1
- endif
- enddo
- enddo
-
-! assign global node numbers (now sorted lexicographically)
- ig=0
- do i=1,npointot
- if(ifseg(i)) ig=ig+1
- iglob(loc(i))=ig
- enddo
-
- nglob=ig
-
-! deallocate arrays
- deallocate(ind)
- deallocate(ninseg)
- deallocate(iwork)
- deallocate(work)
-
- end subroutine get_global_AVS
-
-! -----------------------------------
-
-! sorting routines put in same file to allow for inlining
-
- subroutine rank(A,IND,N)
-!
-! Use Heap Sort (Numerical Recipes)
-!
- implicit none
-
- integer n
- double precision A(n)
- integer IND(n)
-
- integer i,j,l,ir,indx
- double precision q
-
- do j=1,n
- IND(j)=j
- enddo
-
- if (n == 1) return
-
- L=n/2+1
- ir=n
- 100 CONTINUE
- IF (l>1) THEN
- l=l-1
- indx=ind(l)
- q=a(indx)
- ELSE
- indx=ind(ir)
- q=a(indx)
- ind(ir)=ind(1)
- ir=ir-1
- if (ir == 1) then
- ind(1)=indx
- return
- endif
- ENDIF
- i=l
- j=l+l
- 200 CONTINUE
- IF (J <= IR) THEN
- IF (J<IR) THEN
- IF ( A(IND(j))<A(IND(j+1)) ) j=j+1
- ENDIF
- IF (q<A(IND(j))) THEN
- IND(I)=IND(J)
- I=J
- J=J+J
- ELSE
- J=IR+1
- ENDIF
- goto 200
- ENDIF
- IND(I)=INDX
- goto 100
- end subroutine rank
-
-! ------------------------------------------------------------------
-
- subroutine swap_all(IA,A,B,C,IW,W,ind,n)
-!
-! swap arrays IA, A, B and C according to addressing in array IND
-!
- implicit none
-
- integer n
-
- integer IND(n)
- integer IA(n),IW(n)
- double precision A(n),B(n),C(n),W(n)
-
- integer i
-
- IW(:) = IA(:)
- W(:) = A(:)
-
- do i=1,n
- IA(i)=IW(ind(i))
- A(i)=W(ind(i))
- enddo
-
- W(:) = B(:)
-
- do i=1,n
- B(i)=W(ind(i))
- enddo
-
- W(:) = C(:)
-
- do i=1,n
- C(i)=W(ind(i))
- enddo
-
- end subroutine swap_all
-
Deleted: seismo/3D/SPECFEM3D/trunk/create_name_database.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/create_name_database.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/create_name_database.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,47 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine create_name_database(prname,iproc,LOCAL_PATH)
-
-! create the name of the database for the mesher and the solver
-
- implicit none
-
- integer iproc
-
-! name of the database file
- character(len=256) prname,procname,LOCAL_PATH,clean_LOCAL_PATH
-
-! create the name for the database of the current slide and region
- write(procname,"('/proc',i6.6,'_')") iproc
-
-! suppress white spaces if any
- clean_LOCAL_PATH = adjustl(LOCAL_PATH)
-
-! create full name with path
- prname = clean_LOCAL_PATH(1:len_trim(clean_LOCAL_PATH)) // procname
-
- end subroutine create_name_database
-
Deleted: seismo/3D/SPECFEM3D/trunk/create_regions_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/create_regions_mesh.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/create_regions_mesh.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,773 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-module create_regions_mesh_ext_par
-
- include 'constants.h'
-
-! global point coordinates
- real(kind=CUSTOM_REAL), dimension(:), allocatable :: xstore_dummy
- real(kind=CUSTOM_REAL), dimension(:), allocatable :: ystore_dummy
- real(kind=CUSTOM_REAL), dimension(:), allocatable :: zstore_dummy
-
-! Gauss-Lobatto-Legendre points and weights of integration
- double precision, dimension(:), allocatable :: xigll,yigll,zigll,wxgll,wygll,wzgll
-
-! 3D shape functions and their derivatives
- double precision, dimension(:,:,:,:), allocatable :: shape3D
- double precision, dimension(:,:,:,:,:), allocatable :: dershape3D
-
- double precision, dimension(:), allocatable :: xelm,yelm,zelm
-
-! arrays with mesh parameters
- real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: xixstore,xiystore,xizstore, &
- etaxstore,etaystore,etazstore,gammaxstore,gammaystore,gammazstore,jacobianstore
-
-! for model density, kappa, mu
- real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: rhostore,kappastore,mustore
-
-! mass matrix
- real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmass,rmass_acoustic,&
- rmass_solid_poroelastic,rmass_fluid_poroelastic
-
-! ocean load
- integer :: NGLOB_OCEAN
- real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmass_ocean_load
-
-! attenuation
- integer, dimension(:,:,:,:), allocatable :: iflag_attenuation_store
-
-! 2D shape functions and their derivatives, weights
- double precision, dimension(:,:,:), allocatable :: shape2D_x,shape2D_y,shape2D_bottom,shape2D_top
- double precision, dimension(:,:,:,:), allocatable :: dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top
- double precision, dimension(:,:), allocatable :: wgllwgll_xy,wgllwgll_xz,wgllwgll_yz
-
-! 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
- integer, dimension(:,:,:), allocatable :: abs_boundary_ijk
- integer, dimension(:), allocatable :: abs_boundary_ispec
- integer :: num_abs_boundary_faces
-
-! free surface arrays
- real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: free_surface_normal
- real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: free_surface_jacobian2Dw
- integer, dimension(:,:,:), allocatable :: free_surface_ijk
- integer, dimension(:), allocatable :: free_surface_ispec
- integer :: num_free_surface_faces
-
-! acoustic-elastic coupling surface
- real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: coupling_ac_el_normal
- real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: coupling_ac_el_jacobian2Dw
- integer, dimension(:,:,:), allocatable :: coupling_ac_el_ijk
- integer, dimension(:), allocatable :: coupling_ac_el_ispec
- integer :: num_coupling_ac_el_faces
-
-! for stacey
- real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: rho_vp,rho_vs
-
-! anisotropy
- integer :: NSPEC_ANISO
- real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: &
- c11store,c12store,c13store,c14store,c15store,c16store,&
- c22store,c23store,c24store,c25store,c26store,c33store,&
- c34store,c35store,c36store,c44store,c45store,c46store,&
- c55store,c56store,c66store
-
-! material domain flags
- logical, dimension(:), allocatable :: ispec_is_acoustic,ispec_is_elastic,ispec_is_poroelastic
-
-! name of the database file
- character(len=256) prname
-
-end module create_regions_mesh_ext_par
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-! 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, &
- UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION,NX_TOPO,NY_TOPO, &
- ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO, &
- itopo_bathy)
-
-! create the different regions of the mesh
-
- 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(6,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
-
-! 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
-! static memory size needed by the solver
- double precision :: static_memory_size
- real(kind=CUSTOM_REAL) :: model_speed_max
-
-! for vtk output
-! character(len=256) prname_file
-! integer,dimension(:),allocatable :: itest_flag
-! integer, dimension(:), allocatable :: elem_flag
-
-! For Piero Basini :
-! integer :: doubling_value_found_for_Piero
-! double precision :: xmesh,ymesh,zmesh
-! double precision :: rho,vp,vs
-
-! integer,dimension(nspec) :: idoubling
-! integer :: doubling_value_found_for_Piero
-! integer, parameter :: NUMBER_OF_STATIONS = 6
-! double precision, parameter :: RADIUS_TO_EXCLUDE = 250.d0
-! double precision, dimension(NUMBER_OF_STATIONS) :: utm_x_station,utm_y_station
-
-! logical :: is_around_a_station
-! integer :: istation
-
-! ! store bedrock values
-! integer :: icornerlat,icornerlong
-! double precision :: lat,long,elevation_bedrock
-! double precision :: lat_corner,long_corner,ratio_xi,ratio_eta
-!real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: ibedrock
-
-! initializes arrays
- call sync_all()
- if( myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) ' ...allocating arrays '
- endif
- call crm_ext_allocate_arrays(nspec,LOCAL_PATH,myrank, &
- nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
- nspec2D_bottom,nspec2D_top,ANISOTROPY)
-
-
-! fills location and weights for Gauss-Lobatto-Legendre points, shape and derivations,
-! returns jacobianstore,xixstore,...gammazstore
-! and GLL-point locations in xstore,ystore,zstore
- call sync_all()
- if( myrank == 0) then
- write(IMAIN,*) ' ...setting up jacobian '
- endif
- call crm_ext_setup_jacobian(myrank, &
- xstore,ystore,zstore,nspec, &
- nodes_coords_ext_mesh,nnodes_ext_mesh,&
- elmnts_ext_mesh,nelmnts_ext_mesh)
-
-! creates ibool index array for projection from local to global points
- call sync_all()
- if( myrank == 0) then
- write(IMAIN,*) ' ...indexing global points'
- endif
- call crm_ext_setup_indexing(ibool, &
- xstore,ystore,zstore,nspec,nglob,npointot, &
- nnodes_ext_mesh,nodes_coords_ext_mesh,myrank)
-
-! sets up MPI interfaces between partitions
- call sync_all()
- if( myrank == 0) then
- write(IMAIN,*) ' ...preparing MPI interfaces '
- endif
- call get_MPI(myrank,nglob,nspec,ibool, &
- nelmnts_ext_mesh,elmnts_ext_mesh, &
- my_nelmnts_neighbours_ext_mesh, my_interfaces_ext_mesh, &
- ibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh, &
- 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, &
- 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, &
- nodes_ibelm_bottom,nodes_ibelm_top, &
- nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
- nspec2D_bottom,nspec2D_top)
-
-! sets up acoustic-elastic coupling surfaces
- call sync_all()
- if( myrank == 0) then
- write(IMAIN,*) ' ...detecting acoustic-elastic surfaces '
- endif
- call get_coupling_surfaces(myrank, &
- nspec,nglob,ibool,NPROC, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,&
- num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
- my_neighbours_ext_mesh)
-
-! creates mass matrix
- call sync_all()
- if( myrank == 0) then
- write(IMAIN,*) ' ...creating mass matrix '
- endif
- call create_mass_matrices(nglob,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,&
- UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION,NX_TOPO,NY_TOPO, &
- ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO, &
- itopo_bathy)
-
-! saves the binary mesh files
- call sync_all()
- if( myrank == 0) then
- write(IMAIN,*) ' ...saving databases'
- endif
- !call create_name_database(prname,myrank,LOCAL_PATH)
- call save_arrays_solver_ext_mesh(nspec,nglob, &
- xixstore,xiystore,xizstore,etaxstore,etaystore,etazstore,&
- gammaxstore,gammaystore,gammazstore, &
- jacobianstore, rho_vp,rho_vs,iflag_attenuation_store, &
- rhostore,kappastore,mustore, &
- rmass,rmass_acoustic,rmass_solid_poroelastic,rmass_fluid_poroelastic, &
- OCEANS,rmass_ocean_load,NGLOB_OCEAN,ibool,xstore_dummy,ystore_dummy,zstore_dummy, &
- abs_boundary_normal,abs_boundary_jacobian2Dw, &
- abs_boundary_ijk,abs_boundary_ispec,num_abs_boundary_faces, &
- free_surface_normal,free_surface_jacobian2Dw, &
- free_surface_ijk,free_surface_ispec,num_free_surface_faces, &
- coupling_ac_el_normal,coupling_ac_el_jacobian2Dw, &
- coupling_ac_el_ijk,coupling_ac_el_ispec,num_coupling_ac_el_faces, &
- num_interfaces_ext_mesh,my_neighbours_ext_mesh,nibool_interfaces_ext_mesh, &
- max_interface_size_ext_mesh,ibool_interfaces_ext_mesh, &
- prname,SAVE_MESH_FILES,ANISOTROPY,NSPEC_ANISO, &
- c11store,c12store,c13store,c14store,c15store,c16store, &
- c22store,c23store,c24store,c25store,c26store,c33store, &
- c34store,c35store,c36store,c44store,c45store,c46store, &
- c55store,c56store,c66store, &
- ispec_is_acoustic,ispec_is_elastic,ispec_is_poroelastic)
-
-! computes the approximate amount of static memory needed to run the solver
- call memory_eval(nspec,nglob,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()
- call check_mesh_resolution(myrank,nspec,nglob,ibool,&
- xstore_dummy,ystore_dummy,zstore_dummy, &
- kappastore,mustore,rho_vp,rho_vs, &
- -1.0d0, model_speed_max )
-
-! VTK file output
-! if( SAVE_MESH_FILES ) then
-! ! saves material flag assigned for each spectral element into a vtk file
-! 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, &
-! xstore_dummy,ystore_dummy,zstore_dummy,ibool, &
-! elem_flag,prname_file)
-! deallocate(elem_flag)
-!
-! !plotting abs boundaries
-! ! allocate(itest_flag(nspec))
-! ! itest_flag(:) = 0
-! ! do ispec=1,nspec
-! ! 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, &
-! ! xstore_dummy,ystore_dummy,zstore_dummy,ibool, &
-! ! itest_flag,prname_file)
-! ! deallocate(itest_flag)
-! endif
-
-! AVS/DX file output
-! create AVS or DX mesh data for the slice, edges and faces
-! if(SAVE_MESH_FILES) then
-! check: no idoubling
-! call write_AVS_DX_global_data(myrank,prname,nspec,ibool,idoubling,xstore,ystore,zstore,locval,ifseg,npointot)
-! call write_AVS_DX_mesh_quality_data(prname,nspec,xstore,ystore,zstore, &
-! kappastore,mustore,rhostore)
-! check: no iMPIcut_xi,iMPIcut_eta,idoubling
-! call write_AVS_DX_global_faces_data(myrank,prname,nspec,iMPIcut_xi,iMPIcut_eta,ibool, &
-! idoubling,xstore,ystore,zstore,locval,ifseg,npointot)
-! check: no idoubling
-! call write_AVS_DX_surface_data(myrank,prname,nspec,iboun,ibool, &
-! idoubling,xstore,ystore,zstore,locval,ifseg,npointot)
-! endif
-
-! cleanup
- if( .not. SAVE_MOHO_MESH ) deallocate(xstore_dummy,ystore_dummy,zstore_dummy)
- deallocate(xixstore,xiystore,xizstore,&
- etaxstore,etaystore,etazstore,&
- gammaxstore,gammaystore,gammazstore)
- deallocate(jacobianstore,iflag_attenuation_store)
- deallocate(kappastore,mustore,rho_vp,rho_vs)
-
-end subroutine create_regions_mesh_ext
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine crm_ext_allocate_arrays(nspec,LOCAL_PATH,myrank, &
- nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
- nspec2D_bottom,nspec2D_top,ANISOTROPY)
-
- use create_regions_mesh_ext_par
- implicit none
-
- integer :: nspec,myrank
- integer :: nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
- nspec2D_bottom,nspec2D_top
-
- character(len=256) :: LOCAL_PATH
-
- logical :: ANISOTROPY
-
-! local parameters
- integer :: ier
-
-! memory test
-! logical,dimension(:),allocatable :: test_mem
-!
-! tests memory availability (including some small buffer of 10*1024 byte)
-! allocate( test_mem(int(max_static_memory_size)+10*1024),stat=ier)
-! if(ier /= 0) then
-! write(IMAIN,*) 'error: try to increase the available process stack size by'
-! write(IMAIN,*) ' ulimit -s **** '
-! call exit_MPI(myrank,'not enough memory to allocate arrays')
-! endif
-! test_mem(:) = .true.
-! deallocate( test_mem, stat=ier)
-! if(ier /= 0) call exit_MPI(myrank,'error to allocate arrays')
-! call sync_all()
-
- allocate( xelm(NGNOD),yelm(NGNOD),zelm(NGNOD),stat=ier)
-
- allocate( iflag_attenuation_store(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
- if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
-
-! create the name for the database of the current slide and region
- call create_name_database(prname,myrank,LOCAL_PATH)
-
-! Gauss-Lobatto-Legendre points of integration
- allocate(xigll(NGLLX),yigll(NGLLY),zigll(NGLLZ))
-
-! Gauss-Lobatto-Legendre weights of integration
- allocate(wxgll(NGLLX),wygll(NGLLY),wzgll(NGLLZ))
-
-! 3D shape functions and their derivatives
- allocate(shape3D(NGNOD,NGLLX,NGLLY,NGLLZ), &
- dershape3D(NDIM,NGNOD,NGLLX,NGLLY,NGLLZ),stat=ier)
-
-! 2D shape functions and their derivatives
- allocate(shape2D_x(NGNOD2D,NGLLY,NGLLZ), &
- shape2D_y(NGNOD2D,NGLLX,NGLLZ), &
- shape2D_bottom(NGNOD2D,NGLLX,NGLLY), &
- shape2D_top(NGNOD2D,NGLLX,NGLLY), stat=ier)
-
- allocate(dershape2D_x(NDIM2D,NGNOD2D,NGLLY,NGLLZ), &
- dershape2D_y(NDIM2D,NGNOD2D,NGLLX,NGLLZ), &
- dershape2D_bottom(NDIM2D,NGNOD2D,NGLLX,NGLLY), &
- dershape2D_top(NDIM2D,NGNOD2D,NGLLX,NGLLY),stat=ier)
-
- allocate(wgllwgll_xy(NGLLX,NGLLY), &
- wgllwgll_xz(NGLLX,NGLLZ), &
- wgllwgll_yz(NGLLY,NGLLZ),stat=ier)
- if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
-
-! Stacey
- allocate(rho_vp(NGLLX,NGLLY,NGLLZ,nspec), &
- rho_vs(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
- if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
-
-! array with model density
- allocate(rhostore(NGLLX,NGLLY,NGLLZ,nspec), &
- kappastore(NGLLX,NGLLY,NGLLZ,nspec), &
- mustore(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
- !vpstore(NGLLX,NGLLY,NGLLZ,nspec), &
- !vsstore(NGLLX,NGLLY,NGLLZ,nspec),
- if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
-
-! arrays with mesh parameters
- allocate(xixstore(NGLLX,NGLLY,NGLLZ,nspec), &
- xiystore(NGLLX,NGLLY,NGLLZ,nspec), &
- xizstore(NGLLX,NGLLY,NGLLZ,nspec), &
- etaxstore(NGLLX,NGLLY,NGLLZ,nspec), &
- etaystore(NGLLX,NGLLY,NGLLZ,nspec), &
- etazstore(NGLLX,NGLLY,NGLLZ,nspec), &
- gammaxstore(NGLLX,NGLLY,NGLLZ,nspec), &
- gammaystore(NGLLX,NGLLY,NGLLZ,nspec), &
- gammazstore(NGLLX,NGLLY,NGLLZ,nspec), &
- jacobianstore(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
- if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
-
-! absorbing boundary
- ! absorbing faces
- num_abs_boundary_faces = nspec2D_xmin + nspec2D_xmax + nspec2D_ymin + nspec2D_ymax + nspec2D_bottom
- ! adds faces of free surface if it also absorbs
- if( ABSORB_FREE_SURFACE ) num_abs_boundary_faces = num_abs_boundary_faces + nspec2D_top
-
- ! allocates arrays to store info for each face (assumes NGLLX=NGLLY=NGLLZ)
- allocate( abs_boundary_ispec(num_abs_boundary_faces), &
- abs_boundary_ijk(3,NGLLSQUARE,num_abs_boundary_faces), &
- abs_boundary_jacobian2Dw(NGLLSQUARE,num_abs_boundary_faces), &
- abs_boundary_normal(NDIM,NGLLSQUARE,num_abs_boundary_faces),stat=ier)
- if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
-
-! free surface
- ! free surface faces
- if( ABSORB_FREE_SURFACE ) then
- ! no free surface - uses a dummy size
- num_free_surface_faces = 1
- else
- num_free_surface_faces = nspec2D_top
- endif
-
- ! allocates arrays to store info for each face (assumes NGLLX=NGLLY=NGLLZ)
- allocate( free_surface_ispec(num_free_surface_faces), &
- free_surface_ijk(3,NGLLSQUARE,num_free_surface_faces), &
- free_surface_jacobian2Dw(NGLLSQUARE,num_free_surface_faces), &
- free_surface_normal(NDIM,NGLLSQUARE,num_free_surface_faces),stat=ier)
- if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
-
-! array with anisotropy
- if( ANISOTROPY ) then
- NSPEC_ANISO = nspec
- else
- NSPEC_ANISO = 1
- endif
- allocate(c11store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c12store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c13store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c14store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c15store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c16store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c22store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c23store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c24store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c25store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c26store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c33store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c34store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c35store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c36store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c44store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c45store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c46store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c55store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c56store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO), &
- c66store(NGLLX,NGLLY,NGLLZ,NSPEC_ANISO),stat=ier)
- if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
-
-! material flags
- allocate( ispec_is_acoustic(nspec), &
- ispec_is_elastic(nspec), &
- ispec_is_poroelastic(nspec), stat=ier)
- if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
-
-end subroutine crm_ext_allocate_arrays
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine crm_ext_setup_jacobian(myrank, &
- xstore,ystore,zstore,nspec, &
- nodes_coords_ext_mesh,nnodes_ext_mesh,&
- elmnts_ext_mesh,nelmnts_ext_mesh)
-
- use create_regions_mesh_ext_par
- implicit none
-
-! number of spectral elements in each block
- integer :: nspec
-
- double precision, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: xstore,ystore,zstore
-
-! 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
-
-! proc numbers for MPI
- integer :: myrank
-
-! local parameters
- integer :: ispec,ia,i,j,k
-
-! set up coordinates of the Gauss-Lobatto-Legendre points
- call zwgljd(xigll,wxgll,NGLLX,GAUSSALPHA,GAUSSBETA)
- call zwgljd(yigll,wygll,NGLLY,GAUSSALPHA,GAUSSBETA)
- call zwgljd(zigll,wzgll,NGLLZ,GAUSSALPHA,GAUSSBETA)
-
-! if number of points is odd, the middle abscissa is exactly zero
- if(mod(NGLLX,2) /= 0) xigll((NGLLX-1)/2+1) = ZERO
- if(mod(NGLLY,2) /= 0) yigll((NGLLY-1)/2+1) = ZERO
- if(mod(NGLLZ,2) /= 0) zigll((NGLLZ-1)/2+1) = ZERO
-
-! get the 3-D shape functions
- call get_shape3D(myrank,shape3D,dershape3D,xigll,yigll,zigll)
-
-! get the 2-D shape functions
- call get_shape2D(myrank,shape2D_x,dershape2D_x,yigll,zigll,NGLLY,NGLLZ)
- call get_shape2D(myrank,shape2D_y,dershape2D_y,xigll,zigll,NGLLX,NGLLZ)
- call get_shape2D(myrank,shape2D_bottom,dershape2D_bottom,xigll,yigll,NGLLX,NGLLY)
- call get_shape2D(myrank,shape2D_top,dershape2D_top,xigll,yigll,NGLLX,NGLLY)
-
-! 2D weights
- do j=1,NGLLY
- do i=1,NGLLX
- wgllwgll_xy(i,j) = wxgll(i)*wygll(j)
- enddo
- enddo
- do k=1,NGLLZ
- do i=1,NGLLX
- wgllwgll_xz(i,k) = wxgll(i)*wzgll(k)
- enddo
- enddo
- do k=1,NGLLZ
- do j=1,NGLLY
- wgllwgll_yz(j,k) = wygll(j)*wzgll(k)
- enddo
- enddo
-
-! point locations
- xstore(:,:,:,:) = 0.d0
- ystore(:,:,:,:) = 0.d0
- zstore(:,:,:,:) = 0.d0
-
- do ispec = 1, nspec
- !call get_xyzelm(xelm, yelm, zelm, ispec, elmnts_ext_mesh, nodes_coords_ext_mesh, nspec, nnodes_ext_mesh)
- do ia = 1,NGNOD
- xelm(ia) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(ia,ispec))
- yelm(ia) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(ia,ispec))
- zelm(ia) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(ia,ispec))
- enddo
-
- ! CUBIT should provide a mesh ordering such that the 3D jacobian is defined
- ! (otherwise mesh would be degenerated)
- call calc_jacobian(myrank,xixstore,xiystore,xizstore, &
- etaxstore,etaystore,etazstore, &
- gammaxstore,gammaystore,gammazstore,jacobianstore, &
- xstore,ystore,zstore, &
- xelm,yelm,zelm,shape3D,dershape3D,ispec,nspec)
-
- enddo
-
-end subroutine crm_ext_setup_jacobian
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-subroutine crm_ext_setup_indexing(ibool, &
- xstore,ystore,zstore,nspec,nglob,npointot, &
- nnodes_ext_mesh,nodes_coords_ext_mesh,myrank)
-
-! creates global indexing array ibool
-
- use create_regions_mesh_ext_par
- implicit none
-
-! number of spectral elements in each block
- integer :: nspec,nglob,npointot,myrank
-
-! arrays with the mesh
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
- double precision, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: xstore,ystore,zstore
-
-! data from the external mesh
- integer :: nnodes_ext_mesh
- double precision, dimension(NDIM,nnodes_ext_mesh) :: nodes_coords_ext_mesh
-
-! local parameters
-! variables for creating array ibool
- double precision, dimension(:), allocatable :: xp,yp,zp
- integer, dimension(:), allocatable :: locval
- logical, dimension(:), allocatable :: ifseg
-
- integer :: ieoff,ilocnum,ier
- integer :: i,j,k,ispec,iglobnum
-
-! allocate memory for arrays
- allocate(locval(npointot), &
- ifseg(npointot), &
- xp(npointot), &
- yp(npointot), &
- zp(npointot),stat=ier)
- if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
-
-! creates temporary global point arrays
- locval = 0
- ifseg = .false.
- xp = 0.d0
- yp = 0.d0
- zp = 0.d0
-
- do ispec=1,nspec
- ieoff = NGLLX * NGLLY * NGLLZ * (ispec-1)
- ilocnum = 0
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- ilocnum = ilocnum + 1
- xp(ilocnum+ieoff) = xstore(i,j,k,ispec)
- yp(ilocnum+ieoff) = ystore(i,j,k,ispec)
- zp(ilocnum+ieoff) = zstore(i,j,k,ispec)
- enddo
- enddo
- enddo
- enddo
-
-! gets ibool indexing from local (GLL points) to global points
- call get_global(nspec,xp,yp,zp,ibool,locval,ifseg,nglob,npointot, &
- minval(nodes_coords_ext_mesh(1,:)),maxval(nodes_coords_ext_mesh(1,:)))
-
-!- we can create a new indirect addressing to reduce cache misses
- call get_global_indirect_addressing(nspec,nglob,ibool)
-
-!cleanup
- deallocate(xp,stat=ier); if(ier /= 0) stop 'error in deallocate'
- deallocate(yp,stat=ier); if(ier /= 0) stop 'error in deallocate'
- deallocate(zp,stat=ier); if(ier /= 0) stop 'error in deallocate'
- deallocate(locval,stat=ier); if(ier /= 0) stop 'error in deallocate'
- 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)
- if(ier /= 0) stop 'error in allocate'
- do ispec = 1, nspec
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
- iglobnum = ibool(i,j,k,ispec)
- xstore_dummy(iglobnum) = xstore(i,j,k,ispec)
- ystore_dummy(iglobnum) = ystore(i,j,k,ispec)
- zstore_dummy(iglobnum) = zstore(i,j,k,ispec)
- enddo
- enddo
- enddo
- enddo
-
-end subroutine crm_ext_setup_indexing
Deleted: seismo/3D/SPECFEM3D/trunk/create_serial_name_database.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/create_serial_name_database.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/create_serial_name_database.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,86 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine create_serial_name_database(prname,iproc,LOCAL_PATH,NPROC,OUTPUT_FILES)
-
-! create name of the database for serial codes (AVS_DX and codes to check buffers)
-
- implicit none
-
- include "constants.h"
-
- integer iproc,NPROC
-
-! name of the database file
- character(len=256) prname,procname,LOCAL_PATH,clean_LOCAL_PATH,serial_prefix,OUTPUT_FILES
-
- integer iprocloop,nproc_max_loop
- integer, dimension(:), allocatable :: num_active_proc
-
- nproc_max_loop = NPROC-1
-
-! create the name for the database of the current slide and region
- write(procname,"('/proc',i6.6,'_')") iproc
-
-! on a Beowulf-type machine, path on frontend can be different from local paths
- if(.not. LOCAL_PATH_IS_ALSO_GLOBAL) then
-
-! allocate array for active processors
- allocate(num_active_proc(0:nproc_max_loop))
-
-! read filtered file with name of active machines
- open(unit=48,file=trim(OUTPUT_FILES)//'/filtered_machines.txt',status='old',action='read')
- do iprocloop = 0,nproc_max_loop
- read(48,*) num_active_proc(iprocloop)
- enddo
- close(48)
-
-! create the serial prefix pointing to the correct machine
- write(serial_prefix,"('/auto/scratch_n',i6.6,'/')") num_active_proc(iproc)
-
-! suppress everything until the last "/" to define the base name of local path
-! this is system dependent since it assumes the disks are mounted
-! as on our Beowulf (Unix and NFS)
- clean_LOCAL_PATH = LOCAL_PATH(index(LOCAL_PATH,'/',.true.)+1:len_trim(LOCAL_PATH))
-
-! create full name with path
- prname = serial_prefix(1:len_trim(serial_prefix)) // clean_LOCAL_PATH(1:len_trim(clean_LOCAL_PATH)) // procname
-
-! deallocate array
- deallocate(num_active_proc)
-
-! on shared-memory machines, global path is the same as local path
- else
-
-! suppress white spaces if any
- clean_LOCAL_PATH = adjustl(LOCAL_PATH)
-
-! create full name with path
- prname = clean_LOCAL_PATH(1:len_trim(clean_LOCAL_PATH)) // procname
-
- endif
-
- end subroutine create_serial_name_database
-
Deleted: seismo/3D/SPECFEM3D/trunk/define_derivation_matrices.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/define_derivation_matrices.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/define_derivation_matrices.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,157 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine define_derivation_matrices(xigll,yigll,zigll,wxgll,wygll,wzgll, &
- hprime_xx,hprime_yy,hprime_zz, &
- hprimewgll_xx,hprimewgll_yy,hprimewgll_zz, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz)
-
- implicit none
-
- include "constants.h"
-
-! Gauss-Lobatto-Legendre points of integration and weights
- double precision, dimension(NGLLX) :: xigll,wxgll
- double precision, dimension(NGLLY) :: yigll,wygll
- double precision, dimension(NGLLZ) :: zigll,wzgll
-
-! array with derivatives of Lagrange polynomials and precalculated products
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx,hprimewgll_xx
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLY) :: hprime_yy,hprimewgll_yy
- real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz,hprimewgll_zz
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY) :: wgllwgll_xy
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ) :: wgllwgll_xz
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ) :: wgllwgll_yz
-
-! function for calculating derivatives of Lagrange polynomials
- double precision, external :: lagrange_deriv_GLL
-
- integer i,j,k,i1,i2,j1,j2,k1,k2
-
-! $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
-
-! set up coordinates of the Gauss-Lobatto-Legendre points
- call zwgljd(xigll,wxgll,NGLLX,GAUSSALPHA,GAUSSBETA)
- call zwgljd(yigll,wygll,NGLLY,GAUSSALPHA,GAUSSBETA)
- call zwgljd(zigll,wzgll,NGLLZ,GAUSSALPHA,GAUSSBETA)
-
-! if number of points is odd, the middle abscissa is exactly ZERO
- if(mod(NGLLX,2) /= 0) xigll((NGLLX-1)/2+1) = ZERO
- if(mod(NGLLY,2) /= 0) yigll((NGLLY-1)/2+1) = ZERO
- if(mod(NGLLZ,2) /= 0) zigll((NGLLZ-1)/2+1) = ZERO
-
-! distinguish between single and double precision for reals
- if(CUSTOM_REAL == SIZE_REAL) then
-
-! calculate derivatives of the Lagrange polynomials
-! and precalculate some products in double precision
-! hprime(i,j) = h'_j(xigll_i) by definition of the derivation matrix
- do i1=1,NGLLX
- do i2=1,NGLLX
- hprime_xx(i2,i1) = sngl(lagrange_deriv_GLL(i1-1,i2-1,xigll,NGLLX))
- hprimewgll_xx(i2,i1) = sngl(lagrange_deriv_GLL(i1-1,i2-1,xigll,NGLLX)*wxgll(i2))
- enddo
- enddo
-
- do j1=1,NGLLY
- do j2=1,NGLLY
- hprime_yy(j2,j1) = sngl(lagrange_deriv_GLL(j1-1,j2-1,yigll,NGLLY))
- hprimewgll_yy(j2,j1) = sngl(lagrange_deriv_GLL(j1-1,j2-1,yigll,NGLLY)*wygll(j2))
- enddo
- enddo
-
- do k1=1,NGLLZ
- do k2=1,NGLLZ
- hprime_zz(k2,k1) = sngl(lagrange_deriv_GLL(k1-1,k2-1,zigll,NGLLZ))
- hprimewgll_zz(k2,k1) = sngl(lagrange_deriv_GLL(k1-1,k2-1,zigll,NGLLZ)*wzgll(k2))
- enddo
- enddo
-
- do i=1,NGLLX
- do j=1,NGLLY
- wgllwgll_xy(i,j) = sngl(wxgll(i)*wygll(j))
- enddo
- enddo
-
- do i=1,NGLLX
- do k=1,NGLLZ
- wgllwgll_xz(i,k) = sngl(wxgll(i)*wzgll(k))
- enddo
- enddo
-
- do j=1,NGLLY
- do k=1,NGLLZ
- wgllwgll_yz(j,k) = sngl(wygll(j)*wzgll(k))
- enddo
- enddo
-
- else ! double precision version
-
-! calculate derivatives of the Lagrange polynomials
-! and precalculate some products in double precision
-! hprime(i,j) = h'_j(xigll_i) by definition of the derivation matrix
- do i1=1,NGLLX
- do i2=1,NGLLX
- hprime_xx(i2,i1) = lagrange_deriv_GLL(i1-1,i2-1,xigll,NGLLX)
- hprimewgll_xx(i2,i1) = lagrange_deriv_GLL(i1-1,i2-1,xigll,NGLLX)*wxgll(i2)
- enddo
- enddo
-
- do j1=1,NGLLY
- do j2=1,NGLLY
- hprime_yy(j2,j1) = lagrange_deriv_GLL(j1-1,j2-1,yigll,NGLLY)
- hprimewgll_yy(j2,j1) = lagrange_deriv_GLL(j1-1,j2-1,yigll,NGLLY)*wygll(j2)
- enddo
- enddo
-
- do k1=1,NGLLZ
- do k2=1,NGLLZ
- hprime_zz(k2,k1) = lagrange_deriv_GLL(k1-1,k2-1,zigll,NGLLZ)
- hprimewgll_zz(k2,k1) = lagrange_deriv_GLL(k1-1,k2-1,zigll,NGLLZ)*wzgll(k2)
- enddo
- enddo
-
- do i=1,NGLLX
- do j=1,NGLLY
- wgllwgll_xy(i,j) = wxgll(i)*wygll(j)
- enddo
- enddo
-
- do i=1,NGLLX
- do k=1,NGLLZ
- wgllwgll_xz(i,k) = wxgll(i)*wzgll(k)
- enddo
- enddo
-
- do j=1,NGLLY
- do k=1,NGLLZ
- wgllwgll_yz(j,k) = wygll(j)*wzgll(k)
- enddo
- enddo
-
- endif
-
- end subroutine define_derivation_matrices
-
Deleted: seismo/3D/SPECFEM3D/trunk/detect_mesh_surfaces.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/detect_mesh_surfaces.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/detect_mesh_surfaces.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,238 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! This program is free software; you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation; either version 2 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along
-! with this program; if not, write to the Free Software Foundation, Inc.,
-! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-!
-!=====================================================================
-!
-! United States and French Government Sponsorship Acknowledged.
-
- subroutine detect_mesh_surfaces()
-
- use specfem_par
- use specfem_par_movie
- use specfem_par_acoustic
- use specfem_par_elastic
- implicit none
-
- ! for mesh surface
- allocate(ispec_is_surface_external_mesh(NSPEC_AB))
- allocate(iglob_is_surface_external_mesh(NGLOB_AB))
-
-! determines model surface
- if (.not. RECVS_CAN_BE_BURIED_EXT_MESH .or. &
- EXTERNAL_MESH_MOVIE_SURFACE .or. EXTERNAL_MESH_CREATE_SHAKEMAP) then
-
- ! returns surface points/elements
- ! in ispec_is_surface_external_mesh / iglob_is_surface_external_mesh and
- ! number of faces in nfaces_surface_ext_mesh
- call detect_surface(NPROC,NGLOB_AB,NSPEC_AB,ibool,&
- ispec_is_surface_external_mesh, &
- iglob_is_surface_external_mesh, &
- nfaces_surface_ext_mesh, &
- num_interfaces_ext_mesh, &
- max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh, &
- ibool_interfaces_ext_mesh)
- endif
-
-! takes cross-section surfaces instead
- if( (EXTERNAL_MESH_MOVIE_SURFACE .or. EXTERNAL_MESH_CREATE_SHAKEMAP) &
- .and. PLOT_CROSS_SECTIONS ) then
- call detect_surface_cross_section(NPROC,NGLOB_AB,NSPEC_AB,ibool,&
- ispec_is_surface_external_mesh, &
- iglob_is_surface_external_mesh, &
- nfaces_surface_ext_mesh, &
- num_interfaces_ext_mesh, &
- max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh, &
- ibool_interfaces_ext_mesh,&
- CROSS_SECTION_X,CROSS_SECTION_Y,CROSS_SECTION_Z, &
- xstore,ystore,zstore,myrank)
- endif
-
-! takes number of faces for top, free surface only
- if( MOVIE_SURFACE .or. CREATE_SHAKEMAP ) then
- nfaces_surface_ext_mesh = num_free_surface_faces
- ! face corner indices
- iorderi(1) = 1
- iorderi(2) = NGLLX
- iorderi(3) = NGLLX
- iorderi(4) = 1
- iorderj(1) = 1
- iorderj(2) = 1
- iorderj(3) = NGLLY
- iorderj(4) = NGLLY
- endif
-
-! handles movies and shakemaps
- if( EXTERNAL_MESH_MOVIE_SURFACE .or. &
- EXTERNAL_MESH_CREATE_SHAKEMAP .or. &
- MOVIE_SURFACE .or. &
- CREATE_SHAKEMAP ) then
- call setup_movie_meshes()
- endif
-
-! stores wavefields for whole volume
- if (MOVIE_VOLUME) then
- ! acoustic
- if( ACOUSTIC_SIMULATION .or. ELASTIC_SIMULATION ) then
- allocate(velocity_x(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- allocate(velocity_y(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- allocate(velocity_z(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- endif
- ! elastic only
- if( ELASTIC_SIMULATION ) then
- allocate(div(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- allocate(curl_x(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- allocate(curl_y(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- allocate(curl_z(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
- div(:,:,:,:) = 0._CUSTOM_REAL
- curl_x(:,:,:,:) = 0._CUSTOM_REAL
- curl_y(:,:,:,:) = 0._CUSTOM_REAL
- curl_z(:,:,:,:) = 0._CUSTOM_REAL
- endif
- endif
-
-! initializes cross-section gif image
- if( PNM_GIF_IMAGE ) then
- call write_PNM_GIF_initialize()
- endif
-
-
-!!!! NL NL REGOLITH : runs at cines for asteroid simulations. Elements in contact with surface are part of the regolith layer.
-!!$ allocate(ispec_is_regolith(NSPEC_AB))
-!!$ ispec_is_regolith(:) = .false.
-!!$ do ispec = 1, NSPEC_AB
-!!$ do k = 1, NGLLZ
-!!$ do j = 1, NGLLY
-!!$ do i = 1, NGLLX
-!!$ iglob = ibool(i,j,k,ispec)
-!!$ if (iglob_is_surface_external_mesh(iglob)) then
-!!$ ispec_is_regolith(ispec) = .true.
-!!$ endif
-!!$ enddo
-!!$ enddo
-!!$ enddo
-!!$ enddo
-!!$
-!!$ do ispec = 1, NSPEC_AB
-!!$ if (ispec_is_regolith(ispec)) then
-!!$ do k = 1, NGLLZ
-!!$ do j = 1, NGLLY
-!!$ do i = 1, NGLLX
-!!$ kappastore(i,j,k,ispec) = materials_ext_mesh(1,2)* &
-!!$ (materials_ext_mesh(2,2)*materials_ext_mesh(2,2) - &
-!!$ 4.d0*materials_ext_mesh(3,2)*materials_ext_mesh(3,2)/3.d0)
-!!$ mustore(i,j,k,ispec) = materials_ext_mesh(1,2)*materials_ext_mesh(3,2)*&
-!!$ materials_ext_mesh(3,2)
-!!$
-!!$ enddo
-!!$ enddo
-!!$ enddo
-!!$ endif
-!!$ enddo
-!!$
-!!$
-!!$ call zwgljd(xigll,wxgll,NGLLX,GAUSSALPHA,GAUSSBETA)
-!!$ call zwgljd(yigll,wygll,NGLLY,GAUSSALPHA,GAUSSBETA)
-!!$ call zwgljd(zigll,wzgll,NGLLZ,GAUSSALPHA,GAUSSBETA)
-!!$
-!!$ rmass(:) = 0._CUSTOM_REAL
-!!$
-!!$ do ispec=1,NSPEC_AB
-!!$ do k=1,NGLLZ
-!!$ do j=1,NGLLY
-!!$ do i=1,NGLLX
-!!$ weight=wxgll(i)*wygll(j)*wzgll(k)
-!!$ iglob=ibool(i,j,k,ispec)
-!!$
-!!$ jacobianl=jacobian(i,j,k,ispec)
-!!$
-!!$! distinguish between single and double precision for reals
-!!$ if (.not. ispec_is_regolith(ispec)) then
-!!$ if(CUSTOM_REAL == SIZE_REAL) then
-!!$ rmass(iglob) = rmass(iglob) + &
-!!$ sngl(dble(materials_ext_mesh(1,1)) * dble(jacobianl) * weight)
-!!$ else
-!!$ rmass(iglob) = rmass(iglob) + materials_ext_mesh(1,1) * jacobianl * weight
-!!$ endif
-!!$ else
-!!$ if(CUSTOM_REAL == SIZE_REAL) then
-!!$ rmass(iglob) = rmass(iglob) + &
-!!$ sngl(dble(materials_ext_mesh(1,2)) * dble(jacobianl) * weight)
-!!$ else
-!!$ rmass(iglob) = rmass(iglob) + materials_ext_mesh(1,2) * jacobianl * weight
-!!$ endif
-!!$ endif
-!!$
-!!$ enddo
-!!$ enddo
-!!$ enddo
-!!$ enddo
-
-
-!!!! NL NL REGOLITH
-
-!!!!!!!!!! DK DK endif
-
- end subroutine detect_mesh_surfaces
-
-
-!!!! NL NL REGOLITH
-!!$ double precision function materials_ext_mesh(i,j)
-!!$
-!!$ implicit none
-!!$
-!!$ integer :: i,j
-!!$
-!!$ select case (j)
-!!$ case (1)
-!!$ select case (i)
-!!$ case (1)
-!!$ materials_ext_mesh = 2700.d0
-!!$ case (2)
-!!$ materials_ext_mesh = 3000.d0
-!!$ case (3)
-!!$ materials_ext_mesh = 1732.051d0
-!!$ case default
-!!$ call stop_all()
-!!$ end select
-!!$ case (2)
-!!$ select case (i)
-!!$ case (1)
-!!$ materials_ext_mesh = 2000.d0
-!!$ case (2)
-!!$ materials_ext_mesh = 900.d0
-!!$ case (3)
-!!$ materials_ext_mesh = 500.d0
-!!$ case default
-!!$ call stop_all()
-!!$ end select
-!!$ case default
-!!$ call stop_all()
-!!$ end select
-!!$
-!!$ end function materials_ext_mesh
-!!!! NL NL REGOLITH
-
Deleted: seismo/3D/SPECFEM3D/trunk/detect_surface.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/detect_surface.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/detect_surface.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,681 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine detect_surface(NPROC,nglob,nspec,ibool,&
- ispec_is_surface_external_mesh, &
- iglob_is_surface_external_mesh, &
- nfaces_surface_ext_mesh, &
- num_interfaces_ext_mesh, &
- max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh, &
- ibool_interfaces_ext_mesh)
-
-! detects surface (points/elements) of model based upon valence
-!
-! returns: ispec_is_surface_external_mesh, iglob_is_surface_external_mesh
-! and nfaces_surface_ext_mesh
-
- implicit none
-
- include "constants.h"
-
-! global indexing
- integer :: NPROC,nglob,nspec
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec):: ibool
-
-! surface
- logical, dimension(nspec) :: ispec_is_surface_external_mesh
- logical, dimension(nglob) :: iglob_is_surface_external_mesh
- integer :: nfaces_surface_ext_mesh
-
-! MPI partitions
- integer :: num_interfaces_ext_mesh
- integer :: max_nibool_interfaces_ext_mesh
- integer,dimension(num_interfaces_ext_mesh):: nibool_interfaces_ext_mesh
- integer,dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh):: ibool_interfaces_ext_mesh
- integer,dimension(num_interfaces_ext_mesh) :: my_neighbours_ext_mesh
-
-!local parameters
- integer, dimension(:), allocatable :: valence_external_mesh
- integer :: ispec,i,j,k,ii,jj,kk,iglob,ier
-
-! detecting surface points/elements (based on valence check on NGLL points) for external mesh
- allocate(valence_external_mesh(nglob),stat=ier)
- if( ier /= 0 ) stop 'error allocate valence array'
-
-! initialize surface indices
- ispec_is_surface_external_mesh(:) = .false.
- iglob_is_surface_external_mesh(:) = .false.
- valence_external_mesh(:) = 0
-
- do ispec = 1, nspec
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
- iglob = ibool(i,j,k,ispec)
- if( iglob < 1 .or. iglob > nglob) then
- print*,'error valence iglob:',iglob,i,j,k,ispec
- stop 'error valence'
- endif
- valence_external_mesh(iglob) = valence_external_mesh(iglob) + 1
- enddo
- enddo
- enddo
- enddo
-
- ! adds contributions from different partitions to valence_external_mesh
- call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,valence_external_mesh, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh)
-
-! determines spectral elements containing surface points
- do ispec = 1, nspec
-
- ! loops over GLL points not on edges or corners
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
- if ( &
- (k == 1 .or. k == NGLLZ) .and. (j /= 1 .and. j /= NGLLY) .and. (i /= 1 .and. i /= NGLLX) .or. &
- (j == 1 .or. j == NGLLY) .and. (k /= 1 .and. k /= NGLLZ) .and. (i /= 1 .and. i /= NGLLX) .or. &
- (i == 1 .or. i == NGLLX) .and. (k /= 1 .and. k /= NGLLZ) .and. (j /= 1 .and. j /= NGLLY) &
- ) then
- iglob = ibool(i,j,k,ispec)
- if (valence_external_mesh(iglob) == 1) then
- ispec_is_surface_external_mesh(ispec) = .true.
-
- ! sets flags for all gll points on this face
- if (k == 1 .or. k == NGLLZ) then
- do jj = 1, NGLLY
- do ii = 1, NGLLX
- iglob_is_surface_external_mesh(ibool(ii,jj,k,ispec)) = .true.
- enddo
- enddo
- endif
- if (j == 1 .or. j == NGLLY) then
- do kk = 1, NGLLZ
- do ii = 1, NGLLX
- iglob_is_surface_external_mesh(ibool(ii,j,kk,ispec)) = .true.
- enddo
- enddo
- endif
- if (i == 1 .or. i == NGLLX) then
- do kk = 1, NGLLZ
- do jj = 1, NGLLY
- iglob_is_surface_external_mesh(ibool(i,jj,kk,ispec)) = .true.
- enddo
- enddo
- endif
- endif
-
- endif
- enddo
- enddo
- enddo
-
- enddo ! nspec
-
-! counts faces for external-mesh movies and shakemaps
- nfaces_surface_ext_mesh = 0
- do ispec = 1, nspec
- iglob = ibool(2,2,1,ispec)
- if (iglob_is_surface_external_mesh(iglob)) then
- nfaces_surface_ext_mesh = nfaces_surface_ext_mesh + 1
- endif
- iglob = ibool(2,2,NGLLZ,ispec)
- if (iglob_is_surface_external_mesh(iglob)) then
- nfaces_surface_ext_mesh = nfaces_surface_ext_mesh + 1
- endif
- iglob = ibool(2,1,2,ispec)
- if (iglob_is_surface_external_mesh(iglob)) then
- nfaces_surface_ext_mesh = nfaces_surface_ext_mesh + 1
- endif
- iglob = ibool(2,NGLLY,2,ispec)
- if (iglob_is_surface_external_mesh(iglob)) then
- nfaces_surface_ext_mesh = nfaces_surface_ext_mesh + 1
- endif
- iglob = ibool(1,2,2,ispec)
- if (iglob_is_surface_external_mesh(iglob)) then
- nfaces_surface_ext_mesh = nfaces_surface_ext_mesh + 1
- endif
- iglob = ibool(NGLLX,2,2,ispec)
- if (iglob_is_surface_external_mesh(iglob)) then
- nfaces_surface_ext_mesh = nfaces_surface_ext_mesh + 1
- endif
- enddo
-
- end subroutine detect_surface
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine detect_surface_cross_section(NPROC,nglob,nspec,ibool,&
- ispec_is_surface_external_mesh, &
- iglob_is_surface_external_mesh, &
- nfaces_surface_ext_mesh, &
- num_interfaces_ext_mesh, &
- max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh, &
- ibool_interfaces_ext_mesh,&
- x_section,y_section,z_section, &
- xstore,ystore,zstore,myrank)
-
-! instead of surface of model, this returns cross-section surfaces through model
-! at specified x,y,z - coordinates
-!
-! note: x,y,z coordinates must coincide with the element (outer-)faces, no planes inside elements are taken
-! (this is only a quick & dirty cross-section implementation, no sophisticated interpolation of points considered...)
-!
-! returns: ispec_is_surface_external_mesh, iglob_is_surface_external_mesh
-! and nfaces_surface_ext_mesh
-
- implicit none
-
- include "constants.h"
-
-! global indexing
- integer :: NPROC,nglob,nspec,myrank
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec):: ibool
-
-! surface
- logical, dimension(nspec) :: ispec_is_surface_external_mesh
- logical, dimension(nglob) :: iglob_is_surface_external_mesh
- integer :: nfaces_surface_ext_mesh
-
-! MPI partitions
- integer :: num_interfaces_ext_mesh
- integer :: max_nibool_interfaces_ext_mesh
- integer,dimension(num_interfaces_ext_mesh):: nibool_interfaces_ext_mesh
- integer,dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh):: ibool_interfaces_ext_mesh
- integer,dimension(num_interfaces_ext_mesh) :: my_neighbours_ext_mesh
-
-! specified x,y,z - coordinates
- real(kind=CUSTOM_REAL):: x_section,y_section,z_section
-
-! mesh global point coordinates
- real(kind=CUSTOM_REAL), dimension(nglob) :: xstore,ystore,zstore
-
-!local parameters
- real(kind=CUSTOM_REAL),dimension(6) :: midpoint_faces_x,midpoint_faces_y, &
- midpoint_faces_z
- real(kind=CUSTOM_REAL),dimension(6) :: midpoint_dist_x,midpoint_dist_y,midpoint_dist_z
- real(kind=CUSTOM_REAL),dimension(NGNOD2D) :: xcoord_face,ycoord_face,zcoord_face
- real(kind=CUSTOM_REAL) :: mindist,normal(NDIM)
- integer, dimension(:), allocatable :: valence_external_mesh
- integer,dimension(3,NGLLX,NGLLX) :: face_ijk
- integer :: ispec,i,j,k,ii,jj,kk,iglob,ier,count
- integer :: iface,icorner
- logical, dimension(:),allocatable :: ispec_has_points
- logical :: has_face
- ! corners indices of reference cube faces
- integer,dimension(3,4),parameter :: iface1_corner_ijk = &
- reshape((/ 1,1,1, 1,NGLLY,1, 1,NGLLY,NGLLZ, 1,1,NGLLZ /),(/3,4/)) ! xmin
- integer,dimension(3,4),parameter :: iface2_corner_ijk = &
- reshape((/ NGLLX,1,1, NGLLX,NGLLY,1, NGLLX,NGLLY,NGLLZ, NGLLX,1,NGLLZ /),(/3,4/)) !xmax
- integer,dimension(3,4),parameter :: iface3_corner_ijk = &
- reshape((/ 1,1,1, 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,1,1 /),(/3,4/)) !ymin
- integer,dimension(3,4),parameter :: iface4_corner_ijk = &
- reshape((/ 1,NGLLY,1, NGLLX,NGLLY,1, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),(/3,4/)) ! ymax
- integer,dimension(3,4),parameter :: iface5_corner_ijk = &
- reshape((/ 1,1,1, 1,NGLLY,1, NGLLX,NGLLY,1, NGLLX,1,1 /),(/3,4/)) ! bottom
- integer,dimension(3,4),parameter :: iface6_corner_ijk = &
- reshape((/ 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),(/3,4/)) !top
- integer,dimension(3,4,6),parameter :: iface_all_corner_ijk = &
- reshape((/ iface1_corner_ijk,iface2_corner_ijk, &
- iface3_corner_ijk,iface4_corner_ijk, &
- iface5_corner_ijk,iface6_corner_ijk /),(/3,4,6/)) ! all faces
- integer,dimension(3,6),parameter :: iface_midpoint_ijk = &
- reshape( (/ 1,3,3, NGLLX,3,3, 3,1,3, 3,NGLLY,3, 3,3,1, 3,3,NGLLZ /),(/3,6/)) ! top
-
-! detecting surface points/elements (based on valence check on NGLL points) for external mesh
- allocate(valence_external_mesh(nglob),ispec_has_points(nspec),stat=ier)
- if( ier /= 0 ) stop 'error allocate valence array'
-
-! an estimation of the minimum distance between global points (for an element width)
- mindist = minval( (xstore(ibool(1,3,3,:)) - xstore(ibool(NGLLX,3,3,:)))**2 &
- + (ystore(ibool(1,3,3,:)) - ystore(ibool(NGLLX,3,3,:)))**2 &
- + (zstore(ibool(1,3,3,:)) - zstore(ibool(NGLLX,3,3,:)))**2 )
- mindist = sqrt(mindist)
-
-! initialize surface indices
- ispec_is_surface_external_mesh(:) = .false.
- iglob_is_surface_external_mesh(:) = .false.
- nfaces_surface_ext_mesh = 0
- valence_external_mesh(:) = 0
-
-! sets valence value to one corresponding to process rank for points on cross-sections
- do ispec = 1, nspec
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
- iglob = ibool(i,j,k,ispec)
-
- ! x cross-section
- if( abs( xstore(iglob) - x_section ) < 0.2*mindist ) then
- ! sets valence to 1 for points on cross-sections
- valence_external_mesh(iglob) = myrank+1
- endif
-
- ! y cross-section
- if( abs( ystore(iglob) - y_section ) < 0.2*mindist ) then
- ! sets valence to 1 for points on cross-sections
- valence_external_mesh(iglob) = myrank+1
- endif
-
- ! z cross-section
- if( abs( zstore(iglob) - z_section ) < 0.2*mindist ) then
- ! sets valence to 1 for points on cross-sections
- valence_external_mesh(iglob) = myrank+1
- endif
-
- enddo
- enddo
- enddo
- enddo
-
-! adds contributions from different partitions to valence_external_mesh
- call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,valence_external_mesh, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh)
-
-
-! determines spectral elements containing surface points
-! (only counts element outer faces, no planes inside element)
- ispec_has_points(:) = .false.
- count = 0
- do ispec = 1, nspec
-
- ! loops over GLL points not on edges or corners, but inside faces
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
-
- iglob = ibool(i,j,k,ispec)
-
- ! sets flag if element has points
- if( valence_external_mesh(iglob) > 0 ) ispec_has_points(ispec) = .true.
-
- ! checks element surfaces for valence points
- if ( ((k == 1 .or. k == NGLLZ) .and. (j == 2 .and. i == 2)) .or. &
- ((j == 1 .or. j == NGLLY) .and. (k == 2 .and. i == 2)) .or. &
- ((i == 1 .or. i == NGLLX) .and. (k == 2 .and. j == 2)) ) then
-
- iglob = ibool(i,j,k,ispec)
-
- ! considers only points in same process or, if point is shared between two processes,
- ! only with higher process ranks than itself
- if (valence_external_mesh(iglob) == myrank+1 .or. valence_external_mesh(iglob) > 2*(myrank+1) ) then
-
- has_face = .false.
-
-
- ! sets flags for all gll points on a face and makes sure it's not inside the element
- ! zmin & zmax face
- if ((k == 1 .or. k == NGLLZ) .and. valence_external_mesh(ibool(3,3,k,ispec)) >= 1 ) then
- has_face = .true.
- do jj = 1, NGLLY
- do ii = 1, NGLLX
- iglob_is_surface_external_mesh(ibool(ii,jj,k,ispec)) = .true.
- ! resets valence to count face only once
- valence_external_mesh(ibool(ii,jj,k,ispec)) = -1
- enddo
- enddo
- endif
-
- ! ymin & ymax
- if ((j == 1 .or. j == NGLLY) .and. valence_external_mesh(ibool(3,j,3,ispec)) >= 1) then
- has_face = .true.
- do kk = 1, NGLLZ
- do ii = 1, NGLLX
- iglob_is_surface_external_mesh(ibool(ii,j,kk,ispec)) = .true.
- ! resets valence to count face only once
- valence_external_mesh(ibool(ii,j,kk,ispec)) = -1
- enddo
- enddo
- endif
-
- ! xmin & xmax
- if ((i == 1 .or. i == NGLLX) .and. valence_external_mesh(ibool(i,3,3,ispec)) >= 1) then
- has_face = .true.
- do kk = 1, NGLLZ
- do jj = 1, NGLLY
- iglob_is_surface_external_mesh(ibool(i,jj,kk,ispec)) = .true.
- ! resets valence to count face only once
- valence_external_mesh(ibool(i,jj,kk,ispec)) = -1
- enddo
- enddo
- endif
-
-
- ! sets flag for element
- if( has_face ) then
- ispec_is_surface_external_mesh(ispec) = .true.
- count = count+1
- endif
-
- endif
- endif
- enddo
- enddo
- enddo
-
- enddo ! nspec
-
-
-! tries to find closest face if points are inside
- do ispec = 1,nspec
- ! checks if already assigned
- !if( ispec_is_surface_external_mesh(ispec) ) cycle
-
- ! in case element has still unresolved points in interior,
- ! we take closest element face to cross-section plane
- if( ispec_has_points(ispec) ) then
-
- ! an estimation of the element width
- mindist = sqrt((xstore(ibool(1,3,3,ispec)) - xstore(ibool(NGLLX,3,3,ispec)))**2 &
- + (ystore(ibool(1,3,3,ispec)) - ystore(ibool(NGLLX,3,3,ispec)))**2 &
- + (zstore(ibool(1,3,3,ispec)) - zstore(ibool(NGLLX,3,3,ispec)))**2 )
-
- ! determines element face by minimum distance of midpoints
- midpoint_faces_x(:) = 0.0
- midpoint_faces_y(:) = 0.0
- midpoint_faces_z(:) = 0.0
- do iface=1,6
- ! face corners
- do icorner = 1,NGNOD2D
- i = iface_all_corner_ijk(1,icorner,iface)
- j = iface_all_corner_ijk(2,icorner,iface)
- k = iface_all_corner_ijk(3,icorner,iface)
-
- ! coordinates
- iglob = ibool(i,j,k,ispec)
- xcoord_face(icorner) = xstore(iglob)
- ycoord_face(icorner) = ystore(iglob)
- zcoord_face(icorner) = zstore(iglob)
-
- ! face midpoint coordinates
- midpoint_faces_x(iface) = midpoint_faces_x(iface) + xcoord_face(icorner)
- midpoint_faces_y(iface) = midpoint_faces_y(iface) + ycoord_face(icorner)
- midpoint_faces_z(iface) = midpoint_faces_z(iface) + zcoord_face(icorner)
-
- enddo
- midpoint_faces_x(iface) = midpoint_faces_x(iface) / 4.0
- midpoint_faces_y(iface) = midpoint_faces_y(iface) / 4.0
- midpoint_faces_z(iface) = midpoint_faces_z(iface) / 4.0
-
- ! gets face normal
- normal(:) = 0._CUSTOM_REAL
- call get_element_face_normal(ispec,iface,xcoord_face,ycoord_face,zcoord_face,&
- ibool,nspec,nglob,xstore,ystore,zstore,&
- normal)
-
- ! distance to cross-section planes
- midpoint_dist_x(iface) = abs(midpoint_faces_x(iface) - x_section)
- midpoint_dist_y(iface) = abs(midpoint_faces_y(iface) - y_section)
- midpoint_dist_z(iface) = abs(midpoint_faces_z(iface) - z_section)
-
-
- ! x cross-section plane
- !minface = minloc(midpoint_dist_x)
- !iface = minface(1)
- i = iface_midpoint_ijk(1,iface)
- j = iface_midpoint_ijk(2,iface)
- k = iface_midpoint_ijk(3,iface)
- if( midpoint_dist_x(iface) < 0.5*mindist .and. &
- valence_external_mesh(ibool(i,j,k,ispec)) /= -1 ) then
- ! checks face normal points in similar direction as cross-section normal
- if( abs(normal(1)) > 0.6 ) then
- call get_element_face_gll_indices(iface,face_ijk,NGLLX,NGLLX)
- do jj = 1, NGLLY
- do ii = 1, NGLLX
- i = face_ijk(1,ii,jj)
- j = face_ijk(2,ii,jj)
- k = face_ijk(3,ii,jj)
- ! sets iglob flag on face points
- iglob_is_surface_external_mesh(ibool(i,j,k,ispec)) = .true.
- ! sets ispec flag
- ispec_is_surface_external_mesh(ispec) = .true.
- ! resets valence
- valence_external_mesh(ibool(i,j,k,ispec)) = -1
- enddo
- enddo
- endif
- endif
-
- ! y cross-section plane
- !minface = minloc(midpoint_dist_y)
- !iface = minface(1)
- i = iface_midpoint_ijk(1,iface)
- j = iface_midpoint_ijk(2,iface)
- k = iface_midpoint_ijk(3,iface)
- if( midpoint_dist_y(iface) < 0.5*mindist .and. &
- valence_external_mesh(ibool(i,j,k,ispec)) /= -1) then
- ! checks face normal points in similar direction as cross-section normal
- if( abs(normal(2)) > 0.6 ) then
- call get_element_face_gll_indices(iface,face_ijk,NGLLX,NGLLX)
- do jj = 1, NGLLY
- do ii = 1, NGLLX
- i = face_ijk(1,ii,jj)
- j = face_ijk(2,ii,jj)
- k = face_ijk(3,ii,jj)
- ! sets iglob flag on face points
- iglob_is_surface_external_mesh(ibool(i,j,k,ispec)) = .true.
- ! sets ispec flag
- ispec_is_surface_external_mesh(ispec) = .true.
- ! resets valence
- valence_external_mesh(ibool(i,j,k,ispec)) = -1
- enddo
- enddo
- endif
- endif
-
- ! z cross-section plane
- !minface = minloc(midpoint_dist_z)
- !iface = minface(1)
- i = iface_midpoint_ijk(1,iface)
- j = iface_midpoint_ijk(2,iface)
- k = iface_midpoint_ijk(3,iface)
- if( midpoint_dist_z(iface) < 0.5*mindist .and. &
- valence_external_mesh(ibool(i,j,k,ispec)) /= -1) then
- ! checks face normal points in similar direction as cross-section normal
- if( abs(normal(3)) > 0.6 ) then
- call get_element_face_gll_indices(iface,face_ijk,NGLLX,NGLLX)
- do jj = 1, NGLLY
- do ii = 1, NGLLX
- i = face_ijk(1,ii,jj)
- j = face_ijk(2,ii,jj)
- k = face_ijk(3,ii,jj)
- ! sets iglob flag on face points
- iglob_is_surface_external_mesh(ibool(i,j,k,ispec)) = .true.
- ! sets ispec flag
- ispec_is_surface_external_mesh(ispec) = .true.
- ! resets valence
- valence_external_mesh(ibool(i,j,k,ispec)) = -1
- enddo
- enddo
- endif
- endif
-
- enddo ! iface
-
- endif
- enddo
-
-! counts faces for external-mesh movies and shakemaps
- nfaces_surface_ext_mesh = 0
- do ispec = 1, nspec
- if( ispec_is_surface_external_mesh(ispec) ) then
- ! zmin face
- if (iglob_is_surface_external_mesh(ibool(2,2,1,ispec))) then
- nfaces_surface_ext_mesh = nfaces_surface_ext_mesh + 1
- endif
- ! zmax
- if (iglob_is_surface_external_mesh(ibool(2,2,NGLLZ,ispec))) then
- nfaces_surface_ext_mesh = nfaces_surface_ext_mesh + 1
- endif
- ! ymin
- if (iglob_is_surface_external_mesh(ibool(2,1,2,ispec))) then
- nfaces_surface_ext_mesh = nfaces_surface_ext_mesh + 1
- endif
- ! ymax
- if (iglob_is_surface_external_mesh(ibool(2,NGLLY,2,ispec))) then
- nfaces_surface_ext_mesh = nfaces_surface_ext_mesh + 1
- endif
- !xmin
- if (iglob_is_surface_external_mesh(ibool(1,2,2,ispec))) then
- nfaces_surface_ext_mesh = nfaces_surface_ext_mesh + 1
- endif
- !xmax
- if (iglob_is_surface_external_mesh(ibool(NGLLX,2,2,ispec))) then
- nfaces_surface_ext_mesh = nfaces_surface_ext_mesh + 1
- endif
- endif
- enddo
-
- end subroutine detect_surface_cross_section
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine detect_surface_PNM_GIF_image(NPROC,nglob,nspec,ibool,&
- ispec_is_image_surface, &
- iglob_is_image_surface, &
- num_iglob_image_surface, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,my_neighbours_ext_mesh, &
- ibool_interfaces_ext_mesh,&
- section_xorg,section_yorg,section_zorg,&
- section_nx,section_ny,section_nz,&
- xstore,ystore,zstore,myrank)
-
-! this returns points on a cross-section surface through model
-!
-! returns: ispec_is_image_surface, iglob_is_image_surface & num_iglob_image_surface
-
- implicit none
-
- include "constants.h"
-
-! global indexing
- integer :: NPROC,nglob,nspec,myrank
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec):: ibool
-
-! surface
- logical, dimension(nspec) :: ispec_is_image_surface
- logical, dimension(nglob) :: iglob_is_image_surface
- integer :: num_iglob_image_surface
-
-! MPI partitions
- integer :: num_interfaces_ext_mesh
- integer :: max_nibool_interfaces_ext_mesh
- integer,dimension(num_interfaces_ext_mesh):: nibool_interfaces_ext_mesh
- integer,dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh):: ibool_interfaces_ext_mesh
- integer,dimension(num_interfaces_ext_mesh) :: my_neighbours_ext_mesh
-
-! specified x,y,z - coordinates of cross-section origin and normal to cross-section
- real(kind=CUSTOM_REAL):: section_xorg,section_yorg,section_zorg
- real(kind=CUSTOM_REAL):: section_nx,section_ny,section_nz
-
-! mesh global point coordinates
- real(kind=CUSTOM_REAL), dimension(nglob) :: xstore,ystore,zstore
-
-!local parameters
- real(kind=CUSTOM_REAL) :: mindist
- integer, dimension(:), allocatable :: valence_external_mesh
- integer :: ispec,i,j,k,iglob,ier,count
-
-! detecting surface points/elements (based on valence check on NGLL points) for external mesh
- allocate(valence_external_mesh(nglob),stat=ier)
- if( ier /= 0 ) stop 'error allocate valence array'
-
-! initialize surface indices
- ispec_is_image_surface(:) = .false.
- iglob_is_image_surface(:) = .false.
- valence_external_mesh(:) = 0
- num_iglob_image_surface = 0
-
-! an estimation of the minimum distance between global points
- mindist = minval( (xstore(ibool(1,1,1,:)) - xstore(ibool(2,1,1,:)))**2 &
- + (ystore(ibool(1,1,1,:)) - ystore(ibool(2,1,1,:)))**2 &
- + (zstore(ibool(1,1,1,:)) - zstore(ibool(2,1,1,:)))**2 )
- mindist = sqrt(mindist)
-
-! sets valence value to one corresponding to process rank for points on cross-sections
- do ispec = 1, nspec
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
- iglob = ibool(i,j,k,ispec)
-
- ! chooses points close to cross-section
- if( abs((xstore(iglob)-section_xorg)*section_nx + (ystore(iglob)-section_yorg)*section_ny &
- + (zstore(iglob)-section_zorg)*section_nz ) < 0.8*mindist ) then
- ! sets valence to 1 for points on cross-sections
- valence_external_mesh(iglob) = myrank+1
- endif
- enddo
- enddo
- enddo
- enddo
-
-! adds contributions from different partitions to valence_external_mesh
- call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,valence_external_mesh, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh)
-
-
-! determines spectral elements containing points on surface
- count = 0
- do ispec = 1, nspec
- ! loops over GLL points not on edges or corners, but inside faces
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
- iglob = ibool(i,j,k,ispec)
- ! considers only points in same process or, if point is shared between two processes,
- ! only with higher process ranks than itself
- if (valence_external_mesh(iglob) == myrank+1 .or. valence_external_mesh(iglob) > 2*(myrank+1) ) then
- if( iglob_is_image_surface(iglob) .eqv. .false. ) count = count+1
- iglob_is_image_surface(iglob) = .true.
- ispec_is_image_surface(ispec) = .true.
- endif
- enddo
- enddo
- enddo
- enddo ! nspec
- num_iglob_image_surface = count
-
- end subroutine detect_surface_PNM_GIF_image
-
-
-
-
\ No newline at end of file
Copied: seismo/3D/SPECFEM3D/trunk/doc/LICENSE (from rev 17270, seismo/3D/SPECFEM3D/trunk/LICENSE)
===================================================================
--- seismo/3D/SPECFEM3D/trunk/doc/LICENSE (rev 0)
+++ seismo/3D/SPECFEM3D/trunk/doc/LICENSE 2010-10-20 12:16:18 UTC (rev 17293)
@@ -0,0 +1,339 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Lesser General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ 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.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.
Copied: seismo/3D/SPECFEM3D/trunk/doc/USER_MANUAL (from rev 17270, seismo/3D/SPECFEM3D/trunk/USER_MANUAL)
Copied: seismo/3D/SPECFEM3D/trunk/examples (from rev 17270, seismo/3D/SPECFEM3D/trunk/EXAMPLES)
Deleted: seismo/3D/SPECFEM3D/trunk/exit_mpi.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/exit_mpi.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/exit_mpi.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,82 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-! end the simulation and exit MPI
-
- subroutine exit_MPI(myrank,error_msg)
-
- implicit none
-
- include "constants.h"
-
-! identifier for error message file
- integer, parameter :: IERROR = 30
-
- integer myrank
- character(len=*) error_msg
-
- character(len=80) outputname
- character(len=256) OUTPUT_FILES
-
-! write error message to screen
- write(*,*) error_msg(1:len(error_msg))
- write(*,*) 'Error detected, aborting MPI... proc ',myrank
-
-! write error message to file
- call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
- write(outputname,"('/error_message',i6.6,'.txt')") myrank
- open(unit=IERROR,file=trim(OUTPUT_FILES)//outputname,status='unknown')
- write(IERROR,*) error_msg(1:len(error_msg))
- write(IERROR,*) 'Error detected, aborting MPI... proc ',myrank
- close(IERROR)
-
-! close output file
- if(myrank == 0 .and. IMAIN /= ISTANDARD_OUTPUT) close(IMAIN)
-
- call stop_all()
-
- end subroutine exit_MPI
-
-!
-!----
-!
-
-! version without rank number printed in the error message
- subroutine exit_MPI_without_rank(error_msg)
-
- implicit none
-
- include "constants.h"
-
- character(len=*) error_msg
-
-! write error message to screen
- write(*,*) error_msg(1:len(error_msg))
- write(*,*) 'Error detected, aborting MPI...'
-
- call stop_all()
-
- end subroutine exit_MPI_without_rank
-
Deleted: seismo/3D/SPECFEM3D/trunk/finalize_simulation.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/finalize_simulation.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/finalize_simulation.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,142 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! This program is free software; you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation; either version 2 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along
-! with this program; if not, write to the Free Software Foundation, Inc.,
-! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-!
-!=====================================================================
-!
-! United States and French Government Sponsorship Acknowledged.
-
- subroutine finalize_simulation()
-
- use specfem_par
- use specfem_par_elastic
- use specfem_par_acoustic
-
- implicit none
-
- integer :: irec_local
-
-! save last frame
-
- if (SIMULATION_TYPE == 1 .and. SAVE_FORWARD) then
- open(unit=27,file=prname(1:len_trim(prname))//'save_forward_arrays.bin',&
- status='unknown',form='unformatted')
-
- if( ACOUSTIC_SIMULATION ) then
- write(27) potential_acoustic
- write(27) potential_dot_acoustic
- write(27) potential_dot_dot_acoustic
- endif
-
- if( ELASTIC_SIMULATION ) then
- write(27) displ
- write(27) veloc
- write(27) accel
-
- if (ATTENUATION) then
- write(27) R_xx
- write(27) R_yy
- write(27) R_xy
- write(27) R_xz
- write(27) R_yz
- write(27) epsilondev_xx
- write(27) epsilondev_yy
- write(27) epsilondev_xy
- write(27) epsilondev_xz
- write(27) epsilondev_yz
- endif
- endif
-
- close(27)
-
-! adjoint simulations
- else if (SIMULATION_TYPE == 3) then
-
- ! adjoint kernels
- call save_adjoint_kernels()
-
- endif
-
-! closing source time function file
- if(PRINT_SOURCE_TIME_FUNCTION .and. myrank == 0) then
- close(IOSTF)
- endif
-
-! stacey absorbing fields will be reconstructed for adjoint simulations
-! using snapshot files of wavefields
- if( ABSORBING_CONDITIONS ) then
- ! closes absorbing wavefield saved/to-be-saved by forward simulations
- if( num_abs_boundary_faces > 0 .and. (SIMULATION_TYPE == 3 .or. &
- (SIMULATION_TYPE == 1 .and. SAVE_FORWARD)) ) then
-
- if( ELASTIC_SIMULATION) close(IOABS)
- if( ACOUSTIC_SIMULATION) close(IOABS_AC)
-
- endif
- endif
-
-! seismograms and source parameter gradients for (pure type=2) adjoint simulation runs
- if (nrec_local > 0) then
- if (.not. (SIMULATION_TYPE == 1 .or. SIMULATION_TYPE == 3)) then
- ! seismograms
- call write_adj_seismograms2_to_file(myrank,seismograms_eps,number_receiver_global, &
- nrec_local,it,DT,NSTEP,t0,LOCAL_PATH)
-
- ! source gradients (for sources in elastic domains)
- do irec_local = 1, nrec_local
- write(outputname,'(a,i5.5)') 'OUTPUT_FILES/src_frechet.',number_receiver_global(irec_local)
- open(unit=27,file=trim(outputname),status='unknown')
- !
- ! r -> z, theta -> -y, phi -> x
- !
- ! Mrr = Mzz
- ! Mtt = Myy
- ! Mpp = Mxx
- ! Mrt = -Myz
- ! Mrp = Mxz
- ! Mtp = -Mxy
- write(27,*) Mzz_der(irec_local)
- write(27,*) Myy_der(irec_local)
- write(27,*) Mxx_der(irec_local)
- write(27,*) -Myz_der(irec_local)
- write(27,*) Mxz_der(irec_local)
- write(27,*) -Mxy_der(irec_local)
- write(27,*) sloc_der(1,irec_local)
- write(27,*) sloc_der(2,irec_local)
- write(27,*) sloc_der(3,irec_local)
- close(27)
- enddo
- endif
- endif
-
-! close the main output file
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) 'End of the simulation'
- write(IMAIN,*)
- close(IMAIN)
- endif
-
-! synchronize all the processes to make sure everybody has finished
- call sync_all()
-
- end subroutine finalize_simulation
Deleted: seismo/3D/SPECFEM3D/trunk/generate_databases.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/generate_databases.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/generate_databases.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,966 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! This program is free software; you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation; either version 2 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along
-! with this program; if not, write to the Free Software Foundation, Inc.,
-! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-!
-!=====================================================================
-!
-! United States and French Government Sponsorship Acknowledged.
-!
-!=============================================================================!
-! !
-! generate_databases produces a spectral element grid !
-! for a local or regional model. !
-! The mesher uses the UTM projection !
-! !
-!=============================================================================!
-!
-! If you use this code for your own research, please cite at least one article
-! written by the developers of the package, for instance:
-!
-! @ARTICLE{TrKoLi08,
-! author = {Jeroen Tromp and Dimitri Komatitsch and Qinya Liu},
-! title = {Spectral-Element and Adjoint Methods in Seismology},
-! journal = {Communications in Computational Physics},
-! year = {2008},
-! volume = {3},
-! pages = {1-32},
-! number = {1}}
-!
-! or
-!
-! @ARTICLE{LiPoKoTr04,
-! author = {Qinya Liu and Jascha Polet and Dimitri Komatitsch and Jeroen Tromp},
-! title = {Spectral-element moment tensor inversions for earthquakes in {S}outhern {C}alifornia},
-! journal={Bull. Seismol. Soc. Am.},
-! year = {2004},
-! volume = {94},
-! pages = {1748-1761},
-! number = {5},
-! doi = {10.1785/012004038}}
-!
-! @INCOLLECTION{ChKoViCaVaFe07,
-! author = {Emmanuel Chaljub and Dimitri Komatitsch and Jean-Pierre Vilotte and
-! Yann Capdeville and Bernard Valette and Gaetano Festa},
-! title = {Spectral Element Analysis in Seismology},
-! booktitle = {Advances in Wave Propagation in Heterogeneous Media},
-! publisher = {Elsevier - Academic Press},
-! year = {2007},
-! editor = {Ru-Shan Wu and Val\'erie Maupin},
-! volume = {48},
-! series = {Advances in Geophysics},
-! pages = {365-419}}
-!
-! @ARTICLE{KoVi98,
-! author={D. Komatitsch and J. P. Vilotte},
-! title={The spectral-element method: an efficient tool to simulate the seismic response of 2{D} and 3{D} geological structures},
-! journal={Bull. Seismol. Soc. Am.},
-! year=1998,
-! volume=88,
-! number=2,
-! pages={368-392}}
-!
-! @ARTICLE{KoTr99,
-! author={D. Komatitsch and J. Tromp},
-! year=1999,
-! title={Introduction to the spectral-element method for 3-{D} seismic wave propagation},
-! journal={Geophys. J. Int.},
-! volume=139,
-! number=3,
-! pages={806-822},
-! doi={10.1046/j.1365-246x.1999.00967.x}}
-!
-! @ARTICLE{KoLiTrSuStSh04,
-! author={Dimitri Komatitsch and Qinya Liu and Jeroen Tromp and Peter S\"{u}ss
-! and Christiane Stidham and John H. Shaw},
-! year=2004,
-! title={Simulations of Ground Motion in the {L}os {A}ngeles {B}asin
-! based upon the Spectral-Element Method},
-! journal={Bull. Seism. Soc. Am.},
-! volume=94,
-! number=1,
-! pages={187-206}}
-!
-! and/or another article from http://web.univ-pau.fr/~dkomati1/publications.html
-!
-!
-! If you use the kernel capabilities of the code, please cite at least one article
-! written by the developers of the package, for instance:
-!
-! @ARTICLE{TrKoLi08,
-! author = {Jeroen Tromp and Dimitri Komatitsch and Qinya Liu},
-! title = {Spectral-Element and Adjoint Methods in Seismology},
-! journal = {Communications in Computational Physics},
-! year = {2008},
-! volume = {3},
-! pages = {1-32},
-! number = {1}}
-!
-! or
-!
-! @ARTICLE{LiTr06,
-! author={Qinya Liu and Jeroen Tromp},
-! title={Finite-frequency kernels based on adjoint methods},
-! journal={Bull. Seismol. Soc. Am.},
-! year=2006,
-! volume=96,
-! number=6,
-! pages={2383-2397},
-! doi={10.1785/0120060041}}
-!
-!
-! Reference frame - convention:
-! ----------------------------
-!
-! The code uses the following convention for the reference frame:
-!
-! - X axis is East
-! - Y axis is North
-! - Z axis is up
-!
-! Note that this convention is different from both the Aki-Richards convention
-! and the Harvard CMT convention.
-!
-! Let us recall that the Aki-Richards convention is:
-!
-! - X axis is North
-! - Y axis is East
-! - Z axis is down
-!
-! and that the Harvard CMT convention is:
-!
-! - X axis is South
-! - Y axis is East
-! - Z axis is up
-!
-! To report bugs or suggest improvements to the code, please send an email
-! to Jeroen Tromp <jtromp AT princeton.edu> and/or use our online
-! bug tracking system at http://www.geodynamics.org/roundup .
-!
-! Evolution of the code:
-! ---------------------
-!
-! MPI v. 2.0 "SESAME" (Spectral ElementS on Any MEsh), Fall 2009:
-! Dimitri Komatitsch, Nicolas Le Goff, Roland Martin and Pieyre Le Loher, University of Pau, France,
-! Jeroen Tromp and the Princeton group of developers, Princeton University, USA,
-! and Emanuele Casarotti, INGV Roma, Italy:
-! support for CUBIT meshes decomposed by SCOTCH, METIS or ZOLTAN;
-! much faster solver using Michel Deville's inlined matrix products.
-!
-! MPI v. 1.4 Dimitri Komatitsch, University of Pau, Qinya Liu and others, Caltech, September 2006:
-! better adjoint and kernel calculations, faster and better I/Os
-! on very large systems, many small improvements and bug fixes
-!
-! MPI v. 1.3 Dimitri Komatitsch, University of Pau, and Qinya Liu, Caltech, July 2005:
-! serial version, regular mesh, adjoint and kernel calculations, ParaView support
-!
-! MPI v. 1.2 Min Chen and Dimitri Komatitsch, Caltech, July 2004:
-! full anisotropy, volume movie
-!
-! MPI v. 1.1 Dimitri Komatitsch, Caltech, October 2002: Zhu's Moho map, scaling
-! of Vs with depth, Hauksson's regional model, attenuation, oceans, movies
-!
-! MPI v. 1.0 Dimitri Komatitsch, Caltech, May 2002: first MPI version based on global code
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- module generate_databases_par
-
- implicit none
-
- include "constants.h"
-
-! number of spectral elements in each block
- integer nspec,npointot
-
-! local to global indexing array
- integer, dimension(:,:,:,:), allocatable :: ibool
-
-! arrays with the mesh in double precision
- double precision, dimension(:,:,:,:), allocatable :: xstore,ystore,zstore
-
-! proc numbers for MPI
- integer :: myrank,sizeprocs,ier
-
-! 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
- double precision, external :: wtime
- double precision :: time_start,tCPU
-
-! parameters read from parameter file
- integer :: NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,SIMULATION_TYPE
- integer :: NSOURCES
-
- double precision :: DT,HDUR_MOVIE
-
- logical :: ATTENUATION,USE_OLSEN_ATTENUATION, &
- OCEANS, SAVE_FORWARD
- logical :: ANISOTROPY,ABSORBING_CONDITIONS,SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION
-
- logical :: MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
- USE_HIGHRES_FOR_MOVIES
- integer :: NTSTEP_BETWEEN_FRAMES,NTSTEP_BETWEEN_OUTPUT_INFO,NTSTEP_BETWEEN_READ_ADJSRC
-
- character(len=256) OUTPUT_FILES,LOCAL_PATH
-
-! parameters deduced from parameters read from file
- integer :: NPROC
-
-! static memory size that will be needed by the solver
- double precision :: max_static_memory_size,max_static_memory_size_request
-
-! this for all the regions
- integer NSPEC_AB,NGLOB_AB
-
- integer NSPEC2D_BOTTOM,NSPEC2D_TOP
-
- double precision min_elevation,max_elevation
- double precision min_elevation_all,max_elevation_all
-
-! for Databases of external meshes
- character(len=256) prname
- integer :: dummy_node
- integer :: dummy_elmnt
- integer :: ispec, inode, num_interface,ie,imat,iface,icorner
- integer :: nnodes_ext_mesh, nelmnts_ext_mesh
- integer :: num_interfaces_ext_mesh
- integer :: max_interface_size_ext_mesh
- integer :: nmat_ext_mesh, nundefMat_ext_mesh
- integer, dimension(:), allocatable :: my_neighbours_ext_mesh
- integer, dimension(:), allocatable :: my_nelmnts_neighbours_ext_mesh
- integer, dimension(:,:,:), allocatable :: my_interfaces_ext_mesh
- integer, dimension(:,:), allocatable :: ibool_interfaces_ext_mesh
- integer, dimension(:), allocatable :: nibool_interfaces_ext_mesh
- double precision, dimension(:,:), allocatable :: nodes_coords_ext_mesh
- integer, dimension(:,:), allocatable :: elmnts_ext_mesh
- integer, dimension(:,:), allocatable :: mat_ext_mesh
- integer :: max_nibool_interfaces_ext_mesh
- integer, dimension(:,:), allocatable :: ibool_interfaces_ext_mesh_dummy
-
-! boundaries and materials
- integer :: ispec2D, boundary_number
- integer :: nspec2D_xmin, nspec2D_xmax, nspec2D_ymin, nspec2D_ymax, nspec2D_bottom_ext, nspec2D_top_ext
- character (len=30), dimension(:,:), allocatable :: undef_mat_prop
- integer, dimension(:), allocatable :: ibelm_xmin,ibelm_xmax, ibelm_ymin, ibelm_ymax, ibelm_bottom, ibelm_top
- integer, dimension(:,:), allocatable :: nodes_ibelm_xmin,nodes_ibelm_xmax, &
- nodes_ibelm_ymin, nodes_ibelm_ymax, nodes_ibelm_bottom, nodes_ibelm_top
- double precision, dimension(:,:), allocatable :: materials_ext_mesh
-
-! moho (optional)
- integer :: nspec2D_moho_ext
- integer, dimension(:), allocatable :: ibelm_moho
- integer, dimension(:,:), allocatable :: nodes_ibelm_moho
-
-! number of points per spectral element
- integer, parameter :: NGLLCUBE = NGLLX * NGLLY * NGLLZ
-
- integer :: nglob,nglob_total,nspec_total
-
- integer,dimension(:),allocatable :: ispec_is_surface_external_mesh,iglob_is_surface_external_mesh
- integer :: nfaces_surface_ext_mesh,nfaces_surface_glob_ext_mesh
-
- end module generate_databases_par
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine generate_databases
-
- use generate_databases_par
- implicit none
-
-! sizeprocs returns number of processes started (should be equal to NPROC).
-! myrank is the rank of each process, between 0 and NPROC-1.
-! as usual in MPI, process 0 is in charge of coordinating everything
-! and also takes care of the main output
- call world_size(sizeprocs)
- call world_rank(myrank)
-
-! get the base pathname for output files
- call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
-
-! open main output file, only written to by process 0
- if(myrank == 0 .and. IMAIN /= ISTANDARD_OUTPUT) &
- open(unit=IMAIN,file=trim(OUTPUT_FILES)//'/output_mesher.txt',status='unknown')
-
-! get MPI starting time
- time_start = wtime()
-
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) '******************************************'
- write(IMAIN,*) '*** Specfem3D MPI Mesher - f90 version ***'
- write(IMAIN,*) '******************************************'
- write(IMAIN,*)
- endif
-
-! read the parameter file
- call gd_read_parameters()
-
-! makes sure processes are synchronized
- call sync_all()
-
-! reads topography and bathymetry file
- call gd_read_topography()
-
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) '**************************'
- write(IMAIN,*) 'creating mesh in the model'
- write(IMAIN,*) '**************************'
- write(IMAIN,*)
- endif
-
-! reads Databases files
- call gd_read_partition_files()
-
-! external mesh creation
- call gd_setup_mesh()
-
-! finalize mesher
- call gd_finalize()
-
- end subroutine generate_databases
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine gd_read_parameters
-
-! reads and checks user input parameters
-
- use generate_databases_par
- implicit none
-
-! reads DATA/Par_file
- call read_parameter_file( NPROC,NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,DT, &
- UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION, &
- ATTENUATION,USE_OLSEN_ATTENUATION,LOCAL_PATH,NSOURCES, &
- OCEANS,ANISOTROPY,ABSORBING_CONDITIONS, &
- MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
- 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)
-
-! 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 processors actually run on: ',sizeprocs
- endif
- call exit_MPI(myrank,'wrong number of MPI processes')
- endif
-
-! there would be a problem with absorbing boundaries for different NGLLX,NGLLY,NGLLZ values
-! just to be sure for now..
- if( ABSORBING_CONDITIONS ) then
- if( NGLLX /= NGLLY .and. NGLLY /= NGLLZ ) &
- call exit_MPI(myrank,'must have NGLLX = NGLLY = NGLLZ for external meshes')
- endif
-
-! info about external mesh simulation
-! nlegoff -- should be put in compute_parameters and read_parameter_file for clarity
-! chris -- once the steps in decompose_mesh_SCOTCH are integrated into generate_database.f90,
-! NPROC will be known
-
- if(myrank == 0) then
- write(IMAIN,*) 'This is process ',myrank
- write(IMAIN,*) 'There are ',sizeprocs,' MPI processes'
- write(IMAIN,*) 'Processes are numbered from 0 to ',sizeprocs-1
- write(IMAIN,*)
- write(IMAIN,*) 'There is a total of ',NPROC,' slices'
- write(IMAIN,*)
- write(IMAIN,*) 'NGLLX = ',NGLLX
- write(IMAIN,*) 'NGLLY = ',NGLLY
- write(IMAIN,*) 'NGLLZ = ',NGLLZ
-
- write(IMAIN,*)
- write(IMAIN,*) 'Shape functions defined by NGNOD = ',NGNOD,' control nodes'
- write(IMAIN,*) 'Surface shape functions defined by NGNOD2D = ',NGNOD2D,' control nodes'
- write(IMAIN,*)
- endif
-
-! check that reals are either 4 or 8 bytes
- if(CUSTOM_REAL /= SIZE_REAL .and. CUSTOM_REAL /= SIZE_DOUBLE) &
- call exit_MPI(myrank,'wrong size of CUSTOM_REAL for reals')
-
- if(NGNOD /= 8) call exit_MPI(myrank,'number of control nodes must be 8')
- if(NGNOD2D /= 4) call exit_MPI(myrank,'elements with 8 points should have NGNOD2D = 4')
-
-! for the number of standard linear solids for attenuation
- if(N_SLS /= 3) call exit_MPI(myrank,'number of SLS must be 3')
-
- ! exclusive movie flags
- if( EXTERNAL_MESH_MOVIE_SURFACE .or. EXTERNAL_MESH_CREATE_SHAKEMAP ) then
- MOVIE_SURFACE = .false.
- CREATE_SHAKEMAP = .false.
- endif
-
-
- if(myrank == 0) then
-! chris: I am not sure if we should suppress the following. topography should appear in the external mesh
-! leave it for now
-
- write(IMAIN,*)
- if(SUPPRESS_UTM_PROJECTION) then
- write(IMAIN,*) 'suppressing UTM projection'
- else
- write(IMAIN,*) 'using UTM projection in region ',UTM_PROJECTION_ZONE
- endif
-
- write(IMAIN,*)
- if(ATTENUATION) then
- write(IMAIN,*) 'incorporating attenuation using ',N_SLS,' standard linear solids'
- if(USE_OLSEN_ATTENUATION) then
- write(IMAIN,*) 'using Olsen''s attenuation'
- else
- write(IMAIN,*) 'not using Olsen''s attenuation'
- endif
- else
- write(IMAIN,*) 'no attenuation'
- endif
-
- write(IMAIN,*)
- if(ANISOTROPY) then
- write(IMAIN,*) 'incorporating anisotropy'
- else
- write(IMAIN,*) 'no anisotropy'
- endif
-
- write(IMAIN,*)
- if(OCEANS) then
- write(IMAIN,*) 'incorporating the oceans using equivalent load'
- else
- write(IMAIN,*) 'no oceans'
- endif
-
- write(IMAIN,*)
-
- endif
-
- end subroutine gd_read_parameters
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine gd_read_topography
-
-! reads in topography files
-
- use generate_databases_par
- implicit none
-
- allocate(itopo_bathy(NX_TOPO,NY_TOPO))
-
- if(OCEANS) 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
-
- 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
- endif
-
-!! read basement map
-! if(BASEMENT_MAP) then
-! call get_value_string(BASEMENT_MAP_FILE,'model.BASEMENT_MAP_FILE','DATA/la_basement/reggridbase2_filtered_ascii.dat')
-! open(unit=55,file=BASEMENT_MAP_FILE,status='old',action='read')
-! do ix=1,NX_BASEMENT
-! do iy=1,NY_BASEMENT
-! read(55,*) iz_basement
-! z_basement(ix,iy) = dble(iz_basement)
-! enddo
-! enddo
-! close(55)
-! endif
-
- end subroutine gd_read_topography
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine gd_read_partition_files
-
-! reads in proc***_Databases files
-
- use generate_databases_par
- implicit none
-
- integer :: num_xmin,num_xmax,num_ymin,num_ymax,num_top,num_bottom,num
- integer :: num_moho
- integer :: j
- character(len=128) :: line
-
-! read databases about external mesh simulation
-! global node coordinates
- call create_name_database(prname,myrank,LOCAL_PATH)
- open(unit=IIN,file=prname(1:len_trim(prname))//'Database',status='old',action='read',form='formatted',iostat=ier)
- if( ier /= 0 ) then
- write(IMAIN,*) 'error opening file: ',prname(1:len_trim(prname))//'Database'
- write(IMAIN,*) 'make sure file exists'
- call exit_mpi(myrank,'error opening database file')
- endif
- read(IIN,*) nnodes_ext_mesh
- allocate(nodes_coords_ext_mesh(NDIM,nnodes_ext_mesh))
- do inode = 1, nnodes_ext_mesh
- read(IIN,*) dummy_node, nodes_coords_ext_mesh(1,inode), nodes_coords_ext_mesh(2,inode), &
- nodes_coords_ext_mesh(3,inode)
- enddo
-
- call sum_all_i(nnodes_ext_mesh,num)
- if(myrank == 0) then
- write(IMAIN,*) ' external mesh points: ',num
- endif
- call sync_all()
-
-! read materials' physical properties
- read(IIN,*) nmat_ext_mesh, nundefMat_ext_mesh
- allocate(materials_ext_mesh(6,nmat_ext_mesh))
- do imat = 1, nmat_ext_mesh
- ! format: #(1) rho #(2) vp #(3) vs #(4) Q_flag #(5) anisotropy_flag #(6) material_domain_id
- read(IIN,*) materials_ext_mesh(1,imat), materials_ext_mesh(2,imat), materials_ext_mesh(3,imat), &
- materials_ext_mesh(4,imat), materials_ext_mesh(5,imat), materials_ext_mesh(6,imat)
-
- ! output
- !print*,'materials:',materials_ext_mesh(1,imat), materials_ext_mesh(2,imat), materials_ext_mesh(3,imat), &
- ! materials_ext_mesh(4,imat), materials_ext_mesh(5,imat), materials_ext_mesh(6,imat)
- end do
-
- if(myrank == 0) then
- write(IMAIN,*) ' defined materials: ',nmat_ext_mesh
- endif
- call sync_all()
-
- allocate(undef_mat_prop(6,nundefMat_ext_mesh))
- do imat = 1, nundefMat_ext_mesh
- ! format example tomography:
- ! -1 tomography elastic tomography_model.xyz 1 2
- ! format example interface:
- ! -1 interface 14 15 1 2
- read(IIN,*) undef_mat_prop(1,imat),undef_mat_prop(2,imat),undef_mat_prop(3,imat),undef_mat_prop(4,imat), &
- undef_mat_prop(5,imat), undef_mat_prop(6,imat)
-
- ! output debug
- !print*,'undefined materials:'
- !print*,undef_mat_prop(:,imat)
- end do
-
- if(myrank == 0) then
- write(IMAIN,*) ' undefined materials: ',nundefMat_ext_mesh
- endif
- call sync_all()
-
-! element indexing
- read(IIN,*) nelmnts_ext_mesh
- allocate(elmnts_ext_mesh(esize,nelmnts_ext_mesh))
- allocate(mat_ext_mesh(2,nelmnts_ext_mesh))
-
- ! reads in material association for each spectral element and corner node indices
- do ispec = 1, nelmnts_ext_mesh
- ! format:
- ! # ispec_local # material_index_1 # material_index_2 # corner_id1 # corner_id2 # ... # corner_id8
- read(IIN,*) dummy_elmnt, mat_ext_mesh(1,ispec),mat_ext_mesh(2,ispec), &
- elmnts_ext_mesh(1,ispec), elmnts_ext_mesh(2,ispec), elmnts_ext_mesh(3,ispec), elmnts_ext_mesh(4,ispec), &
- elmnts_ext_mesh(5,ispec), elmnts_ext_mesh(6,ispec), elmnts_ext_mesh(7,ispec), elmnts_ext_mesh(8,ispec)
-
- ! check debug
- if( dummy_elmnt /= ispec) stop "error ispec order in materials file"
-
- enddo
- NSPEC_AB = nelmnts_ext_mesh
-
- call sum_all_i(nspec_ab,num)
- if(myrank == 0) then
- write(IMAIN,*) ' spectral elements: ',num
- endif
- call sync_all()
-
-
-! read boundaries
- read(IIN,*) boundary_number ,nspec2D_xmin
- if(boundary_number /= 1) stop "Error : invalid database file"
- read(IIN,*) boundary_number ,nspec2D_xmax
- if(boundary_number /= 2) stop "Error : invalid database file"
- read(IIN,*) boundary_number ,nspec2D_ymin
- if(boundary_number /= 3) stop "Error : invalid database file"
- read(IIN,*) boundary_number ,nspec2D_ymax
- if(boundary_number /= 4) stop "Error : invalid database file"
- read(IIN,*) boundary_number ,nspec2D_bottom_ext
- if(boundary_number /= 5) stop "Error : invalid database file"
- read(IIN,*) boundary_number ,nspec2D_top_ext
- if(boundary_number /= 6) stop "Error : invalid database file"
-
- NSPEC2D_BOTTOM = nspec2D_bottom_ext
- NSPEC2D_TOP = nspec2D_top_ext
-
- allocate(ibelm_xmin(nspec2D_xmin),nodes_ibelm_xmin(4,nspec2D_xmin))
- do ispec2D = 1,nspec2D_xmin
- read(IIN,*) ibelm_xmin(ispec2D),(nodes_ibelm_xmin(j,ispec2D),j=1,4)
- end do
-
- allocate(ibelm_xmax(nspec2D_xmax),nodes_ibelm_xmax(4,nspec2D_xmax))
- do ispec2D = 1,nspec2D_xmax
- read(IIN,*) ibelm_xmax(ispec2D),(nodes_ibelm_xmax(j,ispec2D),j=1,4)
- end do
-
- allocate(ibelm_ymin(nspec2D_ymin),nodes_ibelm_ymin(4,nspec2D_ymin))
- do ispec2D = 1,nspec2D_ymin
- read(IIN,*) ibelm_ymin(ispec2D),(nodes_ibelm_ymin(j,ispec2D),j=1,4)
- end do
-
- allocate(ibelm_ymax(nspec2D_ymax),nodes_ibelm_ymax(4,nspec2D_ymax))
- do ispec2D = 1,nspec2D_ymax
- read(IIN,*) ibelm_ymax(ispec2D),(nodes_ibelm_ymax(j,ispec2D),j=1,4)
- end do
-
- allocate(ibelm_bottom(nspec2D_bottom_ext),nodes_ibelm_bottom(4,nspec2D_bottom_ext))
- do ispec2D = 1,nspec2D_bottom_ext
- read(IIN,*) ibelm_bottom(ispec2D),(nodes_ibelm_bottom(j,ispec2D),j=1,4)
- end do
-
- allocate(ibelm_top(nspec2D_top_ext),nodes_ibelm_top(4,nspec2D_top_ext))
- do ispec2D = 1,nspec2D_top_ext
- read(IIN,*) ibelm_top(ispec2D),(nodes_ibelm_top(j,ispec2D),j=1,4)
- end do
-
- call sum_all_i(nspec2D_xmin,num_xmin)
- call sum_all_i(nspec2D_xmax,num_xmax)
- call sum_all_i(nspec2D_ymin,num_ymin)
- call sum_all_i(nspec2D_ymax,num_ymax)
- call sum_all_i(nspec2D_top_ext,num_top)
- call sum_all_i(nspec2D_bottom_ext,num_bottom)
-
- if(myrank == 0) then
- write(IMAIN,*) ' absorbing boundaries: '
- write(IMAIN,*) ' xmin,xmax: ',num_xmin,num_xmax
- write(IMAIN,*) ' ymin,ymax: ',num_ymin,num_ymax
- write(IMAIN,*) ' bottom,top: ',num_bottom,num_top
- endif
- call sync_all()
-
-! MPI interfaces between different partitions
- ! format: #number_of_MPI_interfaces #maximum_number_of_elements_on_each_interface
- read(IIN,*) num_interfaces_ext_mesh, max_interface_size_ext_mesh
-
- ! allocates interfaces
- allocate(my_neighbours_ext_mesh(num_interfaces_ext_mesh))
- allocate(my_nelmnts_neighbours_ext_mesh(num_interfaces_ext_mesh))
- allocate(my_interfaces_ext_mesh(6,max_interface_size_ext_mesh,num_interfaces_ext_mesh))
- allocate(ibool_interfaces_ext_mesh(NGLLX*NGLLX*max_interface_size_ext_mesh,num_interfaces_ext_mesh))
- allocate(nibool_interfaces_ext_mesh(num_interfaces_ext_mesh))
-
- ! loops over MPI interfaces with other partitions
- do num_interface = 1, num_interfaces_ext_mesh
- ! format: #process_interface_id #number_of_elements_on_interface
- ! where
- ! process_interface_id = rank of (neighbor) process to share MPI interface with
- ! number_of_elements_on_interface = number of interface elements
- read(IIN,*) my_neighbours_ext_mesh(num_interface), my_nelmnts_neighbours_ext_mesh(num_interface)
-
- ! loops over interface elements
- do ie = 1, my_nelmnts_neighbours_ext_mesh(num_interface)
- ! format: #(1)spectral_element_id #(2)interface_type #(3)node_id1 #(4)node_id2 #(5)...
- !
- ! interface types:
- ! 1 - corner point only
- ! 2 - element edge
- ! 4 - element face
- read(IIN,*) my_interfaces_ext_mesh(1,ie,num_interface), my_interfaces_ext_mesh(2,ie,num_interface), &
- my_interfaces_ext_mesh(3,ie,num_interface), my_interfaces_ext_mesh(4,ie,num_interface), &
- my_interfaces_ext_mesh(5,ie,num_interface), my_interfaces_ext_mesh(6,ie,num_interface)
- enddo
- enddo
-
- call sum_all_i(num_interfaces_ext_mesh,num)
- if(myrank == 0) then
- write(IMAIN,*) ' number of MPI partition interfaces: ',num
- endif
- call sync_all()
-
- ! optional moho
- if( SAVE_MOHO_MESH ) then
- ! checks if additional line exists
- read(IIN,'(a128)',iostat=ier) line
- if( ier /= 0 ) then
- ! no moho informations given
- nspec2D_moho_ext = 0
- boundary_number = 7
- else
- ! tries to read in number of moho elements
- read(line,*,iostat=ier) boundary_number ,nspec2D_moho_ext
- if( ier /= 0 ) call exit_mpi(myrank,'error reading moho mesh in database')
- endif
- if(boundary_number /= 7) stop "Error : invalid database file"
-
- ! checks total number of elements
- call sum_all_i(nspec2D_moho_ext,num_moho)
- if( num_moho == 0 ) call exit_mpi(myrank,'error no moho mesh in database')
-
- ! reads in element informations
- allocate(ibelm_moho(nspec2D_moho_ext),nodes_ibelm_moho(4,nspec2D_moho_ext))
- do ispec2D = 1,nspec2D_moho_ext
- ! format: #element_id #node_id1 #node_id2 #node_id3 #node_id4
- read(IIN,*) ibelm_moho(ispec2D),(nodes_ibelm_moho(j,ispec2D),j=1,4)
- end do
-
- ! user output
- if(myrank == 0) then
- write(IMAIN,*) ' moho surfaces: ',num_moho
- endif
- call sync_all()
- endif
-
- close(IIN)
-
- end subroutine gd_read_partition_files
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine gd_setup_mesh
-
-! mesh creation for static solver
-
- use generate_databases_par
- implicit none
-
-! assign theoretical number of elements
- nspec = NSPEC_AB
-
-! 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))
- allocate(xstore(NGLLX,NGLLY,NGLLZ,nspec))
- allocate(ystore(NGLLX,NGLLY,NGLLZ,nspec))
- allocate(zstore(NGLLX,NGLLY,NGLLZ,nspec),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,&
- 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,&
- max_static_memory_size_request)
-
- max_static_memory_size = max_static_memory_size_request
-
-! make sure everybody is synchronized
- call sync_all()
-
-! main working routine to create all the regions of the mesh
- 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, &
- UTM_PROJECTION_ZONE,SUPPRESS_UTM_PROJECTION,NX_TOPO,NY_TOPO, &
- ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO, &
- itopo_bathy)
-
-! Moho boundary parameters, 2-D jacobians and normals
- if( SAVE_MOHO_MESH ) then
- call create_regions_mesh_save_moho(myrank,nglob,nspec, &
- 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
- do iface = 1,nspec2D_top_ext
- do icorner = 1,NGNOD2D
- inode = nodes_ibelm_top(icorner,iface)
- if (nodes_coords_ext_mesh(3,inode) < min_elevation) then
- min_elevation = nodes_coords_ext_mesh(3,inode)
- end if
- if (nodes_coords_ext_mesh(3,inode) > max_elevation) then
- max_elevation = nodes_coords_ext_mesh(3,inode)
- end if
- end do
- end do
-
-! compute the maximum of the maxima for all the slices using an MPI reduction
- call min_all_dp(min_elevation,min_elevation_all)
- call max_all_dp(max_elevation,max_elevation_all)
-
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) 'min and max of topography included in mesh in m is ',min_elevation_all,' ',max_elevation_all
- write(IMAIN,*)
- endif
-
-! clean-up
- deallocate(xstore,ystore,zstore)
-
-! make sure everybody is synchronized
- call sync_all()
-
- end subroutine gd_setup_mesh
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine gd_finalize
-
-! checks user input parameters
-
- use generate_databases_par
- implicit none
-
- integer :: i
-
-! print number of points and elements in the mesh
- call sum_all_i(NGLOB_AB,nglob_total)
- call sum_all_i(NSPEC_AB,nspec_total)
- call sync_all()
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) 'Repartition of elements:'
- write(IMAIN,*) '-----------------------'
- write(IMAIN,*)
- write(IMAIN,*) 'total number of elements in each slice: ',NSPEC_AB
- write(IMAIN,*) 'total number of points in each slice: ',NGLOB_AB
- write(IMAIN,*)
- write(IMAIN,*) 'total number of elements in entire mesh: ',nspec_total ! NSPEC_AB*NPROC
- write(IMAIN,*) 'total number of points in entire mesh: ',nglob_total !NGLOB_AB*NPROC
- write(IMAIN,*) 'total number of DOFs in entire mesh: ',nglob_total*NDIM !NGLOB_AB*NPROC*NDIM
- write(IMAIN,*)
- write(IMAIN,*) 'total number of time steps in the solver will be: ',NSTEP
- write(IMAIN,*)
- ! write information about precision used for floating-point operations
- if(CUSTOM_REAL == SIZE_REAL) then
- write(IMAIN,*) 'using single precision for the calculations'
- else
- write(IMAIN,*) 'using double precision for the calculations'
- endif
- write(IMAIN,*)
- write(IMAIN,*) 'smallest and largest possible floating-point numbers are: ',tiny(1._CUSTOM_REAL),huge(1._CUSTOM_REAL)
- write(IMAIN,*)
- endif
-
-! gets number of surface elements (for movie outputs)
- allocate( ispec_is_surface_external_mesh(NSPEC_AB), &
- iglob_is_surface_external_mesh(NGLOB_AB),stat=ier)
- if( ier /= 0 ) stop 'error allocating array'
- max_nibool_interfaces_ext_mesh = maxval(nibool_interfaces_ext_mesh)
- allocate(ibool_interfaces_ext_mesh_dummy(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh),stat=ier)
- if( ier /= 0 ) stop 'error allocating array'
- do i = 1, num_interfaces_ext_mesh
- ibool_interfaces_ext_mesh_dummy(:,:) = ibool_interfaces_ext_mesh(1:max_nibool_interfaces_ext_mesh,:)
- enddo
- call sync_all()
- call detect_surface(NPROC,NGLOB_AB,NSPEC_AB,ibool, &
- ispec_is_surface_external_mesh, &
- iglob_is_surface_external_mesh, &
- nfaces_surface_ext_mesh, &
- num_interfaces_ext_mesh, &
- max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh, &
- my_neighbours_ext_mesh, &
- ibool_interfaces_ext_mesh_dummy )
-
- deallocate(ibool)
- deallocate(ispec_is_surface_external_mesh)
- deallocate(iglob_is_surface_external_mesh)
- deallocate(ibool_interfaces_ext_mesh_dummy)
-
- ! takes number of faces for top, free surface only
- if( MOVIE_SURFACE .or. CREATE_SHAKEMAP ) then
- nfaces_surface_ext_mesh = NSPEC2D_TOP
- endif
-
-! number of surface faces for all partitions together
- call sum_all_i(nfaces_surface_ext_mesh,nfaces_surface_glob_ext_mesh)
-
-
-! copy number of elements and points in an include file for the solver
- if( myrank == 0 ) then
- call save_header_file(NSPEC_AB,NGLOB_AB,NPROC, &
- ATTENUATION,ANISOTROPY,NSTEP,DT, &
- SIMULATION_TYPE,max_static_memory_size,nfaces_surface_glob_ext_mesh)
- endif
-
-! elapsed time since beginning of mesh generation
- if(myrank == 0) then
- tCPU = wtime() - time_start
- write(IMAIN,*)
- write(IMAIN,*) 'Elapsed time for mesh generation and buffer creation in seconds = ',tCPU
- write(IMAIN,*) 'End of mesh generation'
- write(IMAIN,*)
- endif
-
-! close main output file
- if(myrank == 0) then
- write(IMAIN,*) 'done'
- write(IMAIN,*)
- close(IMAIN)
- endif
-
-! synchronize all the processes to make sure everybody has finished
- call sync_all()
-
- end subroutine gd_finalize
Deleted: seismo/3D/SPECFEM3D/trunk/get_MPI.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/get_MPI.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/get_MPI.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,229 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine get_MPI(myrank,nglob,nspec,ibool, &
- nelmnts_ext_mesh,elmnts_ext_mesh, &
- my_nelmnts_neighbours_ext_mesh, my_interfaces_ext_mesh, &
- ibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh, &
- num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
- my_neighbours_ext_mesh,NPROC)
-
-! sets up the MPI interface for communication between partitions
-
- use create_regions_mesh_ext_par
- implicit none
-
- integer :: myrank,nglob,nspec,NPROC
-
-! global indexing
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
-
-! external mesh, element indexing
- integer :: nelmnts_ext_mesh
- integer, dimension(ESIZE,nelmnts_ext_mesh) :: elmnts_ext_mesh
-
- integer :: num_interfaces_ext_mesh,max_interface_size_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(num_interfaces_ext_mesh) :: my_neighbours_ext_mesh
-
- integer, dimension(num_interfaces_ext_mesh) :: nibool_interfaces_ext_mesh
- integer, dimension(NGLLX*NGLLX*max_interface_size_ext_mesh,num_interfaces_ext_mesh) :: ibool_interfaces_ext_mesh
-
-
- !integer :: nnodes_ext_mesh
- !double precision, dimension(NDIM,nnodes_ext_mesh) :: nodes_coords_ext_mesh
-
-!local parameters
- double precision, dimension(:), allocatable :: xp,yp,zp
- double precision, dimension(:), allocatable :: work_ext_mesh
-
- integer, dimension(:), allocatable :: locval
- integer, dimension(:), allocatable :: nibool_interfaces_ext_mesh_true
-
- ! for MPI buffers
- integer, dimension(:), allocatable :: reorder_interface_ext_mesh,ind_ext_mesh,ninseg_ext_mesh,iwork_ext_mesh
- integer, dimension(:), allocatable :: ibool_interface_ext_mesh_dummy
- logical, dimension(:), allocatable :: ifseg
- integer :: iinterface,ilocnum
- integer :: num_points1, num_points2
-
- ! assembly test
- integer :: i,j,k,ispec,iglob,count,inum
- integer :: max_nibool_interfaces_ext_mesh
- integer,dimension(:),allocatable :: test_flag
- real(kind=CUSTOM_REAL), dimension(:),allocatable :: test_flag_cr
- integer, dimension(:,:), allocatable :: ibool_interfaces_dummy
-
-! gets global indices for points on MPI interfaces (defined by my_interfaces_ext_mesh) between different partitions
-! and stores them in ibool_interfaces_ext_mesh & nibool_interfaces_ext_mesh (number of total points)
- call prepare_assemble_MPI( nelmnts_ext_mesh,elmnts_ext_mesh, &
- ibool,nglob,ESIZE, &
- num_interfaces_ext_mesh, max_interface_size_ext_mesh, &
- my_nelmnts_neighbours_ext_mesh, my_interfaces_ext_mesh, &
- ibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh )
-
- allocate(nibool_interfaces_ext_mesh_true(num_interfaces_ext_mesh))
-
-! sorts ibool comm buffers lexicographically for all MPI interfaces
- num_points1 = 0
- num_points2 = 0
- do iinterface = 1, num_interfaces_ext_mesh
-
- allocate(xp(nibool_interfaces_ext_mesh(iinterface)))
- allocate(yp(nibool_interfaces_ext_mesh(iinterface)))
- allocate(zp(nibool_interfaces_ext_mesh(iinterface)))
- allocate(locval(nibool_interfaces_ext_mesh(iinterface)))
- allocate(ifseg(nibool_interfaces_ext_mesh(iinterface)))
- allocate(reorder_interface_ext_mesh(nibool_interfaces_ext_mesh(iinterface)))
- allocate(ibool_interface_ext_mesh_dummy(nibool_interfaces_ext_mesh(iinterface)))
- allocate(ind_ext_mesh(nibool_interfaces_ext_mesh(iinterface)))
- allocate(ninseg_ext_mesh(nibool_interfaces_ext_mesh(iinterface)))
- allocate(iwork_ext_mesh(nibool_interfaces_ext_mesh(iinterface)))
- allocate(work_ext_mesh(nibool_interfaces_ext_mesh(iinterface)))
-
- ! gets x,y,z coordinates of global points on MPI interface
- do ilocnum = 1, nibool_interfaces_ext_mesh(iinterface)
- xp(ilocnum) = xstore_dummy(ibool_interfaces_ext_mesh(ilocnum,iinterface))
- yp(ilocnum) = ystore_dummy(ibool_interfaces_ext_mesh(ilocnum,iinterface))
- zp(ilocnum) = zstore_dummy(ibool_interfaces_ext_mesh(ilocnum,iinterface))
- enddo
-
- ! sorts (lexicographically?) ibool_interfaces_ext_mesh and updates value
- ! of total number of points nibool_interfaces_ext_mesh_true(iinterface)
- call sort_array_coordinates(nibool_interfaces_ext_mesh(iinterface),xp,yp,zp, &
- ibool_interfaces_ext_mesh(1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
- reorder_interface_ext_mesh,locval,ifseg,nibool_interfaces_ext_mesh_true(iinterface), &
- ind_ext_mesh,ninseg_ext_mesh,iwork_ext_mesh,work_ext_mesh)
-
- ! checks that number of MPI points are still the same
- num_points1 = num_points1 + nibool_interfaces_ext_mesh(iinterface)
- num_points2 = num_points2 + nibool_interfaces_ext_mesh_true(iinterface)
- if( num_points1 /= num_points2 ) then
- write(*,*) 'error sorting MPI interface points:',myrank
- write(*,*) ' interface:',iinterface,num_points1,num_points2
- call exit_mpi(myrank,'error sorting MPI interface')
- endif
- !write(*,*) myrank,'intfc',iinterface,num_points2,nibool_interfaces_ext_mesh_true(iinterface)
-
- ! cleanup temporary arrays
- deallocate(xp)
- deallocate(yp)
- deallocate(zp)
- deallocate(locval)
- deallocate(ifseg)
- deallocate(reorder_interface_ext_mesh)
- deallocate(ibool_interface_ext_mesh_dummy)
- deallocate(ind_ext_mesh)
- deallocate(ninseg_ext_mesh)
- deallocate(iwork_ext_mesh)
- deallocate(work_ext_mesh)
-
- enddo
-
- ! cleanup
- deallocate(nibool_interfaces_ext_mesh_true)
-
- ! outputs total number of MPI interface points
- call sum_all_i(num_points2,ilocnum)
- if( myrank == 0 ) then
- write(IMAIN,*) ' total MPI interface points: ',ilocnum
- endif
-
-! checks with assembly of test fields
- allocate(test_flag(nglob),test_flag_cr(nglob))
- test_flag(:) = 0
- test_flag_cr(:) = 0._CUSTOM_REAL
- count = 0
- do ispec = 1, nspec
- ! sets flags on global points
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
- ! global index
- iglob = ibool(i,j,k,ispec)
-
- ! counts number of unique global points to set
- if( test_flag(iglob) == 0 ) count = count+1
-
- ! sets identifier
- test_flag(iglob) = myrank + 1
- test_flag_cr(iglob) = myrank + 1.0
- enddo
- enddo
- enddo
- enddo
- call sync_all()
-
- ! collects contributions from different MPI partitions
- ! sets up MPI communications
- max_nibool_interfaces_ext_mesh = maxval( nibool_interfaces_ext_mesh(:) )
- allocate(ibool_interfaces_dummy(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh))
-
- count = 0
- do iinterface = 1, num_interfaces_ext_mesh
- ibool_interfaces_dummy(:,iinterface) = ibool_interfaces_ext_mesh(1:max_nibool_interfaces_ext_mesh,iinterface)
- count = count + nibool_interfaces_ext_mesh(iinterface)
- !write(*,*) myrank,'interfaces ',iinterface,nibool_interfaces_ext_mesh(iinterface),max_nibool_interfaces_ext_mesh
- enddo
- call sync_all()
-
- call sum_all_i(count,iglob)
- if( myrank == 0 ) then
- if( iglob /= ilocnum ) call exit_mpi(myrank,'error total global MPI interface points')
- endif
-
- ! adds contributions from different partitions to flag arrays
- ! integer arrays
- call assemble_MPI_scalar_i_ext_mesh(NPROC,nglob,test_flag, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_dummy,&
- my_neighbours_ext_mesh)
- ! custom_real arrays
- call assemble_MPI_scalar_ext_mesh(NPROC,nglob,test_flag_cr, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_dummy, &
- my_neighbours_ext_mesh)
-
- ! checks number of interface points
- i = 0
- j = 0
- do iglob=1,nglob
- ! only counts flags with MPI contributions
- if( test_flag(iglob) > myrank+1 ) i = i + 1
- if( test_flag_cr(iglob) > myrank+1.0) j = j + 1
- enddo
- call sum_all_i(i,inum)
- call sum_all_i(j,iglob)
- if( myrank == 0 ) then
- write(IMAIN,*) ' total assembled MPI interface points:',inum
- if( inum /= iglob .or. inum > ilocnum ) call exit_mpi(myrank,'error MPI assembly')
- endif
-
- end subroutine get_MPI
Deleted: seismo/3D/SPECFEM3D/trunk/get_absorbing_boundary.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/get_absorbing_boundary.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/get_absorbing_boundary.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,498 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine get_absorbing_boundary(myrank,nspec,nglob,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, &
- nodes_ibelm_bottom,nodes_ibelm_top, &
- nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
- nspec2D_bottom,nspec2D_top)
-
-! determines absorbing boundaries/free-surface, 2D jacobians, face normals for Stacey conditions
-
- use create_regions_mesh_ext_par
- implicit none
-
-! number of spectral elements in each block
- integer :: myrank,nspec,nglob
-
-! arrays with the mesh
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
-
-! data from the external mesh
- integer :: nnodes_ext_mesh
- double precision, dimension(NDIM,nnodes_ext_mesh) :: nodes_coords_ext_mesh
-
-! absorbing boundaries (as defined in CUBIT)
- integer :: nspec2D_xmin, nspec2D_xmax, nspec2D_ymin, nspec2D_ymax, NSPEC2D_BOTTOM, NSPEC2D_TOP
- ! element indices containing a boundary
- 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
-
- ! corner node indices of boundary faces coming from CUBIT
- 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
-
-! local parameters
- logical, dimension(:,:),allocatable :: iboun ! pll
-
- ! (assumes NGLLX=NGLLY=NGLLZ)
- real(kind=CUSTOM_REAL) :: jacobian2Dw_face(NGLLX,NGLLY)
- real(kind=CUSTOM_REAL) :: normal_face(NDIM,NGLLX,NGLLY)
- integer:: ijk_face(3,NGLLX,NGLLY)
-
- ! corner locations for faces
- real(kind=CUSTOM_REAL), dimension(:,:,:),allocatable :: xcoord_iboun,ycoord_iboun,zcoord_iboun
-
- ! face corner locations
- real(kind=CUSTOM_REAL),dimension(NGNOD2D) :: xcoord,ycoord,zcoord
- integer :: ispec,ispec2D,icorner,ier,iabs,iface,igll,i,j,igllfree,ifree
-
-! allocate temporary flag array
- allocate(iboun(6,nspec), &
- xcoord_iboun(NGNOD2D,6,nspec), &
- ycoord_iboun(NGNOD2D,6,nspec), &
- zcoord_iboun(NGNOD2D,6,nspec),stat=ier)
- if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
-
-! sets flag in array iboun for elements with an absorbing boundary faces
- iboun(:,:) = .false.
-
-! abs face counter
- iabs = 0
-
- ! xmin
- do ispec2D = 1, nspec2D_xmin
- ! sets element
- ispec = ibelm_xmin(ispec2D)
-
- !if(myrank == 0 ) print*,'xmin:',ispec2D,ispec
-
- ! looks for i,j,k indices of GLL points on boundary face
- ! determines element face by given CUBIT corners
- do icorner=1,NGNOD2D
- xcoord(icorner) = nodes_coords_ext_mesh(1,nodes_ibelm_xmin(icorner,ispec2D))
- ycoord(icorner) = nodes_coords_ext_mesh(2,nodes_ibelm_xmin(icorner,ispec2D))
- zcoord(icorner) = nodes_coords_ext_mesh(3,nodes_ibelm_xmin(icorner,ispec2D))
- !print*,'corner look:',icorner,xcoord(icorner),ycoord(icorner),zcoord(icorner)
- enddo
-
- ! sets face id of reference element associated with this face
- call get_element_face_id(ispec,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- iface)
-
- iboun(iface,ispec) = .true.
-
- ! ijk indices of GLL points for face id
- call get_element_face_gll_indices(iface,ijk_face,NGLLX,NGLLZ)
-
- ! weighted jacobian and normal
- call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob,&
- dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
- ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLZ)
-
- ! normal convention: points away from element
- ! switch normal direction if necessary
- do j=1,NGLLZ
- do i=1,NGLLX
- call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- normal_face(:,i,j) )
- enddo
- enddo
-
- ! sets face infos
- iabs = iabs + 1
- abs_boundary_ispec(iabs) = ispec
-
- ! gll points -- assuming NGLLX = NGLLY = NGLLZ
- igll = 0
- do j=1,NGLLZ
- do i=1,NGLLX
- igll = igll+1
- abs_boundary_ijk(:,igll,iabs) = ijk_face(:,i,j)
- abs_boundary_jacobian2Dw(igll,iabs) = jacobian2Dw_face(i,j)
- abs_boundary_normal(:,igll,iabs) = normal_face(:,i,j)
- enddo
- enddo
-
- enddo ! nspec2D_xmin
-
- ! xmax
- do ispec2D = 1, nspec2D_xmax
- ! sets element
- ispec = ibelm_xmax(ispec2D)
-
- ! looks for i,j,k indices of GLL points on boundary face
- ! determines element face by given CUBIT corners
- do icorner=1,NGNOD2D
- xcoord(icorner) = nodes_coords_ext_mesh(1,nodes_ibelm_xmax(icorner,ispec2D))
- ycoord(icorner) = nodes_coords_ext_mesh(2,nodes_ibelm_xmax(icorner,ispec2D))
- zcoord(icorner) = nodes_coords_ext_mesh(3,nodes_ibelm_xmax(icorner,ispec2D))
- enddo
-
- ! sets face id of reference element associated with this face
- call get_element_face_id(ispec,xcoord,ycoord,zcoord,&
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- iface )
- iboun(iface,ispec) = .true.
-
- ! ijk indices of GLL points on face
- call get_element_face_gll_indices(iface,ijk_face,NGLLX,NGLLZ)
-
- ! weighted jacobian and normal
- call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob,&
- dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
- ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLZ)
-
- ! normal convention: points away from element
- ! switch normal direction if necessary
- do j=1,NGLLZ
- do i=1,NGLLX
- call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- normal_face(:,i,j) )
- enddo
- enddo
-
- ! sets face infos
- iabs = iabs + 1
- abs_boundary_ispec(iabs) = ispec
-
- ! gll points -- assuming NGLLX = NGLLY = NGLLZ
- igll = 0
- do j=1,NGLLZ
- do i=1,NGLLX
- igll = igll+1
- abs_boundary_ijk(:,igll,iabs) = ijk_face(:,i,j)
- abs_boundary_jacobian2Dw(igll,iabs) = jacobian2Dw_face(i,j)
- abs_boundary_normal(:,igll,iabs) = normal_face(:,i,j)
- enddo
- enddo
-
- enddo
-
- ! ymin
- do ispec2D = 1, nspec2D_ymin
- ! sets element
- ispec = ibelm_ymin(ispec2D)
-
- ! looks for i,j,k indices of GLL points on boundary face
- ! determines element face by given CUBIT corners
- do icorner=1,NGNOD2D
- xcoord(icorner) = nodes_coords_ext_mesh(1,nodes_ibelm_ymin(icorner,ispec2D))
- ycoord(icorner) = nodes_coords_ext_mesh(2,nodes_ibelm_ymin(icorner,ispec2D))
- zcoord(icorner) = nodes_coords_ext_mesh(3,nodes_ibelm_ymin(icorner,ispec2D))
- enddo
-
- ! sets face id of reference element associated with this face
- call get_element_face_id(ispec,xcoord,ycoord,zcoord,&
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- iface )
- iboun(iface,ispec) = .true.
-
- ! ijk indices of GLL points on face
- call get_element_face_gll_indices(iface,ijk_face,NGLLY,NGLLZ)
-
- ! weighted jacobian and normal
- call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob,&
- dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
- ispec,iface,jacobian2Dw_face,normal_face,NGLLY,NGLLZ)
-
- ! normal convention: points away from element
- ! switch normal direction if necessary
- do j=1,NGLLZ
- do i=1,NGLLY
- call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- normal_face(:,i,j) )
- enddo
- enddo
-
- ! sets face infos
- iabs = iabs + 1
- abs_boundary_ispec(iabs) = ispec
-
- ! gll points -- assuming NGLLX = NGLLY = NGLLZ
- igll = 0
- do j=1,NGLLZ
- do i=1,NGLLY
- igll = igll+1
- abs_boundary_ijk(:,igll,iabs) = ijk_face(:,i,j)
- abs_boundary_jacobian2Dw(igll,iabs) = jacobian2Dw_face(i,j)
- abs_boundary_normal(:,igll,iabs) = normal_face(:,i,j)
- enddo
- enddo
-
- enddo
-
- ! ymax
- do ispec2D = 1, nspec2D_ymax
- ! sets element
- ispec = ibelm_ymax(ispec2D)
-
- ! looks for i,j,k indices of GLL points on boundary face
- ! determines element face by given CUBIT corners
- do icorner=1,NGNOD2D
- xcoord(icorner) = nodes_coords_ext_mesh(1,nodes_ibelm_ymax(icorner,ispec2D))
- ycoord(icorner) = nodes_coords_ext_mesh(2,nodes_ibelm_ymax(icorner,ispec2D))
- zcoord(icorner) = nodes_coords_ext_mesh(3,nodes_ibelm_ymax(icorner,ispec2D))
- enddo
-
- ! sets face id of reference element associated with this face
- call get_element_face_id(ispec,xcoord,ycoord,zcoord,&
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- iface )
- iboun(iface,ispec) = .true.
-
- ! ijk indices of GLL points on face
- call get_element_face_gll_indices(iface,ijk_face,NGLLY,NGLLZ)
-
- ! weighted jacobian and normal
- call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob, &
- dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- ispec,iface,jacobian2Dw_face,normal_face,NGLLY,NGLLZ)
-
- ! normal convention: points away from element
- ! switch normal direction if necessary
- do j=1,NGLLZ
- do i=1,NGLLY
- call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- normal_face(:,i,j) )
- enddo
- enddo
-
- ! sets face infos
- iabs = iabs + 1
- abs_boundary_ispec(iabs) = ispec
-
- ! gll points -- assuming NGLLX = NGLLY = NGLLZ
- igll = 0
- do j=1,NGLLY
- do i=1,NGLLX
- igll = igll+1
- abs_boundary_ijk(:,igll,iabs) = ijk_face(:,i,j)
- abs_boundary_jacobian2Dw(igll,iabs) = jacobian2Dw_face(i,j)
- abs_boundary_normal(:,igll,iabs) = normal_face(:,i,j)
- enddo
- enddo
-
- enddo
-
- ! bottom
- do ispec2D = 1, NSPEC2D_BOTTOM
- ! sets element
- ispec = ibelm_bottom(ispec2D)
-
- ! looks for i,j,k indices of GLL points on boundary face
- ! determines element face by given CUBIT corners
- do icorner=1,NGNOD2D
- xcoord(icorner) = nodes_coords_ext_mesh(1,nodes_ibelm_bottom(icorner,ispec2D))
- ycoord(icorner) = nodes_coords_ext_mesh(2,nodes_ibelm_bottom(icorner,ispec2D))
- zcoord(icorner) = nodes_coords_ext_mesh(3,nodes_ibelm_bottom(icorner,ispec2D))
- enddo
-
- ! sets face id of reference element associated with this face
- call get_element_face_id(ispec,xcoord,ycoord,zcoord,&
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- iface )
- iboun(iface,ispec) = .true.
-
- ! ijk indices of GLL points on face
- call get_element_face_gll_indices(iface,ijk_face,NGLLX,NGLLY)
-
- ! weighted jacobian and normal
- call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob, &
- dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLY)
-
- ! normal convention: points away from element
- ! switch normal direction if necessary
- do j=1,NGLLY
- do i=1,NGLLX
- call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- normal_face(:,i,j) )
- enddo
- enddo
-
- ! sets face infos
- iabs = iabs + 1
- abs_boundary_ispec(iabs) = ispec
-
- ! gll points -- assuming NGLLX = NGLLY = NGLLZ
- igll = 0
- do j=1,NGLLY
- do i=1,NGLLX
- igll = igll+1
- abs_boundary_ijk(:,igll,iabs) = ijk_face(:,i,j)
- abs_boundary_jacobian2Dw(igll,iabs) = jacobian2Dw_face(i,j)
- abs_boundary_normal(:,igll,iabs) = normal_face(:,i,j)
- enddo
- enddo
-
- enddo
-
- ! top
- ! free surface face counter
- ifree = 0
- do ispec2D = 1, NSPEC2D_TOP
- ! sets element
- ispec = ibelm_top(ispec2D)
-
- ! looks for i,j,k indices of GLL points on boundary face
- ! determines element face by given CUBIT corners
- do icorner=1,NGNOD2D
- xcoord(icorner) = nodes_coords_ext_mesh(1,nodes_ibelm_top(icorner,ispec2D))
- ycoord(icorner) = nodes_coords_ext_mesh(2,nodes_ibelm_top(icorner,ispec2D))
- zcoord(icorner) = nodes_coords_ext_mesh(3,nodes_ibelm_top(icorner,ispec2D))
- enddo
-
- ! sets face id of reference element associated with this face
- call get_element_face_id(ispec,xcoord,ycoord,zcoord,&
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- iface )
- iboun(iface,ispec) = .true.
-
- ! ijk indices of GLL points on face
- call get_element_face_gll_indices(iface,ijk_face,NGLLX,NGLLY)
-
- ! weighted jacobian and normal
- call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob, &
- dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLY)
-
- ! normal convention: points away from element
- ! switch normal direction if necessary
- do j=1,NGLLY
- do i=1,NGLLX
- call get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- normal_face(:,i,j) )
- enddo
- enddo
-
- ! stores surface infos
- if( .not. ABSORB_FREE_SURFACE ) then
- ! store for free surface
- !jacobian2D_top(:,:,ispec2D) = jacobian2Dw_face(:,:)
- !normal_top(:,:,:,ispec2D) = normal_face(:,:,:)
-
- ! sets face infos
- ifree = ifree + 1
- free_surface_ispec(ifree) = ispec
-
- ! gll points -- assuming NGLLX = NGLLY = NGLLZ
- igllfree = 0
- do j=1,NGLLY
- do i=1,NGLLX
- igllfree = igllfree+1
- free_surface_ijk(:,igllfree,ifree) = ijk_face(:,i,j)
- free_surface_jacobian2Dw(igllfree,ifree) = jacobian2Dw_face(i,j)
- free_surface_normal(:,igllfree,ifree) = normal_face(:,i,j)
- enddo
- enddo
- else
- ! adds face infos to absorbing boundary surface
- iabs = iabs + 1
- abs_boundary_ispec(iabs) = ispec
-
- ! gll points -- assuming NGLLX = NGLLY = NGLLZ
- igll = 0
- do j=1,NGLLY
- do i=1,NGLLX
- igll = igll+1
- abs_boundary_ijk(:,igll,iabs) = ijk_face(:,i,j)
- abs_boundary_jacobian2Dw(igll,iabs) = jacobian2Dw_face(i,j)
- abs_boundary_normal(:,igll,iabs) = normal_face(:,i,j)
- enddo
- enddo
-
- ! resets free surface
- ifree = 1
- free_surface_ispec(:) = 0
- free_surface_ijk(:,:,:) = 0
- free_surface_jacobian2Dw(:,:) = 0.0
- free_surface_normal(:,:,:) = 0.0
- endif
- enddo
-
-! checks counters
- if( ifree /= num_free_surface_faces ) then
- print*,'error number of free surface faces:',ifree,num_free_surface_faces
- stop 'error number of free surface faces'
- endif
-
- if( iabs /= num_abs_boundary_faces ) then
- print*,'error number of absorbing faces:',iabs,num_abs_boundary_faces
- stop 'error number of absorbing faces'
- endif
-
- call sum_all_i(num_abs_boundary_faces,iabs)
- if( myrank == 0 ) then
- write(IMAIN,*) ' absorbing boundary:'
- write(IMAIN,*) ' total number of faces = ',iabs
- if( ABSORB_FREE_SURFACE ) then
- write(IMAIN,*) ' absorbing boundary includes free surface'
- endif
- endif
-
- end subroutine get_absorbing_boundary
-
Deleted: seismo/3D/SPECFEM3D/trunk/get_attenuation_model.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/get_attenuation_model.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/get_attenuation_model.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,278 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine get_attenuation_model(myrank,iattenuation, &
- tau_mu,tau_sigma,beta,one_minus_sum_beta,factor_scale)
-
-! return attenuation mechanisms Q_mu using standard linear solids
-! frequency range: 20.000000 -- 1000.000000 mHz
-! period range: 1.000000 -- 50.000000 s
-! central logarithmic frequency: 0.141421 Hz
-! the Tau values computed by Jeroen's code are used
-! number of relaxation mechanisms: 3
-
-! in the future when more memory is available on computers
-! it would be more accurate to use four mechanisms instead of three
-
- implicit none
-
- include "constants.h"
-
-! define central frequency of source in seconds using values from Jeroen's code
-! logarithmic mean of frequency interval
- double precision, parameter :: f_c_source = 0.141421d0
-
-! reference frequency for target velocity values in velocity model
-! arbitrarily set to typical resolution of model (3 sec)
- double precision, parameter :: f0_REFERENCE = 0.3d0
-
- integer iattenuation,myrank
-
- double precision, dimension(N_SLS) :: tau_mu,tau_sigma,beta
- double precision one_minus_sum_beta
-
- integer i
-
- double precision Q_mu,w_c_source
- double precision factor_scale_mu0,factor_scale_mu,factor_scale
- double precision a_val,b_val,big_omega
-
-! check number of SLS is okay
- if(N_SLS /= 3) call exit_MPI(myrank,'wrong number of SLS for attenuation, must be 3')
-
-! clear arrays
- tau_mu(:) = 0.d0
- tau_sigma(:) = 0.d0
-
-! tau sigma evenly spaced in log frequency, does not depend on value of Q
- tau_sigma( 1) = 7.957747154594766669788441504352d0
- tau_sigma( 2) = 1.125395395196382652969191440206d0
- tau_sigma( 3) = 0.159154943091895345608222100964d0
-
-! determine in which region we are based upon doubling flag
-
- select case(iattenuation)
-
-!--- sediments
-
-! select value needed here, from Q_mu = 40 to Q_mu = 150
-
- case(IATTENUATION_SEDIMENTS_40)
-
- Q_mu = 40.000000d0
- tau_mu( 1) = 8.207413221956890936326090013608d0
- tau_mu( 2) = 1.161729745747647424281012717984d0
- tau_mu( 3) = 0.165834182312059152941685624683d0
-
- case(IATTENUATION_SEDIMENTS_50)
-
- Q_mu = 50.000000d0
- tau_mu( 1) = 8.169307711419302009403509146068d0
- tau_mu( 2) = 1.153839195800796080249028818798d0
- tau_mu( 3) = 0.164437605011117371489604011003d0
-
- case(IATTENUATION_SEDIMENTS_60)
-
- Q_mu = 60.000000d0
- tau_mu( 1) = 8.140254475505114939437589782756d0
- tau_mu( 2) = 1.148759228190431747052002720011d0
- tau_mu( 3) = 0.163522774234807849458306350243d0
-
- case(IATTENUATION_SEDIMENTS_70)
-
- Q_mu = 70.000000d0
- tau_mu( 1) = 8.117833196570874321196242817678d0
- tau_mu( 2) = 1.145216760190841176481058028003d0
- tau_mu( 3) = 0.162877472647593862786763452277d0
-
- case(IATTENUATION_SEDIMENTS_80)
-
- Q_mu = 80.000000d0
- tau_mu( 1) = 8.100148465407393416626291582361d0
- tau_mu( 2) = 1.142606124533341649396334105404d0
- tau_mu( 3) = 0.162398031255151509277823151933d0
-
- case(IATTENUATION_SEDIMENTS_90)
-
- Q_mu = 90.000000d0
- tau_mu( 1) = 8.085897732468197318667080253363d0
- tau_mu( 2) = 1.140602642076625095057806902332d0
- tau_mu( 3) = 0.162027854074084459723437134926d0
-
- case(IATTENUATION_SEDIMENTS_100)
-
- Q_mu = 100.000000d0
- tau_mu( 1) = 8.074193745349216300155603676103d0
- tau_mu( 2) = 1.139016691991711960341149278975d0
- tau_mu( 3) = 0.161733443689579814428469717313d0
-
- case(IATTENUATION_SEDIMENTS_110)
-
- Q_mu = 110.000000d0
- tau_mu( 1) = 8.064421863800781409281626110896d0
- tau_mu( 2) = 1.137730132230029722606445830024d0
- tau_mu( 3) = 0.161493715940844051459635011270d0
-
- case(IATTENUATION_SEDIMENTS_120)
-
- Q_mu = 120.000000d0
- tau_mu( 1) = 8.056146565814696458573962445371d0
- tau_mu( 2) = 1.136665532765689157201904890826d0
- tau_mu( 3) = 0.161294740739552050490246415393d0
-
- case(IATTENUATION_SEDIMENTS_130)
-
- Q_mu = 130.000000d0
- tau_mu( 1) = 8.049052148467024991873586259317d0
- tau_mu( 2) = 1.135770035674695810357093250786d0
- tau_mu( 3) = 0.161126946571733903335044146843d0
-
- case(IATTENUATION_SEDIMENTS_140)
-
- Q_mu = 140.000000d0
- tau_mu( 1) = 8.042904857756342451580167107750d0
- tau_mu( 2) = 1.135006327178704310654211440124d0
- tau_mu( 3) = 0.160983540254336005004276444197d0
-
- case(IATTENUATION_SEDIMENTS_150)
-
- Q_mu = 150.000000d0
- tau_mu( 1) = 8.037528252037535736462814384140d0
- tau_mu( 2) = 1.134347316535732730358176922891d0
- tau_mu( 3) = 0.160859567464536307168643247678d0
-
-!--- bedrock
-
- case(IATTENUATION_BEDROCK)
-
- tau_mu( 1) = 7.959142154402283786396310460987d0
- tau_mu( 2) = 1.125540477911388892451327592426d0
- tau_mu( 3) = 0.159182872336587483141912002793d0
-
- Q_mu = 9000.d0
-
- case default
-
- call exit_MPI(myrank,'wrong attenuation flag in mesh')
-
- end select
-
-!--- compute beta
- beta(:) = 1.d0 - tau_mu(:) / tau_sigma(:)
-
-!--- compute central angular frequency of source
- w_c_source = TWO_PI * f_c_source
-
-!--- quantity by which to scale mu_0 to get mu
- factor_scale_mu0 = ONE + TWO * log(f_c_source / f0_REFERENCE) / (PI * Q_mu)
-
-!--- compute a, b and Omega parameters, also compute one minus sum of betas
- a_val = ONE
- b_val = ZERO
- one_minus_sum_beta = ONE
-
- do i = 1,N_SLS
- a_val = a_val - w_c_source * w_c_source * tau_mu(i) * &
- (tau_mu(i) - tau_sigma(i)) / (1.d0 + w_c_source * w_c_source * tau_mu(i) * tau_mu(i))
- b_val = b_val + w_c_source * (tau_mu(i) - tau_sigma(i)) / &
- (1.d0 + w_c_source * w_c_source * tau_mu(i) * tau_mu(i))
- one_minus_sum_beta = one_minus_sum_beta - beta(i)
- enddo
-
- big_omega = a_val*(sqrt(1.d0 + b_val*b_val/(a_val*a_val))-1.d0)
-
-!--- quantity by which to scale mu to get mu_relaxed
- factor_scale_mu = b_val * b_val / (TWO * big_omega)
-
-!--- total factor by which to scale mu0
- factor_scale = factor_scale_mu * factor_scale_mu0
-
-!--- check that the correction factor is close to one
- if(factor_scale < 0.9 .or. factor_scale > 1.1) &
- call exit_MPI(myrank,'incorrect correction factor in attenuation model')
-
- end subroutine get_attenuation_model
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine get_attenuation_model_olsen( vs_val, iselected )
-
-! uses scaling rule similar to Olsen et al. (2003) to determine attenuation medium
-!
-! returns: selected sediment iselected
-
- implicit none
-
- include "constants.h"
-
- real(kind=CUSTOM_REAL) :: vs_val
- integer :: iselected
-
-!local parameters
- real(kind=CUSTOM_REAL) :: Q_mu
- integer :: int_Q_mu,iattenuation_sediments
-
- ! use rule Q_mu = constant * v_s
- Q_mu = OLSEN_ATTENUATION_RATIO * vs_val
- int_Q_mu = 10 * nint(Q_mu / 10.)
-
- if(int_Q_mu < 40) int_Q_mu = 40
- if(int_Q_mu > 150) int_Q_mu = 150
-
- if(int_Q_mu == 40) then
- iattenuation_sediments = IATTENUATION_SEDIMENTS_40
- else if(int_Q_mu == 50) then
- iattenuation_sediments = IATTENUATION_SEDIMENTS_50
- else if(int_Q_mu == 60) then
- iattenuation_sediments = IATTENUATION_SEDIMENTS_60
- else if(int_Q_mu == 70) then
- iattenuation_sediments = IATTENUATION_SEDIMENTS_70
- else if(int_Q_mu == 80) then
- iattenuation_sediments = IATTENUATION_SEDIMENTS_80
- else if(int_Q_mu == 90) then
- iattenuation_sediments = IATTENUATION_SEDIMENTS_90
- else if(int_Q_mu == 100) then
- iattenuation_sediments = IATTENUATION_SEDIMENTS_100
- else if(int_Q_mu == 110) then
- iattenuation_sediments = IATTENUATION_SEDIMENTS_110
- else if(int_Q_mu == 120) then
- iattenuation_sediments = IATTENUATION_SEDIMENTS_120
- else if(int_Q_mu == 130) then
- iattenuation_sediments = IATTENUATION_SEDIMENTS_130
- else if(int_Q_mu == 140) then
- iattenuation_sediments = IATTENUATION_SEDIMENTS_140
- else if(int_Q_mu == 150) then
- iattenuation_sediments = IATTENUATION_SEDIMENTS_150
- else
- stop 'incorrect attenuation coefficient'
- endif
-
- ! return sediment number
- iselected = iattenuation_sediments
-
- end subroutine get_attenuation_model_olsen
Deleted: seismo/3D/SPECFEM3D/trunk/get_cmt.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/get_cmt.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/get_cmt.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,159 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine get_cmt(yr,jda,ho,mi,sec,t_cmt,hdur,lat,long,depth,moment_tensor,NSOURCES)
-
- implicit none
-
- include "constants.h"
-
- integer yr,jda,ho,mi,NSOURCES
- double precision sec
- double precision, dimension(NSOURCES) :: t_cmt,hdur,lat,long,depth
- double precision moment_tensor(6,NSOURCES)
-
- integer mo,da,julian_day,isource
- character(len=5) datasource
- character(len=256) string, CMTSOLUTION
-
-!
-!---- read hypocenter info
-!
- call get_value_string(CMTSOLUTION, 'solver.CMTSOLUTION', 'DATA/CMTSOLUTION')
- open(unit=1,file=CMTSOLUTION,status='old',action='read')
-
-! read source number isource
- do isource=1,NSOURCES
-
- read(1,"(a256)") string
- ! skips empty lines
- do while( len_trim(string) == 0 )
- read(1,"(a256)") string
- enddo
-
- ! read header with event information
- read(string,"(a4,i5,i3,i3,i3,i3,f6.2)") datasource,yr,mo,da,ho,mi,sec
- jda=julian_day(yr,mo,da)
-
- ! ignore line with event name
- read(1,"(a)") string
-
- ! read time shift
- read(1,"(a)") string
- read(string(12:len_trim(string)),*) t_cmt(isource)
-
- ! read half duration
- read(1,"(a)") string
- read(string(15:len_trim(string)),*) hdur(isource)
-
- ! read latitude
- read(1,"(a)") string
- read(string(10:len_trim(string)),*) lat(isource)
-
- ! read longitude
- read(1,"(a)") string
- read(string(11:len_trim(string)),*) long(isource)
-
- ! read depth
- read(1,"(a)") string
- read(string(7:len_trim(string)),*) depth(isource)
-
- ! read Mrr
- read(1,"(a)") string
- read(string(5:len_trim(string)),*) moment_tensor(1,isource)
-
- ! read Mtt
- read(1,"(a)") string
- read(string(5:len_trim(string)),*) moment_tensor(2,isource)
-
- ! read Mpp
- read(1,"(a)") string
- read(string(5:len_trim(string)),*) moment_tensor(3,isource)
-
- ! read Mrt
- read(1,"(a)") string
- read(string(5:len_trim(string)),*) moment_tensor(4,isource)
-
- ! read Mrp
- read(1,"(a)") string
- read(string(5:len_trim(string)),*) moment_tensor(5,isource)
-
- ! read Mtp
- read(1,"(a)") string
- read(string(5:len_trim(string)),*) moment_tensor(6,isource)
-
- enddo
-
- close(1)
-
- !
- ! scale the moment tensor
- ! CMTSOLUTION file values are in dyne.cm
- ! 1 dyne is 1 gram * 1 cm / (1 second)^2
- ! 1 Newton is 1 kg * 1 m / (1 second)^2
- ! thus 1 Newton = 100,000 dynes
- ! therefore 1 dyne.cm = 1e-7 Newton.m
- !
- moment_tensor(:,:) = moment_tensor(:,:) * 1.d-7
-
- end subroutine get_cmt
-
-! ------------------------------------------------------------------
-
- integer function julian_day(yr,mo,da)
-
- implicit none
-
- integer yr,mo,da
-
- integer mon(12)
- integer lpyr
- data mon /0,31,59,90,120,151,181,212,243,273,304,334/
-
- julian_day = da + mon(mo)
- if(mo>2) julian_day = julian_day + lpyr(yr)
-
- end function julian_day
-
-! ------------------------------------------------------------------
-
- integer function lpyr(yr)
-
- implicit none
-
- integer yr
-!
-!---- returns 1 if leap year
-!
- lpyr=0
- if(mod(yr,400) == 0) then
- lpyr=1
- else if(mod(yr,4) == 0) then
- lpyr=1
- if(mod(yr,100) == 0) lpyr=0
- endif
-
- end function lpyr
-
Deleted: seismo/3D/SPECFEM3D/trunk/get_coupling_surfaces.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/get_coupling_surfaces.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/get_coupling_surfaces.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,308 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine get_coupling_surfaces(myrank, &
- nspec,nglob,ibool,NPROC, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
- num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
- my_neighbours_ext_mesh)
-
-! determines coupling surface for acoustic-elastic domains
-
- use create_regions_mesh_ext_par
- implicit none
-
-! number of spectral elements in each block
- integer :: myrank,nspec,nglob,NPROC
-
-! arrays with the mesh
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
-
-! MPI communication
- integer :: num_interfaces_ext_mesh,max_interface_size_ext_mesh
- integer, dimension(num_interfaces_ext_mesh) :: my_neighbours_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
-
-! local parameters
- ! (assumes NGLLX=NGLLY=NGLLZ)
- real(kind=CUSTOM_REAL),dimension(NGNOD2D) :: xcoord,ycoord,zcoord
- real(kind=CUSTOM_REAL) :: jacobian2Dw_face(NGLLX,NGLLY)
- real(kind=CUSTOM_REAL) :: normal_face(NDIM,NGLLX,NGLLY)
- real(kind=CUSTOM_REAL),dimension(:,:,:),allocatable :: tmp_normal
- real(kind=CUSTOM_REAL),dimension(:,:),allocatable :: tmp_jacobian2Dw
- integer :: ijk_face(3,NGLLX,NGLLY)
- integer,dimension(:,:,:),allocatable :: tmp_ijk
- integer,dimension(:),allocatable :: tmp_ispec
-
- integer,dimension(NGNOD2D) :: iglob_corners_ref !,iglob_corners
- integer :: ispec,i,j,k,igll,ier,iglob
- integer :: inum,iface_ref,icorner,iglob_midpoint ! iface,ispec_neighbor
- integer :: count_elastic,count_acoustic
-
- ! mpi interface communication
- integer, dimension(:), allocatable :: elastic_flag,acoustic_flag,test_flag
- integer, dimension(:,:), allocatable :: ibool_interfaces_ext_mesh_dummy
- integer :: max_nibool_interfaces_ext_mesh
- logical, dimension(:), allocatable :: mask_ibool
-
- ! corners indices of reference cube faces
- integer,dimension(3,4),parameter :: iface1_corner_ijk = &
- reshape( (/ 1,1,1, 1,NGLLY,1, 1,NGLLY,NGLLZ, 1,1,NGLLZ /),(/3,4/)) ! xmin
- integer,dimension(3,4),parameter :: iface2_corner_ijk = &
- reshape( (/ NGLLX,1,1, NGLLX,NGLLY,1, NGLLX,NGLLY,NGLLZ, NGLLX,1,NGLLZ /),(/3,4/)) ! xmax
- integer,dimension(3,4),parameter :: iface3_corner_ijk = &
- reshape( (/ 1,1,1, 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,1,1 /),(/3,4/)) ! ymin
- integer,dimension(3,4),parameter :: iface4_corner_ijk = &
- reshape( (/ 1,NGLLY,1, NGLLX,NGLLY,1, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),(/3,4/)) ! ymax
- integer,dimension(3,4),parameter :: iface5_corner_ijk = &
- reshape( (/ 1,1,1, 1,NGLLY,1, NGLLX,NGLLY,1, NGLLX,1,1 /),(/3,4/)) ! bottom
- integer,dimension(3,4),parameter :: iface6_corner_ijk = &
- reshape( (/ 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),(/3,4/)) ! top
- integer,dimension(3,4,6),parameter :: iface_all_corner_ijk = &
- reshape( (/ iface1_corner_ijk,iface2_corner_ijk, &
- iface3_corner_ijk,iface4_corner_ijk, &
- iface5_corner_ijk,iface6_corner_ijk /),(/3,4,6/)) ! all faces
- ! midpoint indices for each face (xmin,xmax,ymin,ymax,zmin,zmax)
- integer,dimension(3,6),parameter :: iface_all_midpointijk = &
- reshape( (/ 1,2,2, NGLLX,2,2, 2,1,2, 2,NGLLY,2, 2,2,1, 2,2,NGLLZ /),(/3,6/)) ! top
-
-
- ! test vtk output
- !integer,dimension(NGLLX,NGLLY,NGLLZ,NSPEC) :: gll_data
- !character(len=256):: prname_file
-
-! allocates temporary arrays
- allocate(tmp_normal(NDIM,NGLLSQUARE,nspec*6))
- allocate(tmp_jacobian2Dw(NGLLSQUARE,nspec*6))
- allocate(tmp_ijk(3,NGLLSQUARE,nspec*6))
- allocate(tmp_ispec(nspec*6))
- tmp_ispec(:) = 0
- tmp_ijk(:,:,:) = 0
- tmp_normal(:,:,:) = 0.0
- tmp_jacobian2Dw(:,:) = 0.0
-
- ! sets flags for acoustic / elastic on global points
- allocate(elastic_flag(nglob),stat=ier)
- allocate(acoustic_flag(nglob),stat=ier)
- allocate(test_flag(nglob),stat=ier)
- allocate(mask_ibool(nglob),stat=ier)
- if( ier /= 0 ) stop 'error allocate flag array'
- elastic_flag(:) = 0
- acoustic_flag(:) = 0
- test_flag(:) = 0
- count_elastic = 0
- count_acoustic = 0
- do ispec = 1, nspec
- ! counts elements
- if( ispec_is_elastic(ispec) ) count_elastic = count_elastic + 1
- if( ispec_is_acoustic(ispec) ) count_acoustic = count_acoustic + 1
-
- ! sets flags on global points
- do k = 1, NGLLZ
- do j = 1, NGLLY
- do i = 1, NGLLX
- ! global index
- iglob = ibool(i,j,k,ispec)
- ! sets elastic flag
- if( ispec_is_elastic(ispec) ) elastic_flag(iglob) = myrank+1
- ! sets acoustic flag
- if( ispec_is_acoustic(ispec) ) acoustic_flag(iglob) = myrank+1
- ! sets test flag
- test_flag(iglob) = myrank+1
- enddo
- enddo
- enddo
- enddo
- call sum_all_i(count_acoustic,inum)
- if( myrank == 0 ) then
- write(IMAIN,*) ' total acoustic elements:',inum
- endif
- call sum_all_i(count_elastic,inum)
- if( myrank == 0 ) then
- write(IMAIN,*) ' total elastic elements :',inum
- endif
-
- ! collects contributions from different MPI partitions
- ! sets up MPI communications
- max_nibool_interfaces_ext_mesh = maxval( nibool_interfaces_ext_mesh(:) )
- allocate(ibool_interfaces_ext_mesh_dummy(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh),stat=ier)
- if( ier /= 0 ) stop 'error allocating array'
- do i = 1, num_interfaces_ext_mesh
- 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, &
- 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, &
- 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, &
- num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
- nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh_dummy,&
- my_neighbours_ext_mesh)
-
- ! loops over all element faces and
- ! counts number of coupling faces between acoustic and elastic elements
- mask_ibool(:) = .false.
- inum = 0
- do ispec=1,nspec
-
- ! loops over each face
- do iface_ref= 1, 6
-
- ! takes indices of corners of reference face
- do icorner = 1,NGNOD2D
- i = iface_all_corner_ijk(1,icorner,iface_ref)
- j = iface_all_corner_ijk(2,icorner,iface_ref)
- k = iface_all_corner_ijk(3,icorner,iface_ref)
- ! global reference indices
- iglob_corners_ref(icorner) = ibool(i,j,k,ispec)
-
- ! reference corner coordinates
- xcoord(icorner) = xstore_dummy(iglob_corners_ref(icorner))
- ycoord(icorner) = ystore_dummy(iglob_corners_ref(icorner))
- zcoord(icorner) = zstore_dummy(iglob_corners_ref(icorner))
- enddo
-
- ! checks if face has acoustic side
- if( acoustic_flag( iglob_corners_ref(1) ) >= 1 .and. &
- acoustic_flag( iglob_corners_ref(2) ) >= 1 .and. &
- acoustic_flag( iglob_corners_ref(3) ) >= 1 .and. &
- acoustic_flag( iglob_corners_ref(4) ) >= 1) then
- ! checks if face is has an elastic side
- if( elastic_flag( iglob_corners_ref(1) ) >= 1 .and. &
- elastic_flag( iglob_corners_ref(2) ) >= 1 .and. &
- elastic_flag( iglob_corners_ref(3) ) >= 1 .and. &
- elastic_flag( iglob_corners_ref(4) ) >= 1) then
-
- ! reference midpoint on face (used to avoid redundant face counting)
- i = iface_all_midpointijk(1,iface_ref)
- j = iface_all_midpointijk(2,iface_ref)
- k = iface_all_midpointijk(3,iface_ref)
- iglob_midpoint = ibool(i,j,k,ispec)
-
- ! checks if points on this face are masked already
- if( .not. mask_ibool(iglob_midpoint) ) then
-
- ! gets face GLL points i,j,k indices from element face
- call get_element_face_gll_indices(iface_ref,ijk_face,NGLLX,NGLLY)
-
- ! takes each element face only once, if it lies on an MPI interface
- ! note: this is not exactly load balanced
- ! lowest rank process collects as many faces as possible, second lowest as so forth
- if( (test_flag(iglob_midpoint) == myrank+1) .or. &
- (test_flag(iglob_midpoint) > 2*(myrank+1)) ) then
-
- ! gets face GLL 2Djacobian, weighted from element face
- call get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob, &
- dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
- ispec,iface_ref,jacobian2Dw_face,normal_face,NGLLX,NGLLY)
-
- ! normal convention: points away from acoustic, reference element
- ! switch normal direction if necessary
- do j=1,NGLLY
- 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, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- normal_face(:,i,j) )
- ! makes sure that it always points away from acoustic element,
- ! otherwise switch direction
- if( ispec_is_elastic(ispec) ) normal_face(:,i,j) = - normal_face(:,i,j)
- enddo
- enddo
-
- ! stores informations about this face
- inum = inum + 1
- tmp_ispec(inum) = ispec
- igll = 0
- do j=1,NGLLY
- do i=1,NGLLX
- ! adds all gll points on this face
- igll = igll + 1
-
- ! do we need to store local i,j,k,ispec info? or only global indices iglob?
- tmp_ijk(:,igll,inum) = ijk_face(:,i,j)
-
- ! stores weighted jacobian and normals
- tmp_jacobian2Dw(igll,inum) = jacobian2Dw_face(i,j)
- tmp_normal(:,igll,inum) = normal_face(:,i,j)
-
- ! masks global points ( to avoid redundant counting of faces)
- iglob = ibool(ijk_face(1,i,j),ijk_face(2,i,j),ijk_face(3,i,j),ispec)
- mask_ibool(iglob) = .true.
- enddo
- enddo
- else
- ! assumes to be already collected by lower rank process, masks face points
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(ijk_face(1,i,j),ijk_face(2,i,j),ijk_face(3,i,j),ispec)
- mask_ibool(iglob) = .true.
- enddo
- enddo
- endif ! test_flag
- endif ! mask_ibool
- endif ! elastic_flag
- endif ! acoustic_flag
- enddo ! iface_ref
- enddo ! ispec
-
-! stores completed coupling face informations
-!
-! note: no need to store material parameters on these coupling points
-! for acoustic-elastic interface
- num_coupling_ac_el_faces = inum
- allocate(coupling_ac_el_normal(NDIM,NGLLSQUARE,num_coupling_ac_el_faces))
- allocate(coupling_ac_el_jacobian2Dw(NGLLSQUARE,num_coupling_ac_el_faces))
- allocate(coupling_ac_el_ijk(3,NGLLSQUARE,num_coupling_ac_el_faces))
- allocate(coupling_ac_el_ispec(num_coupling_ac_el_faces))
- do inum = 1,num_coupling_ac_el_faces
- coupling_ac_el_normal(:,:,inum) = tmp_normal(:,:,inum)
- coupling_ac_el_jacobian2Dw(:,inum) = tmp_jacobian2Dw(:,inum)
- coupling_ac_el_ijk(:,:,inum) = tmp_ijk(:,:,inum)
- coupling_ac_el_ispec(inum) = tmp_ispec(inum)
- enddo
-
-! user output
- call sum_all_i(num_coupling_ac_el_faces,inum)
- if( myrank == 0 ) then
- write(IMAIN,*) ' acoustic-elastic coupling:'
- write(IMAIN,*) ' total number of faces = ',inum
- endif
-
- end subroutine get_coupling_surfaces
-
Deleted: seismo/3D/SPECFEM3D/trunk/get_element_face.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/get_element_face.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/get_element_face.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,538 +0,0 @@
-!
-!----
-!
-
-subroutine get_element_face_id(ispec,xcoord,ycoord,zcoord,&
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- iface_id )
-
-! returns iface_id of face in reference element, determined by corner locations xcoord/ycoord/zcoord;
-
- implicit none
-
- include "constants.h"
-
- integer :: ispec,nspec,nglob,iface_id
-
-! face corner locations
- real(kind=CUSTOM_REAL),dimension(NGNOD2D) :: xcoord,ycoord,zcoord
-
-! index array
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
-
-! global point locations
- real(kind=CUSTOM_REAL) :: xstore_dummy(nglob),ystore_dummy(nglob),zstore_dummy(nglob)
-
-! local parameters
- real(kind=CUSTOM_REAL),dimension(NGNOD2D) :: xcoord_face,ycoord_face,zcoord_face
- real(kind=CUSTOM_REAL) :: midpoint_faces(NDIM,6),midpoint(NDIM),midpoint_distances(6)
-
-! corners indices of reference cube faces
- ! shapes of arrays below
- integer,dimension(2),parameter :: face_shape = (/3,4/)
- integer,dimension(3),parameter :: all_faces_shape = (/3,4,6/)
-
- ! xmin
- integer,dimension(3,4),parameter :: iface1_corner_ijk = &
- reshape((/ 1,1,1, 1,NGLLY,1, 1,NGLLY,NGLLZ, 1,1,NGLLZ /),face_shape)
- ! xmax
- integer,dimension(3,4),parameter :: iface2_corner_ijk = &
- reshape((/ NGLLX,1,1, NGLLX,NGLLY,1, NGLLX,NGLLY,NGLLZ, NGLLX,1,NGLLZ /),face_shape)
- ! ymin
- integer,dimension(3,4),parameter :: iface3_corner_ijk = &
- reshape((/ 1,1,1, 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,1,1 /),face_shape)
- ! ymax
- integer,dimension(3,4),parameter :: iface4_corner_ijk = &
- reshape((/ 1,NGLLY,1, NGLLX,NGLLY,1, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),face_shape)
- ! bottom
- integer,dimension(3,4),parameter :: iface5_corner_ijk = &
- reshape((/ 1,1,1, 1,NGLLY,1, NGLLX,NGLLY,1, NGLLX,1,1 /),face_shape)
- ! top
- integer,dimension(3,4),parameter :: iface6_corner_ijk = &
- reshape((/ 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),face_shape)
- ! all faces
- integer,dimension(3,4,6),parameter :: iface_all_corner_ijk = &
- reshape((/ iface1_corner_ijk,iface2_corner_ijk, &
- iface3_corner_ijk,iface4_corner_ijk, &
- iface5_corner_ijk,iface6_corner_ijk /),all_faces_shape)
-
-! face orientation
- !real(kind=CUSTOM_REAL) :: face_n(3),face_ntmp(3),tmp
- integer :: ifa,icorner,i,j,k,iglob,iloc(1)
-
-! initializes
- iface_id = -1
-
-! gets face midpoint by its corners
- midpoint(:) = 0.0
- do icorner=1,NGNOD2D
- midpoint(1) = midpoint(1) + xcoord(icorner)
- midpoint(2) = midpoint(2) + ycoord(icorner)
- midpoint(3) = midpoint(3) + zcoord(icorner)
- enddo
- midpoint(:) = midpoint(:) / 4.0
-
- ! checks: this holds only for planar face
- !if( midpoint(1) /= (xcoord(1)+xcoord(3))/2.0 .or. midpoint(1) /= (xcoord(2)+xcoord(4))/2.0 ) then
- ! print*,'error midpoint x:',midpoint(1),(xcoord(1)+xcoord(3))/2.0,(xcoord(2)+xcoord(4))/2.0
- !endif
- !if( midpoint(2) /= (ycoord(1)+ycoord(3))/2.0 .or. midpoint(2) /= (ycoord(2)+ycoord(4))/2.0 ) then
- ! print*,'error midpoint y:',midpoint(1),(ycoord(1)+ycoord(3))/2.0,(ycoord(2)+ycoord(4))/2.0
- !endif
- !if( midpoint(3) /= (zcoord(1)+zcoord(3))/2.0 .or. midpoint(3) /= (zcoord(2)+zcoord(4))/2.0 ) then
- ! print*,'error midpoint z:',midpoint(1),(zcoord(1)+zcoord(3))/2.0,(zcoord(2)+zcoord(4))/2.0
- !endif
-
-! determines element face by minimum distance of midpoints
- midpoint_faces(:,:) = 0.0
- do ifa=1,6
- ! face corners
- do icorner = 1,NGNOD2D
- i = iface_all_corner_ijk(1,icorner,ifa)
- j = iface_all_corner_ijk(2,icorner,ifa)
- k = iface_all_corner_ijk(3,icorner,ifa)
- !print*,'corner:',i,j,k,ispec
-
- ! coordinates
- iglob = ibool(i,j,k,ispec)
- xcoord_face(icorner) = xstore_dummy(iglob)
- ycoord_face(icorner) = ystore_dummy(iglob)
- zcoord_face(icorner) = zstore_dummy(iglob)
-
- ! face midpoint coordinates
- midpoint_faces(1,ifa) = midpoint_faces(1,ifa) + xcoord_face(icorner)
- midpoint_faces(2,ifa) = midpoint_faces(2,ifa) + ycoord_face(icorner)
- midpoint_faces(3,ifa) = midpoint_faces(3,ifa) + zcoord_face(icorner)
- enddo
- midpoint_faces(:,ifa) = midpoint_faces(:,ifa) / 4.0
-
- ! distance
- midpoint_distances(ifa) = (midpoint(1)-midpoint_faces(1,ifa))**2 &
- + (midpoint(2)-midpoint_faces(2,ifa))**2 &
- + (midpoint(3)-midpoint_faces(3,ifa))**2
- enddo
-
-! gets closest point, which determines face
- iloc = minloc(midpoint_distances)
-
- ! checks that found midpoint is close enough
- !print*,'face:', midpoint_distances(iloc(1))
- if( midpoint_distances(iloc(1)) > 1.e-5 * &
- ( (xcoord(1)-xcoord(2))**2 &
- + (ycoord(1)-ycoord(2))**2 &
- + (zcoord(1)-zcoord(2))**2 ) ) then
- print*,'error element face midpoint distance:',midpoint_distances(iloc(1)),(xcoord(1)-xcoord(2))**2
- ! corner locations
- do icorner=1,NGNOD2D
- i = iface_all_corner_ijk(1,icorner,iloc(1))
- j = iface_all_corner_ijk(2,icorner,iloc(1))
- k = iface_all_corner_ijk(3,icorner,iloc(1))
- iglob = ibool(i,j,k,ispec)
- print*,'error corner:',icorner,'xyz:',xstore_dummy(iglob),ystore_dummy(iglob),zstore_dummy(iglob)
- enddo
- ! stop
- stop 'error element face midpoint'
- else
- iface_id = iloc(1)
-
- !print*,'face:',iface_id
- !do icorner=1,NGNOD2D
- ! i = iface_all_corner_ijk(1,icorner,iloc(1))
- ! j = iface_all_corner_ijk(2,icorner,iloc(1))
- ! k = iface_all_corner_ijk(3,icorner,iloc(1))
- ! iglob = ibool(i,j,k,ispec)
- ! print*,'corner:',icorner,'xyz:',sngl(xstore_dummy(iglob)), &
- ! sngl(ystore_dummy(iglob)),sngl(zstore_dummy(iglob))
- !enddo
-
- endif
-
-end subroutine get_element_face_id
-
-!
-!----
-!
-
-subroutine get_element_face_gll_indices(iface,ijk_face,NGLLA,NGLLB )
-
-! returns local indices in ijk_face for specified face
-
- implicit none
-
- include "constants.h"
-
- integer :: iface !,nspec,nglob
-
-! gll point indices i,j,k for face, format corresponds to ijk_face(1,*) = i, ijk_face(2,*) = j, ijk_face(3,*) = k
- integer :: NGLLA,NGLLB
- integer,dimension(3,NGLLA,NGLLB) :: ijk_face
-
-! integer :: icorner,i,j,k,iglob,iloc(1)
- integer :: i,j,k
- integer :: ngll,i_gll,j_gll,k_gll
-
-! sets i,j,k indices of GLL points on boundary face
- ngll = 0
- select case( iface )
-
- ! reference xmin face
- case(1)
- if( NGLLA /= NGLLY .or. NGLLB /= NGLLZ ) stop 'error absorbing face 1 indexing'
- i_gll = 1
- do k=1,NGLLZ
- do j=1,NGLLY
- ngll = ngll + 1
- ijk_face(1,j,k) = i_gll
- ijk_face(2,j,k) = j
- ijk_face(3,j,k) = k
- enddo
- enddo
-
- ! reference xmax face
- case(2)
- if( NGLLA /= NGLLY .or. NGLLB /= NGLLZ ) stop 'error absorbing face 2 indexing'
- i_gll = NGLLX
- do k=1,NGLLZ
- do j=1,NGLLY
- ngll = ngll + 1
- ijk_face(1,j,k) = i_gll
- ijk_face(2,j,k) = j
- ijk_face(3,j,k) = k
- enddo
- enddo
-
- ! reference ymin face
- case(3)
- if( NGLLA /= NGLLX .or. NGLLB /= NGLLZ ) stop 'error absorbing face 3 indexing'
- j_gll = 1
- do k=1,NGLLZ
- do i=1,NGLLX
- ngll = ngll + 1
- ijk_face(1,i,k) = i
- ijk_face(2,i,k) = j_gll
- ijk_face(3,i,k) = k
- enddo
- enddo
-
- ! reference ymax face
- case(4)
- if( NGLLA /= NGLLX .or. NGLLB /= NGLLZ ) stop 'error absorbing face 4 indexing'
- j_gll = NGLLY
- do k=1,NGLLZ
- do i=1,NGLLX
- ngll = ngll + 1
- ijk_face(1,i,k) = i
- ijk_face(2,i,k) = j_gll
- ijk_face(3,i,k) = k
- enddo
- enddo
-
- ! reference bottom face
- case(5)
- if( NGLLA /= NGLLX .or. NGLLB /= NGLLY ) stop 'error absorbing face 5 indexing'
- k_gll = 1
- do j=1,NGLLY
- do i=1,NGLLX
- ngll = ngll + 1
- ijk_face(1,i,j) = i
- ijk_face(2,i,j) = j
- ijk_face(3,i,j) = k_gll
- enddo
- enddo
-
- ! reference bottom face
- case(6)
- if( NGLLA /= NGLLX .or. NGLLB /= NGLLY ) stop 'error absorbing face 6 indexing'
- k_gll = NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- ngll = ngll + 1
- ijk_face(1,i,j) = i
- ijk_face(2,i,j) = j
- ijk_face(3,i,j) = k_gll
- enddo
- enddo
-
- case default
- stop 'error element face not found'
-
- end select
-
- ! checks number of gll points set on face
- if( ngll /= NGLLA*NGLLB ) then
- print*,'error element face ngll:',ngll,NGLLA,NGLLB
- stop 'error element face ngll'
- endif
-!
-!! corner locations
-! do icorner=1,NGNOD2D
-! i = iface_all_corner_ijk(1,icorner,iface)
-! j = iface_all_corner_ijk(2,icorner,iface)
-! k = iface_all_corner_ijk(3,icorner,iface)
-! iglob = ibool(i,j,k,ispec)
-! xcoord_iboun(icorner) = xstore_dummy(iglob)
-! ycoord_iboun(icorner) = ystore_dummy(iglob)
-! zcoord_iboun(icorner) = zstore_dummy(iglob)
-! ! looks at values
-! !print*,'corner:',icorner,'xyz:',sngl(xcoord_iboun(icorner)),sngl(ycoord_iboun(icorner)),sngl(zcoord_iboun(icorner))
-! enddo
-!
-!! determines initial orientation given by three corners of the face
-! ! (CUBIT orders corners such that normal points outwards of element)
-! ! cross-product of vectors from corner 1 to corner 2 and from corner 1 to corner 3
-! face_n(1) = (ycoord(2)-ycoord(1))*(zcoord(3)-zcoord(1)) - (zcoord(2)-zcoord(1))*(ycoord(3)-ycoord(1))
-! face_n(2) = - (xcoord(2)-xcoord(1))*(zcoord(3)-zcoord(1)) + (zcoord(2)-zcoord(1))*(xcoord(3)-xcoord(1))
-! face_n(3) = (xcoord(2)-xcoord(1))*(ycoord(3)-ycoord(1)) - (ycoord(2)-ycoord(1))*(xcoord(3)-xcoord(1))
-! face_n(:) = face_n(:)/(sqrt( face_n(1)**2 + face_n(2)**2 + face_n(3)**2) )
-!
-!! checks that this normal direction is outwards of element:
-! ! takes additional corner out of face plane and determines scalarproduct to normal
-! select case( iface )
-! case(1) ! opposite to xmin face
-! iglob = ibool(NGLLX,1,1,ispec)
-! case(2) ! opposite to xmax face
-! iglob = ibool(1,1,1,ispec)
-! case(3) ! opposite to ymin face
-! iglob = ibool(1,NGLLY,1,ispec)
-! case(4) ! opposite to ymax face
-! iglob = ibool(1,1,1,ispec)
-! case(5) ! opposite to bottom
-! iglob = ibool(1,1,NGLLZ,ispec)
-! case(6) ! opposite to top
-! iglob = ibool(1,1,1,ispec)
-! end select
-! ! vector from corner 1 to this opposite one
-! xcoord(4) = xstore_dummy(iglob) - xcoord(1)
-! ycoord(4) = ystore_dummy(iglob) - ycoord(1)
-! zcoord(4) = zstore_dummy(iglob) - zcoord(1)
-!
-! ! scalarproduct
-! tmp = xcoord(4)*face_n(1) + ycoord(4)*face_n(2) + zcoord(4)*face_n(3)
-!
-! ! makes sure normal points outwards, that is points away from this additional corner and scalarproduct is negative
-! if( tmp > 0.0 ) then
-! face_n(:) = - face_n(:)
-! endif
-! !print*,'face ',iface,'scalarproduct:',tmp
-!
-!! determines orientation of gll corner locations and sets it such that normal points outwards
-! ! cross-product
-! face_ntmp(1) = (ycoord_iboun(2)-ycoord_iboun(1))*(zcoord_iboun(3)-zcoord_iboun(1)) &
-! - (zcoord_iboun(2)-zcoord_iboun(1))*(ycoord_iboun(3)-ycoord_iboun(1))
-! face_ntmp(2) = - (xcoord_iboun(2)-xcoord_iboun(1))*(zcoord_iboun(3)-zcoord_iboun(1)) &
-! + (zcoord_iboun(2)-zcoord_iboun(1))*(xcoord_iboun(3)-xcoord_iboun(1))
-! face_ntmp(3) = (xcoord_iboun(2)-xcoord_iboun(1))*(ycoord_iboun(3)-ycoord_iboun(1))&
-! - (ycoord_iboun(2)-ycoord_iboun(1))*(xcoord_iboun(3)-xcoord_iboun(1))
-! face_ntmp(:) = face_ntmp(:)/(sqrt( face_ntmp(1)**2 + face_ntmp(2)**2 + face_ntmp(3)**2) )
-! if( abs( (face_n(1)-face_ntmp(1))**2+(face_n(2)-face_ntmp(2))**2+(face_n(3)-face_ntmp(3))**2) > 0.1 ) then
-! !print*,'error orientation face 1:',ispec,face_n(:)
-! !swap corners 2 and 4 ( switches clockwise / anti-clockwise )
-! tmp = xcoord_iboun(2)
-! xcoord_iboun(2) = xcoord_iboun(4)
-! xcoord_iboun(4) = tmp
-! tmp = ycoord_iboun(2)
-! ycoord_iboun(2) = ycoord_iboun(4)
-! ycoord_iboun(4) = tmp
-! tmp = zcoord_iboun(2)
-! zcoord_iboun(2) = zcoord_iboun(4)
-! zcoord_iboun(4) = tmp
-! endif
-
-end subroutine get_element_face_gll_indices
-
-!
-!----
-!
-
-subroutine get_element_face_normal(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- normal)
-
-! only changes direction of normal to point outwards of element
-
- implicit none
-
- include "constants.h"
-
- integer :: ispec,iface,nspec,nglob
-
-! face corner locations
- real(kind=CUSTOM_REAL),dimension(NGNOD2D) :: xcoord,ycoord,zcoord
-
-! index array
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
-
-! global point locations
- real(kind=CUSTOM_REAL),dimension(nglob) :: xstore_dummy,ystore_dummy,zstore_dummy
-
-! face normal
- real(kind=CUSTOM_REAL),dimension(NDIM) :: normal
-
-! local parameters
- real(kind=CUSTOM_REAL) :: face_n(3),tmp,v_tmp(3)
- integer :: iglob
-
-! determines initial orientation given by three corners on the face
- ! cross-product of vectors from corner 1 to corner 2 and from corner 1 to corner 3
- face_n(1) = (ycoord(2)-ycoord(1))*(zcoord(3)-zcoord(1)) - (zcoord(2)-zcoord(1))*(ycoord(3)-ycoord(1))
- face_n(2) = - (xcoord(2)-xcoord(1))*(zcoord(3)-zcoord(1)) + (zcoord(2)-zcoord(1))*(xcoord(3)-xcoord(1))
- face_n(3) = (xcoord(2)-xcoord(1))*(ycoord(3)-ycoord(1)) - (ycoord(2)-ycoord(1))*(xcoord(3)-xcoord(1))
- tmp = sqrt( face_n(1)*face_n(1) + face_n(2)*face_n(2) + face_n(3)*face_n(3) )
- if( abs(tmp) < TINYVAL ) then
- print*,'error get face normal: length',tmp
- print*,'normal:',face_n(:)
- call exit_mpi(0,'error get element face normal')
- endif
- face_n(:) = face_n(:)/tmp
-
-! checks that this normal direction is outwards of element:
- ! takes additional corner out of face plane and determines scalarproduct to normal
- select case( iface )
- case(1) ! opposite to xmin face
- iglob = ibool(NGLLX,1,1,ispec)
- case(2) ! opposite to xmax face
- iglob = ibool(1,1,1,ispec)
- case(3) ! opposite to ymin face
- iglob = ibool(1,NGLLY,1,ispec)
- case(4) ! opposite to ymax face
- iglob = ibool(1,1,1,ispec)
- case(5) ! opposite to bottom
- iglob = ibool(1,1,NGLLZ,ispec)
- case(6) ! opposite to top
- iglob = ibool(1,1,1,ispec)
- end select
- ! vector from corner 1 to this opposite one
- v_tmp(1) = xstore_dummy(iglob) - xcoord(1)
- v_tmp(2) = ystore_dummy(iglob) - ycoord(1)
- v_tmp(3) = zstore_dummy(iglob) - zcoord(1)
-
- ! scalarproduct
- tmp = v_tmp(1)*face_n(1) + v_tmp(2)*face_n(2) + v_tmp(3)*face_n(3)
-
- ! makes sure normal points outwards, that is points away from this additional corner and scalarproduct is negative
- if( tmp > 0.0 ) then
- face_n(:) = - face_n(:)
- endif
-
-! in case given normal has zero length, sets it to computed face normal
- if( ( normal(1)**2 + normal(2)**2 + normal(3)**2 ) < TINYVAL ) then
- normal(:) = face_n(:)
- return
- endif
-
-! otherwise determines orientation of normal and flips direction such that normal points outwards
- tmp = face_n(1)*normal(1) + face_n(2)*normal(2) + face_n(3)*normal(3)
- if( tmp < 0.0 ) then
- !print*,'element face normal: orientation ',ispec,iface,tmp
- !print*,'face normal: ',face_n(:)
- !print*,' normal: ',normal(:)
- !swap
- normal(:) = - normal(:)
- endif
- !print*,'face ',iface,'scalarproduct:',tmp
-
-end subroutine get_element_face_normal
-
-!
-!----
-!
-
-subroutine get_element_face_normal_idirect(ispec,iface,xcoord,ycoord,zcoord, &
- ibool,nspec,nglob, &
- xstore_dummy,ystore_dummy,zstore_dummy, &
- normal,idirect)
-
-! returns direction of normal:
-! idirect = 1 to point outwards of/away from element
-! idirect = 2 to point into element
-
- implicit none
-
- include "constants.h"
-
- integer :: ispec,iface,nspec,nglob
-
-! face corner locations
- real(kind=CUSTOM_REAL),dimension(NGNOD2D) :: xcoord,ycoord,zcoord
-
-! index array
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
-
-! global point locations
- real(kind=CUSTOM_REAL) :: xstore_dummy(nglob),ystore_dummy(nglob),zstore_dummy(nglob)
-
-! face normal
- real(kind=CUSTOM_REAL),dimension(NDIM) :: normal
-
-! direction type
- integer, intent(out) :: idirect
-
-! local parameters
- real(kind=CUSTOM_REAL) :: face_n(3),tmp,v_tmp(3)
- integer :: iglob
-
-! initializes
- idirect = 0
-
-! determines initial orientation given by three corners on the face
- ! cross-product of vectors from corner 1 to corner 2 and from corner 1 to corner 3
- face_n(1) = (ycoord(2)-ycoord(1))*(zcoord(3)-zcoord(1)) - (zcoord(2)-zcoord(1))*(ycoord(3)-ycoord(1))
- face_n(2) = - (xcoord(2)-xcoord(1))*(zcoord(3)-zcoord(1)) + (zcoord(2)-zcoord(1))*(xcoord(3)-xcoord(1))
- face_n(3) = (xcoord(2)-xcoord(1))*(ycoord(3)-ycoord(1)) - (ycoord(2)-ycoord(1))*(xcoord(3)-xcoord(1))
- tmp = sqrt( face_n(1)**2 + face_n(2)**2 + face_n(3)**2 )
- if( abs(tmp) < TINYVAL ) then
- print*,'error get face normal: length',tmp
- print*,'normal:',face_n(:)
- call exit_mpi(0,'error get element face normal')
- endif
- face_n(:) = face_n(:)/tmp
-
-! checks that this normal direction is outwards of element:
- ! takes additional corner out of face plane and determines scalarproduct to normal
- select case( iface )
- case(1) ! opposite to xmin face
- iglob = ibool(NGLLX,1,1,ispec)
- case(2) ! opposite to xmax face
- iglob = ibool(1,1,1,ispec)
- case(3) ! opposite to ymin face
- iglob = ibool(1,NGLLY,1,ispec)
- case(4) ! opposite to ymax face
- iglob = ibool(1,1,1,ispec)
- case(5) ! opposite to bottom
- iglob = ibool(1,1,NGLLZ,ispec)
- case(6) ! opposite to top
- iglob = ibool(1,1,1,ispec)
- end select
- ! vector from corner 1 to this opposite one
- v_tmp(1) = xstore_dummy(iglob) - xcoord(1)
- v_tmp(2) = ystore_dummy(iglob) - ycoord(1)
- v_tmp(3) = zstore_dummy(iglob) - zcoord(1)
-
- ! scalarproduct
- tmp = v_tmp(1)*face_n(1) + v_tmp(2)*face_n(2) + v_tmp(3)*face_n(3)
-
- ! makes sure normal points outwards, that is points away from this additional corner and scalarproduct is negative
- if( tmp > 0.0 ) then
- face_n(:) = - face_n(:)
- endif
-
-! in case given normal has zero length, exit
- if( ( normal(1)**2 + normal(2)**2 + normal(3)**2 ) < TINYVAL ) then
- print*,'problem: given normal is zero'
- return
- endif
-
-! otherwise determines orientation of normal
- tmp = face_n(1)*normal(1) + face_n(2)*normal(2) + face_n(3)*normal(3)
- if( tmp < 0.0 ) then
- ! points into element
- idirect = 2
- else
- ! points away from element/ outwards
- idirect = 1
- endif
-
-end subroutine get_element_face_normal_idirect
-
Deleted: seismo/3D/SPECFEM3D/trunk/get_global.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/get_global.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/get_global.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,300 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine get_global(nspec,xp,yp,zp,iglob,loc,ifseg,nglob,npointot,UTM_X_MIN,UTM_X_MAX)
-
-! this routine MUST be in double precision to avoid sensitivity
-! to roundoff errors in the coordinates of the points
-
-! non-structured global numbering software provided by Paul F. Fischer
-
-! leave the sorting subroutines in the same source file to allow for inlining
-
- implicit none
-
- include "constants.h"
-
-
- integer npointot
- integer nspec,nglob
- integer iglob(npointot),loc(npointot)
- logical ifseg(npointot)
- double precision xp(npointot),yp(npointot),zp(npointot)
- double precision UTM_X_MIN,UTM_X_MAX
-
- integer ispec,i,j,ier
- integer ieoff,ilocnum,nseg,ioff,iseg,ig
-
- integer, dimension(:), allocatable :: ind,ninseg,iwork
- double precision, dimension(:), allocatable :: work
-
-! geometry tolerance parameter to calculate number of independent grid points
-! small value for double precision and to avoid sensitivity to roundoff
- double precision SMALLVALTOL
-
-! number of points per spectral element
- integer, parameter :: NGLLCUBE = NGLLX * NGLLY * NGLLZ
-! for vectorization of loops
-! integer, parameter :: NGLLCUBE_NDIM = NGLLCUBE * NDIM
-
-
-! define geometrical tolerance based upon typical size of the model
- SMALLVALTOL = 1.d-10 * dabs(UTM_X_MAX - UTM_X_MIN)
-
-! dynamically allocate arrays
- allocate(ind(npointot), &
- ninseg(npointot), &
- iwork(npointot), &
- work(npointot),stat=ier)
- if( ier /= 0 ) stop 'error allocating arrays'
-
-! establish initial pointers
- do ispec=1,nspec
- ieoff=NGLLCUBE*(ispec-1)
- do ilocnum=1,NGLLCUBE
- loc(ilocnum+ieoff)=ilocnum+ieoff
- enddo
- enddo
-
- ifseg(:)=.false.
-
- nseg=1
- ifseg(1)=.true.
- ninseg(1)=npointot
-
- do j=1,NDIM
-
-! sort within each segment
- ioff=1
- do iseg=1,nseg
- if(j == 1) then
- call rank(xp(ioff),ind,ninseg(iseg))
- else if(j == 2) then
- call rank(yp(ioff),ind,ninseg(iseg))
- else
- call rank(zp(ioff),ind,ninseg(iseg))
- endif
- call swap_all(loc(ioff),xp(ioff),yp(ioff),zp(ioff),iwork,work,ind,ninseg(iseg))
- ioff=ioff+ninseg(iseg)
- enddo
-
-! check for jumps in current coordinate
-! compare the coordinates of the points within a small tolerance
- if(j == 1) then
- do i=2,npointot
- if(dabs(xp(i)-xp(i-1)) > SMALLVALTOL) ifseg(i)=.true.
- enddo
- else if(j == 2) then
- do i=2,npointot
- if(dabs(yp(i)-yp(i-1)) > SMALLVALTOL) ifseg(i)=.true.
- enddo
- else
- do i=2,npointot
- if(dabs(zp(i)-zp(i-1)) > SMALLVALTOL) ifseg(i)=.true.
- enddo
- endif
-
-! count up number of different segments
- nseg=0
- do i=1,npointot
- if(ifseg(i)) then
- nseg=nseg+1
- ninseg(nseg)=1
- else
- ninseg(nseg)=ninseg(nseg)+1
- endif
- enddo
- enddo
-
-! assign global node numbers (now sorted lexicographically)
- ig=0
- do i=1,npointot
- if(ifseg(i)) ig=ig+1
- iglob(loc(i))=ig
- enddo
-
- nglob=ig
-
-! deallocate arrays
- deallocate(ind)
- deallocate(ninseg)
- deallocate(iwork)
- deallocate(work)
-
- end subroutine get_global
-
-! -----------------------------------
-
-! sorting routines put in same file to allow for inlining
-
- subroutine rank(A,IND,N)
-!
-! Use Heap Sort (Numerical Recipes)
-!
- implicit none
-
- integer n
- double precision A(n)
- integer IND(n)
-
- integer i,j,l,ir,indx
- double precision q
-
- do j=1,n
- IND(j)=j
- enddo
-
- if (n == 1) return
-
- L=n/2+1
- ir=n
- 100 CONTINUE
- IF (l>1) THEN
- l=l-1
- indx=ind(l)
- q=a(indx)
- ELSE
- indx=ind(ir)
- q=a(indx)
- ind(ir)=ind(1)
- ir=ir-1
- if (ir == 1) then
- ind(1)=indx
- return
- endif
- ENDIF
- i=l
- j=l+l
- 200 CONTINUE
- IF (J <= IR) THEN
- IF (J<IR) THEN
- IF ( A(IND(j))<A(IND(j+1)) ) j=j+1
- ENDIF
- IF (q<A(IND(j))) THEN
- IND(I)=IND(J)
- I=J
- J=J+J
- ELSE
- J=IR+1
- ENDIF
- goto 200
- ENDIF
- IND(I)=INDX
- goto 100
-
- end subroutine rank
-
-! ------------------------------------------------------------------
-
- subroutine swap_all(IA,A,B,C,IW,W,ind,n)
-!
-! swap arrays IA, A, B and C according to addressing in array IND
-!
- implicit none
-
- integer n
-
- integer IND(n)
- integer IA(n),IW(n)
- double precision A(n),B(n),C(n),W(n)
-
- integer i
-
- IW(:) = IA(:)
- W(:) = A(:)
-
- do i=1,n
- IA(i)=IW(ind(i))
- A(i)=W(ind(i))
- enddo
-
- W(:) = B(:)
-
- do i=1,n
- B(i)=W(ind(i))
- enddo
-
- W(:) = C(:)
-
- do i=1,n
- C(i)=W(ind(i))
- enddo
-
-end subroutine swap_all
-
-! ------------------------------------------------------------------
-
-
- subroutine get_global_indirect_addressing(nspec,nglob,ibool)
-
-!
-!- we can create a new indirect addressing to reduce cache misses
-! (put into this subroutine but compiler keeps on complaining that it can't vectorize loops...)
-
- implicit none
-
- include "constants.h"
-
- integer :: nspec,nglob
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
-
-! mask to sort ibool
- integer, dimension(:), allocatable :: mask_ibool
- integer, dimension(:,:,:,:), allocatable :: copy_ibool_ori
- integer :: inumber
- integer:: i,j,k,ispec,ier
-
-! copies original array
- allocate(copy_ibool_ori(NGLLX,NGLLY,NGLLZ,nspec),stat=ier); if(ier /= 0) stop 'error in allocate'
- allocate(mask_ibool(nglob),stat=ier); if(ier /= 0) stop 'error in allocate'
-
- mask_ibool(:) = -1
- copy_ibool_ori(:,:,:,:) = ibool(:,:,:,:)
-
-! reduces misses
- inumber = 0
- do ispec=1,nspec
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- if(mask_ibool(copy_ibool_ori(i,j,k,ispec)) == -1) then
-! create a new point
- inumber = inumber + 1
- ibool(i,j,k,ispec) = inumber
- mask_ibool(copy_ibool_ori(i,j,k,ispec)) = inumber
- else
-! use an existing point created previously
- ibool(i,j,k,ispec) = mask_ibool(copy_ibool_ori(i,j,k,ispec))
- endif
- enddo
- enddo
- enddo
- enddo
-
-! cleanup
- deallocate(copy_ibool_ori,stat=ier); if(ier /= 0) stop 'error in deallocate'
- deallocate(mask_ibool,stat=ier); if(ier /= 0) stop 'error in deallocate'
-
-end subroutine get_global_indirect_addressing
Deleted: seismo/3D/SPECFEM3D/trunk/get_jacobian_boundaries.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/get_jacobian_boundaries.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/get_jacobian_boundaries.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,932 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-
- subroutine get_jacobian_boundary_face(myrank,nspec, &
- xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob,&
- dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
- ispec,iface,jacobian2Dw_face,normal_face,NGLLA,NGLLB)
-
-! returns jacobian2Dw_face and normal_face (pointing outwards of element)
-
- implicit none
-
- include "constants.h"
-
- integer nspec,myrank,nglob
-
-! arrays with the mesh
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
- real(kind=CUSTOM_REAL) :: xstore_dummy(nglob),ystore_dummy(nglob),zstore_dummy(nglob)
-
-! face information
- integer :: iface,ispec,NGLLA,NGLLB
- real(kind=CUSTOM_REAL) jacobian2Dw_face(NGLLA,NGLLB)
- real(kind=CUSTOM_REAL) normal_face(NDIM,NGLLA,NGLLB)
-
- double precision dershape2D_x(NDIM2D,NGNOD2D,NGLLY,NGLLZ)
- double precision dershape2D_y(NDIM2D,NGNOD2D,NGLLX,NGLLZ)
- double precision dershape2D_bottom(NDIM2D,NGNOD2D,NGLLX,NGLLY)
- double precision dershape2D_top(NDIM2D,NGNOD2D,NGLLX,NGLLY)
-
- double precision, dimension(NGLLX,NGLLY) :: wgllwgll_xy
- double precision, dimension(NGLLX,NGLLZ) :: wgllwgll_xz
- double precision, dimension(NGLLY,NGLLZ) :: wgllwgll_yz
-
-! local parameters
-! face corners
- double precision xelm(NGNOD2D),yelm(NGNOD2D),zelm(NGNOD2D)
-
-! 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')
-
- select case ( iface )
- ! on reference face: xmin
- case(1)
- xelm(1)=xstore_dummy( ibool(1,1,1,ispec) )
- yelm(1)=ystore_dummy( ibool(1,1,1,ispec) )
- zelm(1)=zstore_dummy( ibool(1,1,1,ispec) )
- xelm(2)=xstore_dummy( ibool(1,NGLLY,1,ispec) )
- yelm(2)=ystore_dummy( ibool(1,NGLLY,1,ispec) )
- zelm(2)=zstore_dummy( ibool(1,NGLLY,1,ispec) )
- xelm(3)=xstore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
- yelm(3)=ystore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
- zelm(3)=zstore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
- xelm(4)=xstore_dummy( ibool(1,1,NGLLZ,ispec) )
- yelm(4)=ystore_dummy( ibool(1,1,NGLLZ,ispec) )
- zelm(4)=zstore_dummy( ibool(1,1,NGLLZ,ispec) )
-
- call compute_jacobian_2D_face(myrank,xelm,yelm,zelm, &
- dershape2D_x,wgllwgll_yz, &
- jacobian2Dw_face,normal_face,NGLLY,NGLLZ)
-
-! on boundary: xmax
- case(2)
- xelm(1)=xstore_dummy( ibool(NGLLX,1,1,ispec) )
- yelm(1)=ystore_dummy( ibool(NGLLX,1,1,ispec) )
- zelm(1)=zstore_dummy( ibool(NGLLX,1,1,ispec) )
- xelm(2)=xstore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
- yelm(2)=ystore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
- zelm(2)=zstore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
- xelm(3)=xstore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
- yelm(3)=ystore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
- zelm(3)=zstore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
- xelm(4)=xstore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
- yelm(4)=ystore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
- zelm(4)=zstore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
-
- call compute_jacobian_2D_face(myrank,xelm,yelm,zelm, &
- dershape2D_x,wgllwgll_yz, &
- jacobian2Dw_face,normal_face,NGLLY,NGLLZ)
-
-! on boundary: ymin
- case(3)
- xelm(1)=xstore_dummy( ibool(1,1,1,ispec) )
- yelm(1)=ystore_dummy( ibool(1,1,1,ispec) )
- zelm(1)=zstore_dummy( ibool(1,1,1,ispec) )
- xelm(2)=xstore_dummy( ibool(NGLLX,1,1,ispec) )
- yelm(2)=ystore_dummy( ibool(NGLLX,1,1,ispec) )
- zelm(2)=zstore_dummy( ibool(NGLLX,1,1,ispec) )
- xelm(3)=xstore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
- yelm(3)=ystore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
- zelm(3)=zstore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
- xelm(4)=xstore_dummy( ibool(1,1,NGLLZ,ispec) )
- yelm(4)=ystore_dummy( ibool(1,1,NGLLZ,ispec) )
- zelm(4)=zstore_dummy( ibool(1,1,NGLLZ,ispec) )
-
- call compute_jacobian_2D_face(myrank,xelm,yelm,zelm, &
- dershape2D_y,wgllwgll_xz, &
- jacobian2Dw_face,normal_face,NGLLX,NGLLZ)
-
-! on boundary: ymax
- case(4)
- xelm(1)=xstore_dummy( ibool(1,NGLLY,1,ispec) )
- yelm(1)=ystore_dummy( ibool(1,NGLLY,1,ispec) )
- zelm(1)=zstore_dummy( ibool(1,NGLLY,1,ispec) )
- xelm(2)=xstore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
- yelm(2)=ystore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
- zelm(2)=zstore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
- xelm(3)=xstore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
- yelm(3)=ystore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
- zelm(3)=zstore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
- xelm(4)=xstore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
- yelm(4)=ystore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
- zelm(4)=zstore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
-
- call compute_jacobian_2D_face(myrank,xelm,yelm,zelm, &
- dershape2D_y, wgllwgll_xz, &
- jacobian2Dw_face,normal_face,NGLLX,NGLLZ)
-
-
-! on boundary: bottom
- case(5)
- xelm(1)=xstore_dummy( ibool(1,1,1,ispec) )
- yelm(1)=ystore_dummy( ibool(1,1,1,ispec) )
- zelm(1)=zstore_dummy( ibool(1,1,1,ispec) )
- xelm(2)=xstore_dummy( ibool(NGLLX,1,1,ispec) )
- yelm(2)=ystore_dummy( ibool(NGLLX,1,1,ispec) )
- zelm(2)=zstore_dummy( ibool(NGLLX,1,1,ispec) )
- xelm(3)=xstore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
- yelm(3)=ystore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
- zelm(3)=zstore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
- xelm(4)=xstore_dummy( ibool(1,NGLLY,1,ispec) )
- yelm(4)=ystore_dummy( ibool(1,NGLLY,1,ispec) )
- zelm(4)=zstore_dummy( ibool(1,NGLLY,1,ispec) )
-
- call compute_jacobian_2D_face(myrank,xelm,yelm,zelm,&
- dershape2D_bottom,wgllwgll_xy, &
- jacobian2Dw_face,normal_face,NGLLX,NGLLY)
-
-! on boundary: top
- case(6)
- xelm(1)=xstore_dummy( ibool(1,1,NGLLZ,ispec) )
- yelm(1)=ystore_dummy( ibool(1,1,NGLLZ,ispec) )
- zelm(1)=zstore_dummy( ibool(1,1,NGLLZ,ispec) )
- xelm(2)=xstore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
- yelm(2)=ystore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
- zelm(2)=zstore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
- xelm(3)=xstore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
- yelm(3)=ystore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
- zelm(3)=zstore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
- xelm(4)=xstore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
- yelm(4)=ystore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
- zelm(4)=zstore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
-
- call compute_jacobian_2D_face(myrank,xelm,yelm,zelm,&
- dershape2D_top, wgllwgll_xy, &
- jacobian2Dw_face,normal_face,NGLLX,NGLLY)
-
- case default
- stop 'error 2D jacobian'
- end select
-
- end subroutine get_jacobian_boundary_face
-
-
-! -------------------------------------------------------
-
- subroutine compute_jacobian_2D_face(myrank,xelm,yelm,zelm, &
- dershape2D,wgllwgll, &
- jacobian2Dw_face,normal_face,NGLLA,NGLLB)
-
- implicit none
-
- include "constants.h"
-
-! generic routine that accepts any polynomial degree in each direction
-! returns 2D jacobian and normal for this face only
-
- integer NGLLA,NGLLB,myrank
-
- double precision xelm(NGNOD2D),yelm(NGNOD2D),zelm(NGNOD2D)
- double precision dershape2D(NDIM2D,NGNOD2D,NGLLA,NGLLB)
- double precision wgllwgll(NGLLA,NGLLB)
-
- real(kind=CUSTOM_REAL) jacobian2Dw_face(NGLLA,NGLLB)
- real(kind=CUSTOM_REAL) normal_face(NDIM,NGLLA,NGLLB)
-
- integer i,j,ia
- double precision xxi,xeta,yxi,yeta,zxi,zeta
- double precision unx,uny,unz,jacobian
-
- do j=1,NGLLB
- do i=1,NGLLA
-
- xxi=ZERO
- xeta=ZERO
- yxi=ZERO
- yeta=ZERO
- zxi=ZERO
- zeta=ZERO
- do ia=1,NGNOD2D
- xxi=xxi+dershape2D(1,ia,i,j)*xelm(ia)
- xeta=xeta+dershape2D(2,ia,i,j)*xelm(ia)
- yxi=yxi+dershape2D(1,ia,i,j)*yelm(ia)
- yeta=yeta+dershape2D(2,ia,i,j)*yelm(ia)
- zxi=zxi+dershape2D(1,ia,i,j)*zelm(ia)
- zeta=zeta+dershape2D(2,ia,i,j)*zelm(ia)
- enddo
-
-! calculate the unnormalized normal to the boundary
- unx=yxi*zeta-yeta*zxi
- uny=zxi*xeta-zeta*xxi
- unz=xxi*yeta-xeta*yxi
- jacobian=dsqrt(unx**2+uny**2+unz**2)
- if(jacobian == ZERO) call exit_MPI(myrank,'2D Jacobian undefined')
-
-! normalize normal vector and store weighted surface jacobian
-
-! distinguish if single or double precision for reals
- if(CUSTOM_REAL == SIZE_REAL) then
- jacobian2Dw_face(i,j) = sngl(jacobian * wgllwgll(i,j) )
- normal_face(1,i,j)=sngl(unx/jacobian)
- normal_face(2,i,j)=sngl(uny/jacobian)
- normal_face(3,i,j)=sngl(unz/jacobian)
- else
- jacobian2Dw_face(i,j) = jacobian * wgllwgll(i,j)
- normal_face(1,i,j)=unx/jacobian
- normal_face(2,i,j)=uny/jacobian
- normal_face(3,i,j)=unz/jacobian
- endif
-
- enddo
- enddo
-
- end subroutine compute_jacobian_2D_face
-
-
-! This subroutine recompute the 3D jacobian for one element
-! based upon 125 GLL points
-! Hejun Zhu OCT16,2009
-
-! input: myrank,
-! xstore,ystore,zstore ----- input position
-! xigll,yigll,zigll ----- gll points position
-! ispec,nspec ----- element number
-! ACTUALLY_STORE_ARRAYS ------ save array or not
-
-! output: xixstore,xiystore,xizstore,
-! etaxstore,etaystore,etazstore,
-! gammaxstore,gammaystore,gammazstore ------ parameters used for calculating jacobian
-
-
- subroutine recalc_jacobian_gll2D(myrank,xstore,ystore,zstore, &
- xigll,yigll,wgllwgll,NGLLA,NGLLB, &
- ispec,nspec,jacobian2Dw_face,normal_face)
-
- implicit none
-
- include "constants.h"
-
- ! input parameter
- integer::myrank,ispec,nspec
- double precision, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: xstore,ystore,zstore
-
- integer :: NGLLA,NGLLB
- double precision, dimension(NGLLA):: xigll
- double precision, dimension(NGLLB):: yigll
- double precision:: wgllwgll(NGLLA,NGLLB)
-
- real(kind=CUSTOM_REAL) jacobian2Dw_face(NGLLA,NGLLB)
- real(kind=CUSTOM_REAL) normal_face(NDIM,NGLLA,NGLLB)
-
- ! other parameters for this subroutine
- integer:: i,j,k,i1,j1,k1
- double precision:: xxi,xeta,yxi,yeta,zxi,zeta
- double precision:: xi,eta
- double precision,dimension(NGLLA):: hxir,hpxir
- double precision,dimension(NGLLB):: hetar,hpetar
- double precision:: hlagrange,hlagrange_xi,hlagrange_eta
- double precision:: jacobian
- double precision:: unx,uny,unz
-
-
-
- ! test parameters which can be deleted
- double precision:: xmesh,ymesh,zmesh
- double precision:: sumshape,sumdershapexi,sumdershapeeta
-
- ! first go over all gll points on face
- k=1
- do j=1,NGLLB
- do i=1,NGLLA
-
- xxi = 0.0
- xeta = 0.0
- yxi = 0.0
- yeta = 0.0
- zxi = 0.0
- zeta = 0.0
-
- xi = xigll(i)
- eta = yigll(j)
-
- ! calculate lagrange polynomial and its derivative
- call lagrange_any(xi,NGLLA,xigll,hxir,hpxir)
- call lagrange_any(eta,NGLLB,yigll,hetar,hpetar)
-
- ! test parameters
- sumshape = 0.0
- sumdershapexi = 0.0
- sumdershapeeta = 0.0
- xmesh = 0.0
- ymesh = 0.0
- zmesh = 0.0
-
- k1=1
- do j1 = 1,NGLLB
- do i1 = 1,NGLLA
- hlagrange = hxir(i1)*hetar(j1)
- hlagrange_xi = hpxir(i1)*hetar(j1)
- hlagrange_eta = hxir(i1)*hpetar(j1)
-
-
- xxi = xxi + xstore(i1,j1,k1,ispec)*hlagrange_xi
- xeta = xeta + xstore(i1,j1,k1,ispec)*hlagrange_eta
-
- yxi = yxi + ystore(i1,j1,k1,ispec)*hlagrange_xi
- yeta = yeta + ystore(i1,j1,k1,ispec)*hlagrange_eta
-
- zxi = zxi + zstore(i1,j1,k1,ispec)*hlagrange_xi
- zeta = zeta + zstore(i1,j1,k1,ispec)*hlagrange_eta
-
- ! test the lagrange polynomial and its derivate
- xmesh = xmesh + xstore(i1,j1,k1,ispec)*hlagrange
- ymesh = ymesh + ystore(i1,j1,k1,ispec)*hlagrange
- zmesh = zmesh + zstore(i1,j1,k1,ispec)*hlagrange
- sumshape = sumshape + hlagrange
- sumdershapexi = sumdershapexi + hlagrange_xi
- sumdershapeeta = sumdershapeeta + hlagrange_eta
-
- end do
- end do
-
- ! Check the lagrange polynomial and its derivative
- if (xmesh /=xstore(i,j,k,ispec).or.ymesh/=ystore(i,j,k,ispec).or.zmesh/=zstore(i,j,k,ispec)) then
- call exit_MPI(myrank,'new mesh positions are wrong in recalc_jacobian_gall3D.f90')
- end if
- if(abs(sumshape-one) > TINYVAL) then
- call exit_MPI(myrank,'error shape functions in recalc_jacobian_gll3D.f90')
- end if
- if(abs(sumdershapexi) > TINYVAL) then
- call exit_MPI(myrank,'error derivative xi shape functions in recalc_jacobian_gll3D.f90')
- end if
- if(abs(sumdershapeeta) > TINYVAL) then
- call exit_MPI(myrank,'error derivative eta shape functions in recalc_jacobian_gll3D.f90')
- end if
-
-! calculate the unnormalized normal to the boundary
- unx=yxi*zeta-yeta*zxi
- uny=zxi*xeta-zeta*xxi
- unz=xxi*yeta-xeta*yxi
- jacobian=dsqrt(unx**2+uny**2+unz**2)
- if(jacobian <= ZERO) call exit_MPI(myrank,'2D Jacobian undefined')
-
-! normalize normal vector and store weighted surface jacobian
-
-! distinguish if single or double precision for reals
- if(CUSTOM_REAL == SIZE_REAL) then
- jacobian2Dw_face(i,j) = sngl(jacobian * wgllwgll(i,j) )
- normal_face(1,i,j)=sngl(unx/jacobian)
- normal_face(2,i,j)=sngl(uny/jacobian)
- normal_face(3,i,j)=sngl(unz/jacobian)
- else
- jacobian2Dw_face(i,j) = jacobian * wgllwgll(i,j)
- normal_face(1,i,j)=unx/jacobian
- normal_face(2,i,j)=uny/jacobian
- normal_face(3,i,j)=unz/jacobian
- endif
-
- enddo
- enddo
-
- end subroutine recalc_jacobian_gll2D
-
-!
-!------------------------------------------------------------------------------------------------
-!
-!
-! subroutine get_jacobian_boundaries(myrank,iboun,nspec, &
-! xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob,&
-! dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
-! wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
-! ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
-! xcoord_iboun,ycoord_iboun,zcoord_iboun, &
-! 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)
-!
-! implicit none
-!
-! include "constants.h"
-!
-! integer nspec,myrank,nglob
-!
-!! arrays with the mesh
-! integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
-! real(kind=CUSTOM_REAL) :: xstore_dummy(nglob),ystore_dummy(nglob),zstore_dummy(nglob)
-!
-!
-!! absorbing boundaries
-!! (careful with array bounds, no need for NSPEC2DMAX_XMIN_XMAX & NSPEC2DMAX_YMIN_YMAX anymore)
-! 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
-!
-! logical iboun(6,nspec)
-! real(kind=CUSTOM_REAL), dimension(NGNOD2D,6,nspec) :: xcoord_iboun,ycoord_iboun,zcoord_iboun
-!
-!! double precision xstore(NGLLX,NGLLY,NGLLZ,nspec)
-!! double precision ystore(NGLLX,NGLLY,NGLLZ,nspec)
-!! double precision zstore(NGLLX,NGLLY,NGLLZ,nspec)
-!
-! real(kind=CUSTOM_REAL) jacobian2D_xmin(NGLLY,NGLLZ,NSPEC2D_xmin)
-! real(kind=CUSTOM_REAL) jacobian2D_xmax(NGLLY,NGLLZ,NSPEC2D_xmax)
-! real(kind=CUSTOM_REAL) jacobian2D_ymin(NGLLX,NGLLZ,NSPEC2D_ymin)
-! real(kind=CUSTOM_REAL) jacobian2D_ymax(NGLLX,NGLLZ,NSPEC2D_ymax)
-! real(kind=CUSTOM_REAL) jacobian2D_bottom(NGLLX,NGLLY,NSPEC2D_BOTTOM)
-! real(kind=CUSTOM_REAL) jacobian2D_top(NGLLX,NGLLY,NSPEC2D_TOP)
-!
-! real(kind=CUSTOM_REAL) normal_xmin(NDIM,NGLLY,NGLLZ,NSPEC2D_xmin)
-! real(kind=CUSTOM_REAL) normal_xmax(NDIM,NGLLY,NGLLZ,NSPEC2D_xmax)
-! real(kind=CUSTOM_REAL) normal_ymin(NDIM,NGLLX,NGLLZ,NSPEC2D_ymin)
-! real(kind=CUSTOM_REAL) normal_ymax(NDIM,NGLLX,NGLLZ,NSPEC2D_ymax)
-! real(kind=CUSTOM_REAL) normal_bottom(NDIM,NGLLX,NGLLY,NSPEC2D_BOTTOM)
-! real(kind=CUSTOM_REAL) normal_top(NDIM,NGLLX,NGLLY,NSPEC2D_TOP)
-!
-! double precision dershape2D_x(NDIM2D,NGNOD2D,NGLLY,NGLLZ)
-! double precision dershape2D_y(NDIM2D,NGNOD2D,NGLLX,NGLLZ)
-! double precision dershape2D_bottom(NDIM2D,NGNOD2D,NGLLX,NGLLY)
-! double precision dershape2D_top(NDIM2D,NGNOD2D,NGLLX,NGLLY)
-!
-! double precision, dimension(NGLLX,NGLLY) :: wgllwgll_xy
-! double precision, dimension(NGLLX,NGLLZ) :: wgllwgll_xz
-! double precision, dimension(NGLLY,NGLLZ) :: wgllwgll_yz
-!
-! double precision xelm(NGNOD2D),yelm(NGNOD2D),zelm(NGNOD2D)
-!
-!! element numbering
-! integer ispec,i,j
-!
-!! 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
-! 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')
-!
-! ispecb1 = 0
-! ispecb2 = 0
-! ispecb3 = 0
-! ispecb4 = 0
-! ispecb5 = 0
-! ispecb6 = 0
-!
-! do ispec=1,nspec
-!
-!! determine if the element falls on a boundary
-!
-!! on boundary: xmin
-!
-! if(iboun(1,ispec)) then
-!
-! ispecb1=ispecb1+1
-! ibelm_xmin(ispecb1)=ispec
-!
-!! specify the 4 nodes for the 2-D boundary element
-!! i.e. face (0,0,0),(0,1,0),(0,1,1),(0,0,1)
-!
-!! careful: these points may not be on the xmin face for unstructured grids
-!! xelm(1)=xstore(1,1,1,ispec)
-!! yelm(1)=ystore(1,1,1,ispec)
-!! zelm(1)=zstore(1,1,1,ispec)
-!! xelm(2)=xstore(1,NGLLY,1,ispec)
-!! yelm(2)=ystore(1,NGLLY,1,ispec)
-!! zelm(2)=zstore(1,NGLLY,1,ispec)
-!! xelm(3)=xstore(1,NGLLY,NGLLZ,ispec)
-!! yelm(3)=ystore(1,NGLLY,NGLLZ,ispec)
-!! zelm(3)=zstore(1,NGLLY,NGLLZ,ispec)
-!! xelm(4)=xstore(1,1,NGLLZ,ispec)
-!! yelm(4)=ystore(1,1,NGLLZ,ispec)
-!! zelm(4)=zstore(1,1,NGLLZ,ispec)
-!
-! xelm(1)=xstore_dummy( ibool(1,1,1,ispec) )
-! yelm(1)=ystore_dummy( ibool(1,1,1,ispec) )
-! zelm(1)=zstore_dummy( ibool(1,1,1,ispec) )
-! xelm(2)=xstore_dummy( ibool(1,NGLLY,1,ispec) )
-! yelm(2)=ystore_dummy( ibool(1,NGLLY,1,ispec) )
-! zelm(2)=zstore_dummy( ibool(1,NGLLY,1,ispec) )
-! xelm(3)=xstore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
-! yelm(3)=ystore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
-! zelm(3)=zstore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
-! xelm(4)=xstore_dummy( ibool(1,1,NGLLZ,ispec) )
-! yelm(4)=ystore_dummy( ibool(1,1,NGLLZ,ispec) )
-! zelm(4)=zstore_dummy( ibool(1,1,NGLLZ,ispec) )
-!
-!! takes coordinates from boundary faces
-!! do i=1,NGNOD2D
-!! xelm(i) = xcoord_iboun(i,1,ispec)
-!! yelm(i) = ycoord_iboun(i,1,ispec)
-!! zelm(i) = zcoord_iboun(i,1,ispec)
-!! enddo
-!
-! call compute_jacobian_2D(myrank,ispecb1,xelm,yelm,zelm, &
-! dershape2D_x,wgllwgll_yz, &
-! jacobian2D_xmin,normal_xmin,NGLLY,NGLLZ,NSPEC2D_xmin)
-!
-! ! normal convention: points away from element
-! ! switches normal direction if necessary
-! do i=1,NGLLY
-! do j=1,NGLLZ
-! call get_element_face_normal(ispecb1, 1, xelm,yelm,zelm, &
-! ibool,nspec,nglob, &
-! xstore_dummy,ystore_dummy,zstore_dummy, &
-! normal_xmin(:,i,j,ispecb1) )
-! enddo
-! enddo
-!
-! endif
-!
-!! on boundary: xmax
-!
-! if(iboun(2,ispec)) then
-!
-! ispecb2=ispecb2+1
-! ibelm_xmax(ispecb2)=ispec
-!
-!! careful...
-!! specify the 4 nodes for the 2-D boundary element
-!! xelm(1)=xstore(NGLLX,1,1,ispec)
-!! yelm(1)=ystore(NGLLX,1,1,ispec)
-!! zelm(1)=zstore(NGLLX,1,1,ispec)
-!! xelm(2)=xstore(NGLLX,NGLLY,1,ispec)
-!! yelm(2)=ystore(NGLLX,NGLLY,1,ispec)
-!! zelm(2)=zstore(NGLLX,NGLLY,1,ispec)
-!! xelm(3)=xstore(NGLLX,NGLLY,NGLLZ,ispec)
-!! yelm(3)=ystore(NGLLX,NGLLY,NGLLZ,ispec)
-!! zelm(3)=zstore(NGLLX,NGLLY,NGLLZ,ispec)
-!! xelm(4)=xstore(NGLLX,1,NGLLZ,ispec)
-!! yelm(4)=ystore(NGLLX,1,NGLLZ,ispec)
-!! zelm(4)=zstore(NGLLX,1,NGLLZ,ispec)
-!
-! xelm(1)=xstore_dummy( ibool(NGLLX,1,1,ispec) )
-! yelm(1)=ystore_dummy( ibool(NGLLX,1,1,ispec) )
-! zelm(1)=zstore_dummy( ibool(NGLLX,1,1,ispec) )
-! xelm(2)=xstore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
-! yelm(2)=ystore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
-! zelm(2)=zstore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
-! xelm(3)=xstore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
-! yelm(3)=ystore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
-! zelm(3)=zstore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
-! xelm(4)=xstore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
-! yelm(4)=ystore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
-! zelm(4)=zstore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
-!
-!! takes coordinates from boundary faces
-!! do i=1,NGNOD2D
-!! xelm(i) = xcoord_iboun(i,2,ispec)
-!! yelm(i) = ycoord_iboun(i,2,ispec)
-!! zelm(i) = zcoord_iboun(i,2,ispec)
-!! enddo
-!
-! call compute_jacobian_2D(myrank,ispecb2,xelm,yelm,zelm, &
-! dershape2D_x,wgllwgll_yz, &
-! jacobian2D_xmax,normal_xmax,NGLLY,NGLLZ,NSPEC2D_xmax)
-!
-! ! normal convention: points away from element
-! ! switch normal direction if necessary
-! do i=1,NGLLY
-! do j=1,NGLLZ
-! call get_element_face_normal(ispecb2, 2, xelm,yelm,zelm, &
-! ibool,nspec,nglob, &
-! xstore_dummy,ystore_dummy,zstore_dummy, &
-! normal_xmax(:,i,j,ispecb2) )
-! enddo
-! enddo
-!
-! endif
-!
-!! on boundary: ymin
-!
-! if(iboun(3,ispec)) then
-!
-! ispecb3=ispecb3+1
-! ibelm_ymin(ispecb3)=ispec
-!
-!! careful...
-!! specify the 4 nodes for the 2-D boundary element
-!! xelm(1)=xstore(1,1,1,ispec)
-!! yelm(1)=ystore(1,1,1,ispec)
-!! zelm(1)=zstore(1,1,1,ispec)
-!! xelm(2)=xstore(NGLLX,1,1,ispec)
-!! yelm(2)=ystore(NGLLX,1,1,ispec)
-!! zelm(2)=zstore(NGLLX,1,1,ispec)
-!! xelm(3)=xstore(NGLLX,1,NGLLZ,ispec)
-!! yelm(3)=ystore(NGLLX,1,NGLLZ,ispec)
-!! zelm(3)=zstore(NGLLX,1,NGLLZ,ispec)
-!! xelm(4)=xstore(1,1,NGLLZ,ispec)
-!! yelm(4)=ystore(1,1,NGLLZ,ispec)
-!! zelm(4)=zstore(1,1,NGLLZ,ispec)
-!
-! xelm(1)=xstore_dummy( ibool(1,1,1,ispec) )
-! yelm(1)=ystore_dummy( ibool(1,1,1,ispec) )
-! zelm(1)=zstore_dummy( ibool(1,1,1,ispec) )
-! xelm(2)=xstore_dummy( ibool(NGLLX,1,1,ispec) )
-! yelm(2)=ystore_dummy( ibool(NGLLX,1,1,ispec) )
-! zelm(2)=zstore_dummy( ibool(NGLLX,1,1,ispec) )
-! xelm(3)=xstore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
-! yelm(3)=ystore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
-! zelm(3)=zstore_dummy( ibool(NGLLX,1,NGLLZ,ispec) )
-! xelm(4)=xstore_dummy( ibool(1,1,NGLLZ,ispec) )
-! yelm(4)=ystore_dummy( ibool(1,1,NGLLZ,ispec) )
-! zelm(4)=zstore_dummy( ibool(1,1,NGLLZ,ispec) )
-!
-!! takes coordinates from boundary faces
-!! do i=1,NGNOD2D
-!! xelm(i) = xcoord_iboun(i,3,ispec)
-!! yelm(i) = ycoord_iboun(i,3,ispec)
-!! zelm(i) = zcoord_iboun(i,3,ispec)
-!! enddo
-!
-! call compute_jacobian_2D(myrank,ispecb3,xelm,yelm,zelm, &
-! dershape2D_y,wgllwgll_xz, &
-! jacobian2D_ymin,normal_ymin,NGLLX,NGLLZ,NSPEC2D_ymin)
-!
-! ! normal convention: points away from element
-! ! switch normal direction if necessary
-! do i=1,NGLLX
-! do j=1,NGLLZ
-! call get_element_face_normal(ispecb3, 3, xelm,yelm,zelm, &
-! ibool,nspec,nglob, &
-! xstore_dummy,ystore_dummy,zstore_dummy, &
-! normal_ymin(:,i,j,ispecb3) )
-! enddo
-! enddo
-!
-!
-! endif
-!
-!! on boundary: ymax
-!
-! if(iboun(4,ispec)) then
-!
-! ispecb4=ispecb4+1
-! ibelm_ymax(ispecb4)=ispec
-!
-!!careful...
-!! specify the 4 nodes for the 2-D boundary element
-!! xelm(1)=xstore(1,NGLLY,1,ispec)
-!! yelm(1)=ystore(1,NGLLY,1,ispec)
-!! zelm(1)=zstore(1,NGLLY,1,ispec)
-!! xelm(2)=xstore(NGLLX,NGLLY,1,ispec)
-!! yelm(2)=ystore(NGLLX,NGLLY,1,ispec)
-!! zelm(2)=zstore(NGLLX,NGLLY,1,ispec)
-!! xelm(3)=xstore(NGLLX,NGLLY,NGLLZ,ispec)
-!! yelm(3)=ystore(NGLLX,NGLLY,NGLLZ,ispec)
-!! zelm(3)=zstore(NGLLX,NGLLY,NGLLZ,ispec)
-!! xelm(4)=xstore(1,NGLLY,NGLLZ,ispec)
-!! yelm(4)=ystore(1,NGLLY,NGLLZ,ispec)
-!! zelm(4)=zstore(1,NGLLY,NGLLZ,ispec)
-!
-! xelm(1)=xstore_dummy( ibool(1,NGLLY,1,ispec) )
-! yelm(1)=ystore_dummy( ibool(1,NGLLY,1,ispec) )
-! zelm(1)=zstore_dummy( ibool(1,NGLLY,1,ispec) )
-! xelm(2)=xstore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
-! yelm(2)=ystore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
-! zelm(2)=zstore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
-! xelm(3)=xstore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
-! yelm(3)=ystore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
-! zelm(3)=zstore_dummy( ibool(NGLLX,NGLLY,NGLLZ,ispec) )
-! xelm(4)=xstore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
-! yelm(4)=ystore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
-! zelm(4)=zstore_dummy( ibool(1,NGLLY,NGLLZ,ispec) )
-!
-!! takes coordinates from boundary faces
-!! do i=1,NGNOD2D
-!! xelm(i) = xcoord_iboun(i,4,ispec)
-!! yelm(i) = ycoord_iboun(i,4,ispec)
-!! zelm(i) = zcoord_iboun(i,4,ispec)
-!! enddo
-!!
-! call compute_jacobian_2D(myrank,ispecb4,xelm,yelm,zelm, &
-! dershape2D_y, wgllwgll_xz, &
-! jacobian2D_ymax,normal_ymax,NGLLX,NGLLZ,NSPEC2D_ymax)
-!
-! ! normal convention: points away from element
-! ! switch normal direction if necessary
-! do i=1,NGLLX
-! do j=1,NGLLZ
-! call get_element_face_normal(ispecb4, 4, xelm,yelm,zelm, &
-! ibool,nspec,nglob, &
-! xstore_dummy,ystore_dummy,zstore_dummy, &
-! normal_ymax(:,i,j,ispecb4) )
-! enddo
-! enddo
-!
-! endif
-!
-!! on boundary: bottom
-!
-! if(iboun(5,ispec)) then
-!
-! ispecb5=ispecb5+1
-! ibelm_bottom(ispecb5)=ispec
-!
-!! careful...
-!! for bottom, this might be actually working... when mesh is oriented along z direction...
-!! xelm(1)=xstore(1,1,1,ispec)
-!! yelm(1)=ystore(1,1,1,ispec)
-!! zelm(1)=zstore(1,1,1,ispec)
-!! xelm(2)=xstore(NGLLX,1,1,ispec)
-!! yelm(2)=ystore(NGLLX,1,1,ispec)
-!! zelm(2)=zstore(NGLLX,1,1,ispec)
-!! xelm(3)=xstore(NGLLX,NGLLY,1,ispec)
-!! yelm(3)=ystore(NGLLX,NGLLY,1,ispec)
-!! zelm(3)=zstore(NGLLX,NGLLY,1,ispec)
-!! xelm(4)=xstore(1,NGLLY,1,ispec)
-!! yelm(4)=ystore(1,NGLLY,1,ispec)
-!! zelm(4)=zstore(1,NGLLY,1,ispec)
-!
-! xelm(1)=xstore_dummy( ibool(1,1,1,ispec) )
-! yelm(1)=ystore_dummy( ibool(1,1,1,ispec) )
-! zelm(1)=zstore_dummy( ibool(1,1,1,ispec) )
-! xelm(2)=xstore_dummy( ibool(NGLLX,1,1,ispec) )
-! yelm(2)=ystore_dummy( ibool(NGLLX,1,1,ispec) )
-! zelm(2)=zstore_dummy( ibool(NGLLX,1,1,ispec) )
-! xelm(3)=xstore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
-! yelm(3)=ystore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
-! zelm(3)=zstore_dummy( ibool(NGLLX,NGLLY,1,ispec) )
-! xelm(4)=xstore_dummy( ibool(1,NGLLY,1,ispec) )
-! yelm(4)=ystore_dummy( ibool(1,NGLLY,1,ispec) )
-! zelm(4)=zstore_dummy( ibool(1,NGLLY,1,ispec) )
-!
-!
-!! takes coordinates from boundary faces
-!! do i=1,NGNOD2D
-!! xelm(i) = xcoord_iboun(i,5,ispec)
-!! yelm(i) = ycoord_iboun(i,5,ispec)
-!! zelm(i) = zcoord_iboun(i,5,ispec)
-!! enddo
-!
-! call compute_jacobian_2D(myrank,ispecb5,xelm,yelm,zelm,&
-! dershape2D_bottom,wgllwgll_xy, &
-! jacobian2D_bottom,normal_bottom,NGLLX,NGLLY,NSPEC2D_BOTTOM)
-!
-! ! normal convention: points away from element
-! ! switch normal direction if necessary
-! do i=1,NGLLX
-! do j=1,NGLLY
-! call get_element_face_normal(ispecb5, 5, xelm,yelm,zelm, &
-! ibool,nspec,nglob, &
-! xstore_dummy,ystore_dummy,zstore_dummy, &
-! normal_bottom(:,i,j,ispecb5) )
-! enddo
-! enddo
-!
-! endif
-!
-!! on boundary: top
-!
-! if(iboun(6,ispec)) then
-!
-! ispecb6=ispecb6+1
-! ibelm_top(ispecb6)=ispec
-!
-!! careful...
-!! for top, this might be working as well ... when mesh is oriented along z direction...
-!! xelm(1)=xstore(1,1,NGLLZ,ispec)
-!! yelm(1)=ystore(1,1,NGLLZ,ispec)
-!! zelm(1)=zstore(1,1,NGLLZ,ispec)
-!! xelm(2)=xstore(NGLLX,1,NGLLZ,ispec)
-!! yelm(2)=ystore(NGLLX,1,NGLLZ,ispec)
-!! zelm(2)=zstore(NGLLX,1,NGLLZ,ispec)
-!! xelm(3)=xstore(NGLLX,NGLLY,NGLLZ,ispec)
-!! yelm(3)=ystore(NGLLX,NGLLY,NGLLZ,ispec)
-!! zelm(3)=zstore(NGLLX,NGLLY,NGLLZ,ispec)
-!! xelm(4)=xstore(1,NGLLY,NGLLZ,ispec)
-!! yelm(4)=ystore(1,NGLLY,NGLLZ,ispec)
-!! zelm(4)=zstore(1,NGLLY,NGLLZ,ispec)
-!
-!
-!! takes coordinates from boundary faces
-!! do i=1,NGNOD2D
-!! xelm(i) = xcoord_iboun(i,6,ispec)
-!! yelm(i) = ycoord_iboun(i,6,ispec)
-!! zelm(i) = zcoord_iboun(i,6,ispec)
-!! enddo
-!
-! call compute_jacobian_2D(myrank,ispecb6,xelm,yelm,zelm,&
-! dershape2D_top, wgllwgll_xy, &
-! jacobian2D_top,normal_top,NGLLX,NGLLY,NSPEC2D_TOP)
-!
-! ! normal convention: points away from element
-! ! switch normal direction if necessary
-! do i=1,NGLLX
-! do j=1,NGLLY
-! call get_element_face_normal(ispecb6, 6, xelm,yelm,zelm, &
-! ibool,nspec,nglob, &
-! xstore_dummy,ystore_dummy,zstore_dummy, &
-! normal_top(:,i,j,ispecb6) )
-! enddo
-! enddo
-!
-! endif
-!
-! enddo
-!
-!! check theoretical value of elements
-!! if(ispecb1 /= NSPEC2D_xmin) call exit_MPI(myrank,'ispecb1 should equal NSPEC2D_xmin')
-!! if(ispecb2 /= NSPEC2D_xmax) call exit_MPI(myrank,'ispecb2 should equal NSPEC2D_xmax')
-!! if(ispecb3 /= NSPEC2D_ymin) call exit_MPI(myrank,'ispecb3 should equal NSPEC2D_ymin')
-!! if(ispecb4 /= NSPEC2D_ymax) call exit_MPI(myrank,'ispecb4 should equal NSPEC2D_ymax')
-!! if(ispecb5 /= NSPEC2D_BOTTOM) call exit_MPI(myrank,'ispecb5 should equal NSPEC2D_BOTTOM')
-!! if(ispecb6 /= NSPEC2D_TOP) call exit_MPI(myrank,'ispecb6 should equal NSPEC2D_TOP')
-!
-! end subroutine get_jacobian_boundaries
-!
-!! -------------------------------------------------------
-!
-! subroutine compute_jacobian_2D(myrank,ispecb,xelm,yelm,zelm, &
-! dershape2D,wgllwgll, &
-! jacobian2D,normal, &
-! NGLLA,NGLLB,NSPEC2DMAX_AB)
-!
-! implicit none
-!
-! include "constants.h"
-!
-!! generic routine that accepts any polynomial degree in each direction
-!
-! integer ispecb,NGLLA,NGLLB,NSPEC2DMAX_AB,myrank
-!
-! double precision xelm(NGNOD2D),yelm(NGNOD2D),zelm(NGNOD2D)
-! double precision dershape2D(NDIM2D,NGNOD2D,NGLLA,NGLLB)
-! double precision wgllwgll
-!
-! real(kind=CUSTOM_REAL) jacobian2D(NGLLA,NGLLB,NSPEC2DMAX_AB)
-! real(kind=CUSTOM_REAL) normal(3,NGLLA,NGLLB,NSPEC2DMAX_AB)
-!
-! integer i,j,ia
-! double precision xxi,xeta,yxi,yeta,zxi,zeta
-! double precision unx,uny,unz,jacobian
-!
-! do j=1,NGLLB
-! do i=1,NGLLA
-!
-! xxi=ZERO
-! xeta=ZERO
-! yxi=ZERO
-! yeta=ZERO
-! zxi=ZERO
-! zeta=ZERO
-! do ia=1,NGNOD2D
-! xxi=xxi+dershape2D(1,ia,i,j)*xelm(ia)
-! xeta=xeta+dershape2D(2,ia,i,j)*xelm(ia)
-! yxi=yxi+dershape2D(1,ia,i,j)*yelm(ia)
-! yeta=yeta+dershape2D(2,ia,i,j)*yelm(ia)
-! zxi=zxi+dershape2D(1,ia,i,j)*zelm(ia)
-! zeta=zeta+dershape2D(2,ia,i,j)*zelm(ia)
-! enddo
-!
-!! calculate the unnormalized normal to the boundary
-! unx=yxi*zeta-yeta*zxi
-! uny=zxi*xeta-zeta*xxi
-! unz=xxi*yeta-xeta*yxi
-! jacobian=dsqrt(unx**2+uny**2+unz**2)
-! if(jacobian == ZERO) call exit_MPI(myrank,'2D Jacobian undefined')
-!
-!! normalize normal vector and store weighted surface jacobian
-!
-!! distinguish if single or double precision for reals
-! if(CUSTOM_REAL == SIZE_REAL) then
-! jacobian2D(i,j,ispecb) = sngl(jacobian * wgllwgll(i,j) )
-! normal(1,i,j,ispecb)=sngl(unx/jacobian)
-! normal(2,i,j,ispecb)=sngl(uny/jacobian)
-! normal(3,i,j,ispecb)=sngl(unz/jacobian)
-! else
-! jacobian2D(i,j,ispecb) = jacobian * wgllwgll(i,j)
-! normal(1,i,j,ispecb)=unx/jacobian
-! normal(2,i,j,ispecb)=uny/jacobian
-! normal(3,i,j,ispecb)=unz/jacobian
-! endif
-!
-! enddo
-! enddo
-!
-! end subroutine compute_jacobian_2D
-!
-
\ No newline at end of file
Deleted: seismo/3D/SPECFEM3D/trunk/get_model.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/get_model.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/get_model.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,350 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine 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)
-
- use create_regions_mesh_ext_par
- implicit none
-
- ! number of spectral elements in each block
- integer :: myrank,nspec
-
- integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
-
- ! external mesh
- integer :: nelmnts_ext_mesh
- integer :: nmat_ext_mesh,nundefMat_ext_mesh
-
- integer, dimension(2,nelmnts_ext_mesh) :: mat_ext_mesh
- double precision, dimension(6,nmat_ext_mesh) :: materials_ext_mesh
- character (len=30), dimension(6,nundefMat_ext_mesh):: undef_mat_prop
-
- ! anisotropy
- logical :: ANISOTROPY
-
- ! local parameters
- real(kind=CUSTOM_REAL) :: vp,vs,rho
- 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
- integer :: ispec,i,j,k,iundef,iflag_atten
- integer :: iflag,flag_below,flag_above
- integer :: iflag_aniso,idomain_id,imaterial_id
-
- ! gll point location
- double precision :: xloc,yloc,zloc
- integer :: iglob
-
-!<YANGL
-!!! variables for importing models from files in SPECFEM format, e.g., proc000000_vp.bin etc.
-!!! mainly used for model update in iterative inversions
- character(len=256) LOCAL_PATH,prname_lp
- real, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: vp_read,vs_read,rho_read
-!>YANGL
-
- ! 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)
- endif
-
- ! prepares external model values if needed
- if( USE_MODEL_EXTERNAL_VALUES ) then
- call model_external_broadcast(myrank)
- endif
-
-! ! Piero, read bedrock file
-! in case, see file model_interface_bedrock.f90:
-! call model_bedrock_broadcast(myrank)
-
-
- ! material properties on all GLL points: taken from material values defined for
- ! each spectral element in input mesh
- do ispec = 1, nspec
- 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)
-
- ! check if the material is known or unknown
- if( imaterial_id > 0) then
- ! gets velocity model as specified by (cubit) mesh files
-
- ! 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
- iflag_atten = materials_ext_mesh(4,imaterial_id)
- !change for piero :
- !if(mat_ext_mesh(1,ispec) == 1) then
- ! iflag_attenuation_store(i,j,k,ispec) = 1
- !else
- ! iflag_attenuation_store(i,j,k,ispec) = 2
- !endif
-
- ! anisotropy
- iflag_aniso = materials_ext_mesh(5,imaterial_id)
-
- ! material domain_id
- idomain_id = materials_ext_mesh(6,imaterial_id)
-
- else if (mat_ext_mesh(2,ispec) == 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)
- iflag_atten = materials_ext_mesh(4,iflag)
- !change for piero :
- ! if(iflag == 1) then
- ! iflag_attenuation_store(i,j,k,ispec) = 1
- ! else
- ! iflag_attenuation_store(i,j,k,ispec) = 2
- ! endif
- iflag_aniso = materials_ext_mesh(5,iflag)
- idomain_id = materials_ext_mesh(6,iflag)
-
- else if ( mat_ext_mesh(2,ispec) == 2 ) then
-
- ! 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)
-
- ! gets model values from tomography file
- call model_tomography(xloc,yloc,zloc, &
- rho,vp,vs)
-
- iflag_atten = 1 ! attenuation: would use IATTENUATION_SEDIMENTS_40
- 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
-
- 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,iflag_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
-
- ! 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
- iflag_attenuation_store(i,j,k,ispec) = iflag_atten
-
- ! Stacey, a completer par la suite
- rho_vp(i,j,k,ispec) = rho*vp
- rho_vs(i,j,k,ispec) = rho*vs
- !end pll
-
- ! 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
-
-!<YANGL
-!!! for pure acoustic simulations (a way of avoiding re-mesh, re-partition etc.)
-!!! can be used to compare elastic & acoustic reflections in exploration seismology
-! idomain_id = IDOMAIN_ACOUSTIC
-!>YANGL
-
- ! 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
- stop 'poroelastic material domain not implemented yet'
- 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
- do ispec=1,nspec
- if( (ispec_is_acoustic(ispec) .eqv. .false.) &
- .and. (ispec_is_elastic(ispec) .eqv. .false.) &
- .and. (ispec_is_poroelastic(ispec) .eqv. .false.) ) then
- print*,'error material domain not assigned to element:',ispec
- print*,'acoustic: ',ispec_is_acoustic(ispec)
- print*,'elastic: ',ispec_is_elastic(ispec)
- print*,'poroelastic: ',ispec_is_poroelastic(ispec)
- stop 'error material domain index element'
- 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()
-
-
-!<YANGL
-!!! import the model from files in SPECFEM format
-!!! note that those those files should be saved in LOCAL_PATH
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!! if only vp structure is available (as is often the case in exploration seismology),
-!!! comment out unneccessary lines
-
-! 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)
-!
-! 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)
-!
-! 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)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!! 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
-!>YANGL
-
- end subroutine get_model
-
Deleted: seismo/3D/SPECFEM3D/trunk/get_shape2D.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/get_shape2D.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/get_shape2D.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,120 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine get_shape2D(myrank,shape2D,dershape2D,xigll,yigll,NGLLA,NGLLB)
-
- implicit none
-
- include "constants.h"
-
-! generic routine that accepts any polynomial degree in each direction
-
- integer NGLLA,NGLLB,myrank
-
- double precision xigll(NGLLA)
- double precision yigll(NGLLB)
-
-! 2D shape functions and their derivatives
- double precision shape2D(NGNOD2D,NGLLA,NGLLB)
- double precision dershape2D(NDIM2D,NGNOD2D,NGLLA,NGLLB)
-
- integer i,j,ia
-
-! location of the nodes of the 2D quadrilateral elements
- double precision xi,eta
- double precision xi_map,eta_map
-
-! for checking the 2D shape functions
- double precision sumshape,sumdershapexi,sumdershapeeta
-
-! 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')
-
-! generate the 2D shape functions and their derivatives (4 nodes)
- do i=1,NGLLA
-
- xi=xigll(i)
-
- do j=1,NGLLB
-
- eta=yigll(j)
-
-! map coordinates to [0,1]
- xi_map = (xi + 1.) / 2.
- eta_map = (eta + 1.) / 2.
-
-! corner nodes
- shape2D(1,i,j) = (1 - xi_map)*(1 - eta_map)
- shape2D(2,i,j) = xi_map*(1 - eta_map)
- shape2D(3,i,j) = xi_map*eta_map
- shape2D(4,i,j) = (1 - xi_map)*eta_map
-
- dershape2D(1,1,i,j) = (eta - 1.) / 4.
- dershape2D(2,1,i,j) = (xi - 1.) / 4.
-
- dershape2D(1,2,i,j) = (1. - eta) / 4.
- dershape2D(2,2,i,j) = (-1. - xi) / 4.
-
- dershape2D(1,3,i,j) = (1. + eta) / 4.
- dershape2D(2,3,i,j) = (1. + xi) / 4.
-
- dershape2D(1,4,i,j) = (- 1. - eta) / 4.
- dershape2D(2,4,i,j) = (1. - xi) / 4.
-
- enddo
- enddo
-
-! check the 2D shape functions
- do i=1,NGLLA
- do j=1,NGLLB
-
- sumshape=ZERO
-
- sumdershapexi=ZERO
- sumdershapeeta=ZERO
-
- do ia=1,NGNOD2D
- sumshape=sumshape+shape2D(ia,i,j)
-
- sumdershapexi=sumdershapexi+dershape2D(1,ia,i,j)
- sumdershapeeta=sumdershapeeta+dershape2D(2,ia,i,j)
- enddo
-
-! the sum of the shape functions should be 1
- if(abs(sumshape-ONE)>TINYVAL) call exit_MPI(myrank,'error in 2D shape functions')
-
-! the sum of the derivatives of the shape functions should be 0
- if(abs(sumdershapexi)>TINYVAL) &
- call exit_MPI(myrank,'error in xi derivatives of 2D shape function')
-
- if(abs(sumdershapeeta)>TINYVAL) &
- call exit_MPI(myrank,'error in eta derivatives of 2D shape function')
-
- enddo
- enddo
-
- end subroutine get_shape2D
-
Deleted: seismo/3D/SPECFEM3D/trunk/get_shape3D.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/get_shape3D.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/get_shape3D.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,269 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
-! 3D shape functions for 8-node element
-
- subroutine get_shape3D(myrank,shape3D,dershape3D,xigll,yigll,zigll)
-
- implicit none
-
- include "constants.h"
-
- integer myrank
-
-! Gauss-Lobatto-Legendre points of integration
- double precision xigll(NGLLX)
- double precision yigll(NGLLY)
- double precision zigll(NGLLZ)
-
-! 3D shape functions and their derivatives
- double precision shape3D(NGNOD,NGLLX,NGLLY,NGLLZ)
- double precision dershape3D(NDIM,NGNOD,NGLLX,NGLLY,NGLLZ)
-
- integer i,j,k,ia
-
-! location of the nodes of the 3D quadrilateral elements
- double precision xi,eta,gamma
- double precision ra1,ra2,rb1,rb2,rc1,rc2
-
-! for checking the 3D shape functions
- double precision sumshape,sumdershapexi,sumdershapeeta,sumdershapegamma
-
- double precision, parameter :: ONE_EIGHTH = 0.125d0
-
-! check that the parameter file is correct
- if(NGNOD /= 8) call exit_MPI(myrank,'elements should have 8 control nodes')
-
-! ***
-! *** create 3D shape functions and jacobian
-! ***
-
-!--- case of a 3D 8-node element (Dhatt-Touzot p. 115)
-
- do i=1,NGLLX
- do j=1,NGLLY
- do k=1,NGLLZ
-
- xi = xigll(i)
- eta = yigll(j)
- gamma = zigll(k)
-
- ra1 = one + xi
- ra2 = one - xi
-
- rb1 = one + eta
- rb2 = one - eta
-
- rc1 = one + gamma
- rc2 = one - gamma
-
- shape3D(1,i,j,k) = ONE_EIGHTH*ra2*rb2*rc2
- shape3D(2,i,j,k) = ONE_EIGHTH*ra1*rb2*rc2
- shape3D(3,i,j,k) = ONE_EIGHTH*ra1*rb1*rc2
- shape3D(4,i,j,k) = ONE_EIGHTH*ra2*rb1*rc2
- shape3D(5,i,j,k) = ONE_EIGHTH*ra2*rb2*rc1
- shape3D(6,i,j,k) = ONE_EIGHTH*ra1*rb2*rc1
- shape3D(7,i,j,k) = ONE_EIGHTH*ra1*rb1*rc1
- shape3D(8,i,j,k) = ONE_EIGHTH*ra2*rb1*rc1
-
- dershape3D(1,1,i,j,k) = - ONE_EIGHTH*rb2*rc2
- dershape3D(1,2,i,j,k) = ONE_EIGHTH*rb2*rc2
- dershape3D(1,3,i,j,k) = ONE_EIGHTH*rb1*rc2
- dershape3D(1,4,i,j,k) = - ONE_EIGHTH*rb1*rc2
- dershape3D(1,5,i,j,k) = - ONE_EIGHTH*rb2*rc1
- dershape3D(1,6,i,j,k) = ONE_EIGHTH*rb2*rc1
- dershape3D(1,7,i,j,k) = ONE_EIGHTH*rb1*rc1
- dershape3D(1,8,i,j,k) = - ONE_EIGHTH*rb1*rc1
-
- dershape3D(2,1,i,j,k) = - ONE_EIGHTH*ra2*rc2
- dershape3D(2,2,i,j,k) = - ONE_EIGHTH*ra1*rc2
- dershape3D(2,3,i,j,k) = ONE_EIGHTH*ra1*rc2
- dershape3D(2,4,i,j,k) = ONE_EIGHTH*ra2*rc2
- dershape3D(2,5,i,j,k) = - ONE_EIGHTH*ra2*rc1
- dershape3D(2,6,i,j,k) = - ONE_EIGHTH*ra1*rc1
- dershape3D(2,7,i,j,k) = ONE_EIGHTH*ra1*rc1
- dershape3D(2,8,i,j,k) = ONE_EIGHTH*ra2*rc1
-
- dershape3D(3,1,i,j,k) = - ONE_EIGHTH*ra2*rb2
- dershape3D(3,2,i,j,k) = - ONE_EIGHTH*ra1*rb2
- dershape3D(3,3,i,j,k) = - ONE_EIGHTH*ra1*rb1
- dershape3D(3,4,i,j,k) = - ONE_EIGHTH*ra2*rb1
- dershape3D(3,5,i,j,k) = ONE_EIGHTH*ra2*rb2
- dershape3D(3,6,i,j,k) = ONE_EIGHTH*ra1*rb2
- dershape3D(3,7,i,j,k) = ONE_EIGHTH*ra1*rb1
- dershape3D(3,8,i,j,k) = ONE_EIGHTH*ra2*rb1
-
- enddo
- enddo
- enddo
-
-!--- check the shape functions and their derivatives
-
- do i=1,NGLLX
- do j=1,NGLLY
- do k=1,NGLLZ
-
- sumshape = ZERO
- sumdershapexi = ZERO
- sumdershapeeta = ZERO
- sumdershapegamma = ZERO
-
- do ia=1,NGNOD
- sumshape = sumshape + shape3D(ia,i,j,k)
- sumdershapexi = sumdershapexi + dershape3D(1,ia,i,j,k)
- sumdershapeeta = sumdershapeeta + dershape3D(2,ia,i,j,k)
- sumdershapegamma = sumdershapegamma + dershape3D(3,ia,i,j,k)
- enddo
-
-! sum of shape functions should be one
-! sum of derivative of shape functions should be zero
- if(abs(sumshape-one) > TINYVAL) call exit_MPI(myrank,'error shape functions')
- if(abs(sumdershapexi) > TINYVAL) call exit_MPI(myrank,'error derivative xi shape functions')
- if(abs(sumdershapeeta) > TINYVAL) call exit_MPI(myrank,'error derivative eta shape functions')
- if(abs(sumdershapegamma) > TINYVAL) call exit_MPI(myrank,'error derivative gamma shape functions')
-
- enddo
- enddo
- enddo
-
- end subroutine get_shape3D
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-! 3D shape functions for given, single xi/eta/gamma location
-
- subroutine get_shape3D_single(myrank,shape3D,xi,eta,gamma)
-
- implicit none
-
- include "constants.h"
-
- integer :: myrank
-
- ! 3D shape functions
- double precision :: shape3D(NGNOD)
-
- ! location
- double precision :: xi,eta,gamma
-
- ! local parameters
- double precision :: ra1,ra2,rb1,rb2,rc1,rc2
- double precision, parameter :: ONE_EIGHTH = 0.125d0
- double precision :: sumshape
- integer :: ia
-
-! check that the parameter file is correct
- if(NGNOD /= 8) call exit_MPI(myrank,'elements should have 8 control nodes')
-
-!--- case of a 3D 8-node element (Dhatt-Touzot p. 115)
- ra1 = one + xi
- ra2 = one - xi
-
- rb1 = one + eta
- rb2 = one - eta
-
- rc1 = one + gamma
- rc2 = one - gamma
-
- ! shape functions
- shape3D(1) = ONE_EIGHTH*ra2*rb2*rc2
- shape3D(2) = ONE_EIGHTH*ra1*rb2*rc2
- shape3D(3) = ONE_EIGHTH*ra1*rb1*rc2
- shape3D(4) = ONE_EIGHTH*ra2*rb1*rc2
- shape3D(5) = ONE_EIGHTH*ra2*rb2*rc1
- shape3D(6) = ONE_EIGHTH*ra1*rb2*rc1
- shape3D(7) = ONE_EIGHTH*ra1*rb1*rc1
- shape3D(8) = ONE_EIGHTH*ra2*rb1*rc1
-
- ! check the shape functions
- sumshape = ZERO
- do ia=1,NGNOD
- sumshape = sumshape + shape3D(ia)
- enddo
-
- ! sum of shape functions should be one
- ! sum of derivative of shape functions should be zero
- if(abs(sumshape-one) > TINYVAL) call exit_MPI(myrank,'error single shape functions')
-
- end subroutine get_shape3D_single
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine get_shape3D_element_corners(xelm,yelm,zelm,ispec,&
- ibool,xstore,ystore,zstore,NSPEC_AB,NGLOB_AB)
-
- implicit none
-
- include "constants.h"
-
- integer :: ispec
- integer :: NSPEC_AB,NGLOB_AB
-
- real(kind=CUSTOM_REAL),dimension(NGNOD),intent(out) :: xelm,yelm,zelm
-
- ! mesh coordinates
- real(kind=CUSTOM_REAL),dimension(NGLOB_AB) :: xstore,ystore,zstore
- integer,dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: ibool
-
-! 8 node corners
- xelm(1)=xstore(ibool(1,1,1,ispec))
- yelm(1)=ystore(ibool(1,1,1,ispec))
- zelm(1)=zstore(ibool(1,1,1,ispec))
-
- xelm(2)=xstore(ibool(NGLLX,1,1,ispec))
- yelm(2)=ystore(ibool(NGLLX,1,1,ispec))
- zelm(2)=zstore(ibool(NGLLX,1,1,ispec))
-
- xelm(3)=xstore(ibool(NGLLX,NGLLY,1,ispec))
- yelm(3)=ystore(ibool(NGLLX,NGLLY,1,ispec))
- zelm(3)=zstore(ibool(NGLLX,NGLLY,1,ispec))
-
- xelm(4)=xstore(ibool(1,NGLLY,1,ispec))
- yelm(4)=ystore(ibool(1,NGLLY,1,ispec))
- zelm(4)=zstore(ibool(1,NGLLY,1,ispec))
-
- xelm(5)=xstore(ibool(1,1,NGLLZ,ispec))
- yelm(5)=ystore(ibool(1,1,NGLLZ,ispec))
- zelm(5)=zstore(ibool(1,1,NGLLZ,ispec))
-
- xelm(6)=xstore(ibool(NGLLX,1,NGLLZ,ispec))
- yelm(6)=ystore(ibool(NGLLX,1,NGLLZ,ispec))
- zelm(6)=zstore(ibool(NGLLX,1,NGLLZ,ispec))
-
- xelm(7)=xstore(ibool(NGLLX,NGLLY,NGLLZ,ispec))
- yelm(7)=ystore(ibool(NGLLX,NGLLY,NGLLZ,ispec))
- zelm(7)=zstore(ibool(NGLLX,NGLLY,NGLLZ,ispec))
-
- xelm(8)=xstore(ibool(1,NGLLY,NGLLZ,ispec))
- yelm(8)=ystore(ibool(1,NGLLY,NGLLZ,ispec))
- zelm(8)=zstore(ibool(1,NGLLY,NGLLZ,ispec))
-
- end subroutine get_shape3D_element_corners
-
-
\ No newline at end of file
Deleted: seismo/3D/SPECFEM3D/trunk/get_value_parameters.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/get_value_parameters.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/get_value_parameters.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,97 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine get_value_integer(value_to_get, name, default_value)
-
- implicit none
-
- integer value_to_get, default_value
- character(len=*) name
-
- call unused_string(name)
-
- value_to_get = default_value
-
- end subroutine get_value_integer
-
-!--------------------
-
- subroutine get_value_double_precision(value_to_get, name, default_value)
-
- implicit none
-
- double precision value_to_get, default_value
- character(len=*) name
-
- call unused_string(name)
-
- value_to_get = default_value
-
- end subroutine get_value_double_precision
-
-!--------------------
-
- subroutine get_value_logical(value_to_get, name, default_value)
-
- implicit none
-
- logical value_to_get, default_value
- character(len=*) name
-
- call unused_string(name)
-
- value_to_get = default_value
-
- end subroutine get_value_logical
-
-!--------------------
-
- subroutine get_value_string(value_to_get, name, default_value)
-
- implicit none
-
- character(len=*) value_to_get, default_value
- character(len=*) name
-
- call unused_string(name)
-
- value_to_get = default_value
-
- end subroutine get_value_string
-
-!--------------------
-
-! dummy subroutine to avoid warnings about variable not used in other subroutines
- subroutine unused_string(s)
-
- implicit none
-
- character(len=*) s
-
- if (len(s) == 1) continue
-
- end subroutine unused_string
-
-
Deleted: seismo/3D/SPECFEM3D/trunk/gll_library.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/gll_library.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/gll_library.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,529 +0,0 @@
-
-!=======================================================================
-!
-! Library to compute the Gauss-Lobatto-Legendre points and weights
-! Based on Gauss-Lobatto routines from M.I.T.
-! Department of Mechanical Engineering
-!
-!=======================================================================
-
- double precision function endw1(n,alpha,beta)
-
- implicit none
-
- integer n
- double precision alpha,beta
-
- double precision, parameter :: zero=0.d0,one=1.d0,two=2.d0,three=3.d0,four=4.d0
- double precision apb,f1,fint1,fint2,f2,di,abn,abnn,a1,a2,a3,f3
- double precision, external :: gammaf
- integer i
-
- f3 = zero
- apb = alpha+beta
- if (n == 0) then
- endw1 = zero
- return
- endif
- f1 = gammaf(alpha+two)*gammaf(beta+one)/gammaf(apb+three)
- f1 = f1*(apb+two)*two**(apb+two)/two
- if (n == 1) then
- endw1 = f1
- return
- endif
- fint1 = gammaf(alpha+two)*gammaf(beta+one)/gammaf(apb+three)
- fint1 = fint1*two**(apb+two)
- fint2 = gammaf(alpha+two)*gammaf(beta+two)/gammaf(apb+four)
- fint2 = fint2*two**(apb+three)
- f2 = (-two*(beta+two)*fint1 + (apb+four)*fint2) * (apb+three)/four
- if (n == 2) then
- endw1 = f2
- return
- endif
- do i=3,n
- di = dble(i-1)
- abn = alpha+beta+di
- abnn = abn+di
- a1 = -(two*(di+alpha)*(di+beta))/(abn*abnn*(abnn+one))
- a2 = (two*(alpha-beta))/(abnn*(abnn+two))
- a3 = (two*(abn+one))/((abnn+two)*(abnn+one))
- f3 = -(a2*f2+a1*f1)/a3
- f1 = f2
- f2 = f3
- enddo
- endw1 = f3
-
- end function endw1
-
-!
-!=======================================================================
-!
-
- double precision function endw2(n,alpha,beta)
-
- implicit none
-
- integer n
- double precision alpha,beta
-
- double precision, parameter :: zero=0.d0,one=1.d0,two=2.d0,three=3.d0,four=4.d0
- double precision apb,f1,fint1,fint2,f2,di,abn,abnn,a1,a2,a3,f3
- double precision, external :: gammaf
- integer i
-
- apb = alpha+beta
- f3 = zero
- if (n == 0) then
- endw2 = zero
- return
- endif
- f1 = gammaf(alpha+one)*gammaf(beta+two)/gammaf(apb+three)
- f1 = f1*(apb+two)*two**(apb+two)/two
- if (n == 1) then
- endw2 = f1
- return
- endif
- fint1 = gammaf(alpha+one)*gammaf(beta+two)/gammaf(apb+three)
- fint1 = fint1*two**(apb+two)
- fint2 = gammaf(alpha+two)*gammaf(beta+two)/gammaf(apb+four)
- fint2 = fint2*two**(apb+three)
- f2 = (two*(alpha+two)*fint1 - (apb+four)*fint2) * (apb+three)/four
- if (n == 2) then
- endw2 = f2
- return
- endif
- do i=3,n
- di = dble(i-1)
- abn = alpha+beta+di
- abnn = abn+di
- a1 = -(two*(di+alpha)*(di+beta))/(abn*abnn*(abnn+one))
- a2 = (two*(alpha-beta))/(abnn*(abnn+two))
- a3 = (two*(abn+one))/((abnn+two)*(abnn+one))
- f3 = -(a2*f2+a1*f1)/a3
- f1 = f2
- f2 = f3
- enddo
- endw2 = f3
-
- end function endw2
-
-!
-!=======================================================================
-!
-
- double precision function gammaf (x)
-
- implicit none
-
- double precision, parameter :: pi = 3.141592653589793d0
-
- double precision x
-
- double precision, parameter :: half=0.5d0,one=1.d0,two=2.d0
-
- gammaf = one
-
- if (x == -half) gammaf = -two*dsqrt(pi)
- if (x == half) gammaf = dsqrt(pi)
- if (x == one ) gammaf = one
- if (x == two ) gammaf = one
- if (x == 1.5d0) gammaf = dsqrt(pi)/2.d0
- if (x == 2.5d0) gammaf = 1.5d0*dsqrt(pi)/2.d0
- if (x == 3.5d0) gammaf = 2.5d0*1.5d0*dsqrt(pi)/2.d0
- if (x == 3.d0 ) gammaf = 2.d0
- if (x == 4.d0 ) gammaf = 6.d0
- if (x == 5.d0 ) gammaf = 24.d0
- if (x == 6.d0 ) gammaf = 120.d0
-
- end function gammaf
-
-!
-!=====================================================================
-!
-
- subroutine jacg (xjac,np,alpha,beta)
-
-!=======================================================================
-!
-! computes np Gauss points, which are the zeros of the
-! Jacobi polynomial with parameters alpha and beta
-!
-! .alpha = beta = 0.0 -> Legendre points
-! .alpha = beta = -0.5 -> Chebyshev points
-!
-!=======================================================================
-
- implicit none
-
- integer np
- double precision alpha,beta
- double precision xjac(np)
-
- integer k,j,i,jmin,jm,n
- double precision xlast,dth,x,x1,x2,recsum,delx,xmin,swap
- double precision p,pd,pm1,pdm1,pm2,pdm2
-
- integer, parameter :: K_MAX_ITER = 10
- double precision, parameter :: zero = 0.d0, eps = 1.0d-12
-
- pm1 = zero
- pm2 = zero
- pdm1 = zero
- pdm2 = zero
-
- xlast = 0.d0
- n = np-1
- dth = 4.d0*datan(1.d0)/(2.d0*dble(n)+2.d0)
- p = 0.d0
- pd = 0.d0
- jmin = 0
- do j=1,np
- if(j == 1) then
- x = dcos((2.d0*(dble(j)-1.d0)+1.d0)*dth)
- else
- x1 = dcos((2.d0*(dble(j)-1.d0)+1.d0)*dth)
- x2 = xlast
- x = (x1+x2)/2.d0
- endif
- do k=1,K_MAX_ITER
- call jacobf (p,pd,pm1,pdm1,pm2,pdm2,np,alpha,beta,x)
- recsum = 0.d0
- jm = j-1
- do i=1,jm
- recsum = recsum+1.d0/(x-xjac(np-i+1))
- enddo
- delx = -p/(pd-recsum*p)
- x = x+delx
- if(abs(delx) < eps) goto 31
- enddo
- 31 continue
- xjac(np-j+1) = x
- xlast = x
- enddo
- do i=1,np
- xmin = 2.d0
- do j=i,np
- if(xjac(j) < xmin) then
- xmin = xjac(j)
- jmin = j
- endif
- enddo
- if(jmin /= i) then
- swap = xjac(i)
- xjac(i) = xjac(jmin)
- xjac(jmin) = swap
- endif
- enddo
-
- end subroutine jacg
-
-!
-!=====================================================================
-!
-
- subroutine jacobf (poly,pder,polym1,pderm1,polym2,pderm2,n,alp,bet,x)
-
-!=======================================================================
-!
-! Computes the Jacobi polynomial of degree n and its derivative at x
-!
-!=======================================================================
-
- implicit none
-
- double precision poly,pder,polym1,pderm1,polym2,pderm2,alp,bet,x
- integer n
-
- double precision apb,polyl,pderl,dk,a1,a2,b3,a3,a4,polyn,pdern,psave,pdsave
- integer k
-
- apb = alp+bet
- poly = 1.d0
- pder = 0.d0
- psave = 0.d0
- pdsave = 0.d0
-
- if (n == 0) return
-
- polyl = poly
- pderl = pder
- poly = (alp-bet+(apb+2.d0)*x)/2.d0
- pder = (apb+2.d0)/2.d0
- if (n == 1) return
-
- do k=2,n
- dk = dble(k)
- a1 = 2.d0*dk*(dk+apb)*(2.d0*dk+apb-2.d0)
- a2 = (2.d0*dk+apb-1.d0)*(alp**2-bet**2)
- b3 = (2.d0*dk+apb-2.d0)
- a3 = b3*(b3+1.d0)*(b3+2.d0)
- a4 = 2.d0*(dk+alp-1.d0)*(dk+bet-1.d0)*(2.d0*dk+apb)
- polyn = ((a2+a3*x)*poly-a4*polyl)/a1
- pdern = ((a2+a3*x)*pder-a4*pderl+a3*poly)/a1
- psave = polyl
- pdsave = pderl
- polyl = poly
- poly = polyn
- pderl = pder
- pder = pdern
- enddo
-
- polym1 = polyl
- pderm1 = pderl
- polym2 = psave
- pderm2 = pdsave
-
- end subroutine jacobf
-
-!
-!------------------------------------------------------------------------
-!
-
- double precision FUNCTION PNDLEG (Z,N)
-
-!------------------------------------------------------------------------
-!
-! Compute the derivative of the Nth order Legendre polynomial at Z.
-! Based on the recursion formula for the Legendre polynomials.
-!
-!------------------------------------------------------------------------
- implicit none
-
- double precision z
- integer n
-
- double precision P1,P2,P1D,P2D,P3D,FK,P3
- integer k
-
- P1 = 1.d0
- P2 = Z
- P1D = 0.d0
- P2D = 1.d0
- P3D = 1.d0
-
- do K = 1, N-1
- FK = dble(K)
- P3 = ((2.d0*FK+1.d0)*Z*P2 - FK*P1)/(FK+1.d0)
- P3D = ((2.d0*FK+1.d0)*P2 + (2.d0*FK+1.d0)*Z*P2D - FK*P1D) / (FK+1.d0)
- P1 = P2
- P2 = P3
- P1D = P2D
- P2D = P3D
- enddo
-
- PNDLEG = P3D
-
- end function pndleg
-
-!
-!------------------------------------------------------------------------
-!
-
- double precision FUNCTION PNLEG (Z,N)
-
-!------------------------------------------------------------------------
-!
-! Compute the value of the Nth order Legendre polynomial at Z.
-! Based on the recursion formula for the Legendre polynomials.
-!
-!------------------------------------------------------------------------
- implicit none
-
- double precision z
- integer n
-
- double precision P1,P2,P3,FK
- integer k
-
- P1 = 1.d0
- P2 = Z
- P3 = P2
-
- do K = 1, N-1
- FK = dble(K)
- P3 = ((2.d0*FK+1.d0)*Z*P2 - FK*P1)/(FK+1.d0)
- P1 = P2
- P2 = P3
- enddo
-
- PNLEG = P3
-
- end function pnleg
-
-!
-!------------------------------------------------------------------------
-!
-
- double precision function pnormj (n,alpha,beta)
-
- implicit none
-
- double precision alpha,beta
- integer n
-
- double precision one,two,dn,const,prod,dindx,frac
- double precision, external :: gammaf
- integer i
-
- one = 1.d0
- two = 2.d0
- dn = dble(n)
- const = alpha+beta+one
-
- if (n <= 1) then
- prod = gammaf(dn+alpha)*gammaf(dn+beta)
- prod = prod/(gammaf(dn)*gammaf(dn+alpha+beta))
- pnormj = prod * two**const/(two*dn+const)
- return
- endif
-
- prod = gammaf(alpha+one)*gammaf(beta+one)
- prod = prod/(two*(one+const)*gammaf(const+one))
- prod = prod*(one+alpha)*(two+alpha)
- prod = prod*(one+beta)*(two+beta)
-
- do i=3,n
- dindx = dble(i)
- frac = (dindx+alpha)*(dindx+beta)/(dindx*(dindx+alpha+beta))
- prod = prod*frac
- enddo
-
- pnormj = prod * two**const/(two*dn+const)
-
- end function pnormj
-
-!
-!------------------------------------------------------------------------
-!
-
- subroutine zwgjd(z,w,np,alpha,beta)
-
-!=======================================================================
-!
-! Z w g j d : Generate np Gauss-Jacobi points and weights
-! associated with Jacobi polynomial of degree n = np-1
-!
-! Note : Coefficients alpha and beta must be greater than -1.
-! ----
-!=======================================================================
-
- implicit none
-
- double precision, parameter :: zero=0.d0,one=1.d0,two=2.d0
-
- integer np
- double precision z(np),w(np)
- double precision alpha,beta
-
- integer n,np1,np2,i
- double precision p,pd,pm1,pdm1,pm2,pdm2
- double precision apb,dnp1,dnp2,fac1,fac2,fac3,fnorm,rcoef
- double precision, external :: gammaf,pnormj
-
- pd = zero
- pm1 = zero
- pm2 = zero
- pdm1 = zero
- pdm2 = zero
-
- n = np-1
- apb = alpha+beta
- p = zero
- pdm1 = zero
-
- if (np <= 0) stop 'minimum number of Gauss points is 1'
-
- if ((alpha <= -one) .or. (beta <= -one)) stop 'alpha and beta must be greater than -1'
-
- if (np == 1) then
- z(1) = (beta-alpha)/(apb+two)
- w(1) = gammaf(alpha+one)*gammaf(beta+one)/gammaf(apb+two) * two**(apb+one)
- return
- endif
-
- call jacg(z,np,alpha,beta)
-
- np1 = n+1
- np2 = n+2
- dnp1 = dble(np1)
- dnp2 = dble(np2)
- fac1 = dnp1+alpha+beta+one
- fac2 = fac1+dnp1
- fac3 = fac2+one
- fnorm = pnormj(np1,alpha,beta)
- rcoef = (fnorm*fac2*fac3)/(two*fac1*dnp2)
- do i=1,np
- call jacobf(p,pd,pm1,pdm1,pm2,pdm2,np2,alpha,beta,z(i))
- w(i) = -rcoef/(p*pdm1)
- enddo
-
- end subroutine zwgjd
-
-!
-!------------------------------------------------------------------------
-!
-
- subroutine zwgljd(z,w,np,alpha,beta)
-
-!=======================================================================
-!
-! Z w g l j d : Generate np Gauss-Lobatto-Jacobi points and the
-! ----------- weights associated with Jacobi polynomials of degree
-! n = np-1.
-!
-! Note : alpha and beta coefficients must be greater than -1.
-! Legendre polynomials are special case of Jacobi polynomials
-! just by setting alpha and beta to 0.
-!
-!=======================================================================
-
- implicit none
-
- double precision, parameter :: zero=0.d0,one=1.d0,two=2.d0
-
- integer np
- double precision alpha,beta
- double precision z(np), w(np)
-
- integer n,nm1,i
- double precision p,pd,pm1,pdm1,pm2,pdm2
- double precision alpg,betg
- double precision, external :: endw1,endw2
-
- p = zero
- pm1 = zero
- pm2 = zero
- pdm1 = zero
- pdm2 = zero
-
- n = np-1
- nm1 = n-1
- pd = zero
-
- if (np <= 1) stop 'minimum number of Gauss-Lobatto points is 2'
-
-! with spectral elements, use at least 3 points
- if (np <= 2) stop 'minimum number of Gauss-Lobatto points for the SEM is 3'
-
- if ((alpha <= -one) .or. (beta <= -one)) stop 'alpha and beta must be greater than -1'
-
- if (nm1 > 0) then
- alpg = alpha+one
- betg = beta+one
- call zwgjd(z(2),w(2),nm1,alpg,betg)
- endif
-
- z(1) = - one
- z(np) = one
-
- do i=2,np-1
- w(i) = w(i)/(one-z(i)**2)
- enddo
-
- call jacobf(p,pd,pm1,pdm1,pm2,pdm2,n,alpha,beta,z(1))
- w(1) = endw1(n,alpha,beta)/(two*pd)
- call jacobf(p,pd,pm1,pdm1,pm2,pdm2,n,alpha,beta,z(np))
- w(np) = endw2(n,alpha,beta)/(two*pd)
-
- end subroutine zwgljd
-
Deleted: seismo/3D/SPECFEM3D/trunk/hex_nodes.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/hex_nodes.f90 2010-10-18 02:07:28 UTC (rev 17292)
+++ seismo/3D/SPECFEM3D/trunk/hex_nodes.f90 2010-10-20 12:16:18 UTC (rev 17293)
@@ -1,478 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- subroutine usual_hex_nodes(iaddx,iaddy,iaddz)
-
- implicit none
-
- include "constants.h"
-
- integer iaddx(NGNOD),iaddy(NGNOD),iaddz(NGNOD)
-
-! define the topology of the hexahedral elements
-
-! check that the parameter file is correct
- if(NGNOD /= 8) stop 'elements should have 8 control nodes'
-
-! corner nodes
- iaddx(1)=0
- iaddy(1)=0
- iaddz(1)=0
-
- iaddx(2)=2
- iaddy(2)=0
- iaddz(2)=0
-
- iaddx(3)=2
- iaddy(3)=2
- iaddz(3)=0
-
- iaddx(4)=0
- iaddy(4)=2
- iaddz(4)=0
-
- iaddx(5)=0
- iaddy(5)=0
- iaddz(5)=2
-
- iaddx(6)=2
- iaddy(6)=0
- iaddz(6)=2
-
- iaddx(7)=2
- iaddy(7)=2
- iaddz(7)=2
-
- iaddx(8)=0
- iaddy(8)=2
- iaddz(8)=2
-
- end subroutine usual_hex_nodes
-
- subroutine unusual_hex_nodes1(iaddx,iaddy,iaddz)
-
- implicit none
-
- include "constants.h"
-
- integer iaddx(NGNOD),iaddy(NGNOD),iaddz(NGNOD)
-
-! define the topology of the hexahedral elements
-
-! corner nodes
- iaddx(1)=0
- iaddy(1)=0
- iaddz(1)=0
-
- iaddx(2)=4
- iaddy(2)=0
- iaddz(2)=0
-
- iaddx(3)=4
- iaddy(3)=4
- iaddz(3)=0
-
- iaddx(4)=0
- iaddy(4)=4
- iaddz(4)=0
-
- iaddx(5)=2
- iaddy(5)=0
- iaddz(5)=2
-
- iaddx(6)=4
- iaddy(6)=0
- iaddz(6)=2
-
- iaddx(7)=4
- iaddy(7)=4
- iaddz(7)=2
-
- iaddx(8)=2
- iaddy(8)=4
- iaddz(8)=2
-
- end subroutine unusual_hex_nodes1
-
- subroutine unusual_hex_nodes1p(iaddx,iaddy,iaddz)
-
- implicit none
-
- include "constants.h"
-
- integer iaddx(NGNOD),iaddy(NGNOD),iaddz(NGNOD)
-
-! define the topology of the hexahedral elements
-
-! corner nodes
- iaddx(1)=0
- iaddy(1)=0
- iaddz(1)=0
-
- iaddx(2)=4
- iaddy(2)=0
- iaddz(2)=0
-
- iaddx(3)=4
- iaddy(3)=4
- iaddz(3)=0
-
- iaddx(4)=0
- iaddy(4)=4
- iaddz(4)=0
-
- iaddx(5)=0
- iaddy(5)=0
- iaddz(5)=2
-
- iaddx(6)=2
- iaddy(6)=0
- iaddz(6)=2
-
- iaddx(7)=2
- iaddy(7)=4
- iaddz(7)=2
-
- iaddx(8)=0
- iaddy(8)=4
- iaddz(8)=2
-
- end subroutine unusual_hex_nodes1p
-
- subroutine unusual_hex_nodes2(iaddx,iaddy,iaddz)
-
- implicit none
-
- include "constants.h"
-
- integer iaddx(NGNOD),iaddy(NGNOD),iaddz(NGNOD)
-
-! define the topology of the hexahedral elements
-
-! corner nodes
- iaddx(1)=0
- iaddy(1)=0
- iaddz(1)=0
-
- iaddx(2)=2
- iaddy(2)=0
- iaddz(2)=2
-
- iaddx(3)=2
- iaddy(3)=4
- iaddz(3)=2
-
- iaddx(4)=0
- iaddy(4)=4
- iaddz(4)=0
-
- iaddx(5)=0
- iaddy(5)=0
- iaddz(5)=4
-
- iaddx(6)=2
- iaddy(6)=0
- iaddz(6)=4
-
- iaddx(7)=2
- iaddy(7)=4
- iaddz(7)=4
-
- iaddx(8)=0
- iaddy(8)=4
- iaddz(8)=4
-
- end subroutine unusual_hex_nodes2
-
- subroutine unusual_hex_nodes2p(iaddx,iaddy,iaddz)
-
- implicit none
-
- include "constants.h"
-
- integer iaddx(NGNOD),iaddy(NGNOD),iaddz(NGNOD)
-
-! define the topology of the hexahedral elements
-
-! corner nodes
- iaddx(1)=0
- iaddy(1)=0
- iaddz(1)=0
-
- iaddx(2)=2
- iaddy(2)=0
- iaddz(2)=-2
-
- iaddx(3)=2
- iaddy(3)=4
- iaddz(3)=-2
-
- iaddx(4)=0
- iaddy(4)=4
- iaddz(4)=0
-
- iaddx(5)=0
- iaddy(5)=0
- iaddz(5)=2
-
- iaddx(6)=2
- iaddy(6)=0
- iaddz(6)=2
-
- iaddx(7)=2
- iaddy(7)=4
- iaddz(7)=2
-
- iaddx(8)=0
- iaddy(8)=4
- iaddz(8)=2
-
- end subroutine unusual_hex_nodes2p
-
- subroutine unusual_hex_nodes3(iaddx,iaddy,iaddz)
-
- implicit none
-
- include "constants.h"
-
- integer iaddx(NGNOD),iaddy(NGNOD),iaddz(NGNOD)
-
-! define the topology of the hexahedral elements
-
-! corner nodes
- iaddx(1)=0
- iaddy(1)=0
- iaddz(1)=0
-
- iaddx(2)=2
- iaddy(2)=0
- iaddz(2)=0
-
- iaddx(3)=2
- iaddy(3)=4
- iaddz(3)=0
-
- iaddx(4)=0
- iaddy(4)=4
- iaddz(4)=0
-
- iaddx(5)=0
- iaddy(5)=0
- iaddz(5)=2
-
- iaddx(6)=2
- iaddy(6)=0
- iaddz(6)=2
-
- iaddx(7)=2
- iaddy(7)=4
- iaddz(7)=2
-
- iaddx(8)=0
- iaddy(8)=4
- iaddz(8)=2
-
- end subroutine unusual_hex_nodes3
-
- subroutine unusual_hex_nodes4(iaddx,iaddy,iaddz)
-
- implicit none
-
- include "constants.h"
-
- integer iaddx(NGNOD),iaddy(NGNOD),iaddz(NGNOD)
-
-! define the topology of the hexahedral elements
-
-! corner nodes
- iaddx(1)=0
- iaddy(1)=0
- iaddz(1)=0
-
- iaddx(2)=2
- iaddy(2)=0
- iaddz(2)=0
-
- iaddx(3)=2
- iaddy(3)=4
- iaddz(3)=0
-
- iaddx(4)=0
- iaddy(4)=4
- iaddz(4)=0
-
- iaddx(5)=0
- iaddy(5)=0
- iaddz(5)=2
-
- iaddx(6)=2
- iaddy(6)=0
- iaddz(6)=2
-
- iaddx(7)=2
- iaddy(7)=2
- iaddz(7)=2
-
- iaddx(8)=0
- iaddy(8)=2
- iaddz(8)=2
-
- end subroutine unusual_hex_nodes4
-
- subroutine unusual_hex_nodes4p(iaddx,iaddy,iaddz)
-
- implicit none
-
- include "constants.h"
-
- integer iaddx(NGNOD),iaddy(NGNOD),iaddz(NGNOD)
-
-! define the topology of the hexahedral elements
-
-! corner nodes
- iaddx(1)=0
- iaddy(1)=0
- iaddz(1)=0
-
- iaddx(2)=2
- iaddy(2)=0
- iaddz(2)=0
-
- iaddx(3)=2
- iaddy(3)=4
- iaddz(3)=0
-
- iaddx(4)=0
- iaddy(4)=4
- iaddz(4)=0
-
- iaddx(5)=0
- iaddy(5)=2
- iaddz(5)=2
-
- iaddx(6)=2
- iaddy(6)=2
- iaddz(6)=2
-
- iaddx(7)=2
- iaddy(7)=4
- iaddz(7)=2
-
- iaddx(8)=0
- iaddy(8)=4
- iaddz(8)=2
-
- end subroutine unusual_hex_nodes4p
-
- subroutine unusual_hex_nodes6(iaddx,iaddy,iaddz)
-
- implicit none
-
- include "constants.h"
-
- integer iaddx(NGNOD),iaddy(NGNOD),iaddz(NGNOD)
-
-! define the topology of the hexahedral elements
-
-! corner nodes
- iaddx(1)=0
- iaddy(1)=0
- iaddz(1)=0
-
- iaddx(2)=2
- iaddy(2)=0
- iaddz(2)=0
-
- iaddx(3)=2
- iaddy(3)=2
- iaddz(3)=-2
-
- iaddx(4)=0
- iaddy(4)=2
- iaddz(4)=-2
-
- iaddx(5)=0
- iaddy(5)=0
- iaddz(5)=2
-
- iaddx(6)=2
- iaddy(6)=0
- iaddz(6)=2
-
- iaddx(7)=2
- iaddy(7)=2
- iaddz(7)=2
-
- iaddx(8)=0
- iaddy(8)=2
- iaddz(8)=2
-
- end subroutine unusual_hex_nodes6
-
- subroutine unusual_hex_nodes6p(iaddx,iaddy,iaddz)
-
- implicit none
-
- include "constants.h"