[cig-commits] r19915 - in seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER: . DATA EXAMPLES/global_PREM_kernels/traveltime/DATA EXAMPLES/global_s362ani_small/DATA EXAMPLES/regional_Greece_small/DATA EXAMPLES/regional_MiddleEast/DATA UTILS setup src/auxiliaries src/create_header_file src/cuda src/meshfem3D src/shared src/specfem3D
danielpeter at geodynamics.org
danielpeter at geodynamics.org
Sun Apr 1 23:04:52 PDT 2012
Author: danielpeter
Date: 2012-04-01 23:04:51 -0700 (Sun, 01 Apr 2012)
New Revision: 19915
Added:
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/UTILS/update_headers_change_word_f90.pl
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/auxiliaries/combine_vol_data_vtk.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/compute_area.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/compute_volumes.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_addressing.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_meshes.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/finalize_mesher.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/initialize_layers.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/initialize_mesher.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/meshfem3D_par.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/setup_counters.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/setup_model.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/count_elements.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/count_points.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/define_all_layers.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/get_timestep_and_layers.f90
Modified:
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/DATA/Par_file
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/global_PREM_kernels/traveltime/DATA/Par_file
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/global_s362ani_small/DATA/Par_file
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/regional_Greece_small/DATA/Par_file
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/regional_MiddleEast/DATA/Par_file
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/Makefile.in
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/setup/constants.h.in
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/auxiliaries/Makefile.in
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/create_header_file/Makefile.in
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/cuda/specfem3D_gpu_cuda_method_stubs.c
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/Makefile.in
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_central_cube.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_regions_mesh.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/get_jacobian_boundaries.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/meshfem3D.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/save_arrays_solver.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/memory_eval.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/read_compute_parameters.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/Makefile.in
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/assemble_MPI_central_cube_block.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/check_simulation_stability.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_crust_mantle.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_crust_mantle_Dev.F90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_inner_core.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_inner_core_Dev.F90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_outer_core.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_outer_core_Dev.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/create_central_cube_buffers.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/fix_non_blocking_flags.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/get_event_info.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/iterate_time.F90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/locate_receivers.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/locate_sources.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/prepare_timerun.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/read_arrays_buffers_solver.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/read_mesh_databases.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/save_kernels.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/setup_sources_receivers.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/specfem3D_par.F90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/write_movie_output.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/write_movie_surface.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/write_movie_volume.f90
Log:
updates mpi interfaces; adds support for nproc_xi==1
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/DATA/Par_file
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/DATA/Par_file 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/DATA/Par_file 2012-04-02 06:04:51 UTC (rev 19915)
@@ -62,7 +62,7 @@
# start/stop: frames will be stored at MOVIE_START + i*NSTEP_BETWEEN_FRAMES, where i=(0,1,2..) and iNSTEP_BETWEEN_FRAMES <= MOVIE_STOP
# movie_volume_type: 1=strain, 2=time integral of strain, 3=\mu*time integral of strain
# type 4 saves the trace and deviatoric stress in the whole volume, 5=displacement, 6=velocity
-#MOVIE_VOLUME_COARSE saves movie only at corners of elements
+# MOVIE_COARSE saves movie only at corners of elements
MOVIE_VOLUME_TYPE = 2
MOVIE_TOP_KM = -100.0
MOVIE_BOTTOM_KM = 1000.0
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/global_PREM_kernels/traveltime/DATA/Par_file
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/global_PREM_kernels/traveltime/DATA/Par_file 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/global_PREM_kernels/traveltime/DATA/Par_file 2012-04-02 06:04:51 UTC (rev 19915)
@@ -1,6 +1,6 @@
# forward or adjoint simulation
-SIMULATION_TYPE = 3
+SIMULATION_TYPE = 1
NOISE_TOMOGRAPHY = 0 # flag of noise tomography, three steps (1,2,3). If earthquake simulation, set it to 0.
SAVE_FORWARD = .false. # save last frame of forward simulation or not
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/global_s362ani_small/DATA/Par_file
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/global_s362ani_small/DATA/Par_file 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/global_s362ani_small/DATA/Par_file 2012-04-02 06:04:51 UTC (rev 19915)
@@ -20,8 +20,8 @@
NEX_ETA = 96
# number of MPI processors along the two sides of the first chunk
-NPROC_XI = 2
-NPROC_ETA = 2
+NPROC_XI = 1
+NPROC_ETA = 1
# 1D models with real structure:
# 1D_isotropic_prem, 1D_transversely_isotropic_prem, 1D_iasp91, 1D_1066a, 1D_ak135, 1D_ref, 1D_ref_iso
@@ -52,7 +52,7 @@
MOVIE_SURFACE = .false.
MOVIE_VOLUME = .false.
MOVIE_COARSE = .true.
-NTSTEP_BETWEEN_FRAMES = 500
+NTSTEP_BETWEEN_FRAMES = 1000
HDUR_MOVIE = 0.d0
# save movie in volume. Will save element if center of element is in prescribed volume
@@ -61,9 +61,8 @@
# start/stop: frames will be stored at MOVIE_START + i*NSTEP_BETWEEN_FRAMES, where i=(0,1,2..) and iNSTEP_BETWEEN_FRAMES <= MOVIE_STOP
# movie_volume_type: 1=strain, 2=time integral of strain, 3=\mu*time integral of strain
# type 4 saves the trace and deviatoric stress in the whole volume
-#MOVIE_VOLUME_COARSE saves movie only at corners of elements
+# MOVIE_COARSE saves movie only at corners of elements
MOVIE_VOLUME_TYPE = 6
-#MOVIE_VOLUME_COARSE = .true.
MOVIE_TOP_KM = -100.0
MOVIE_BOTTOM_KM = 1000.0
MOVIE_WEST_DEG = 0.0
@@ -74,7 +73,7 @@
MOVIE_STOP = 40000
# save mesh files to check the mesh
-SAVE_MESH_FILES = .false.
+SAVE_MESH_FILES = .true.
# restart files (number of runs can be 1, 2 or 3, choose 1 for no restart files)
NUMBER_OF_RUNS = 1
@@ -87,16 +86,16 @@
LOCAL_TMP_PATH = ./DATABASES_MPI
# interval at which we output time step info and max of norm of displacement
-NTSTEP_BETWEEN_OUTPUT_INFO = 1000
+NTSTEP_BETWEEN_OUTPUT_INFO = 500
# interval in time steps for temporary writing of seismograms
NTSTEP_BETWEEN_OUTPUT_SEISMOS = 5000000
NTSTEP_BETWEEN_READ_ADJSRC = 100000
# output format for the seismograms (one can use either or all of the three formats)
-OUTPUT_SEISMOS_ASCII_TEXT = .false.
+OUTPUT_SEISMOS_ASCII_TEXT = .true.
OUTPUT_SEISMOS_SAC_ALPHANUM = .false.
-OUTPUT_SEISMOS_SAC_BINARY = .true.
+OUTPUT_SEISMOS_SAC_BINARY = .false.
# rotate seismograms to Radial-Transverse-Z or use default North-East-Z reference frame
ROTATE_SEISMOGRAMS_RT = .false.
@@ -116,4 +115,4 @@
PRINT_SOURCE_TIME_FUNCTION = .false.
# set to true to use GPUs
-GPU_MODE = .false.
+GPU_MODE = .true.
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/regional_Greece_small/DATA/Par_file
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/regional_Greece_small/DATA/Par_file 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/regional_Greece_small/DATA/Par_file 2012-04-02 06:04:51 UTC (rev 19915)
@@ -62,7 +62,7 @@
# start/stop: frames will be stored at MOVIE_START + i*NSTEP_BETWEEN_FRAMES, where i=(0,1,2..) and iNSTEP_BETWEEN_FRAMES <= MOVIE_STOP
# movie_volume_type: 1=strain, 2=time integral of strain, 3=\mu*time integral of strain
# type 4 saves the trace and deviatoric stress in the whole volume, 5=displacement, 6=velocity
-#MOVIE_VOLUME_COARSE saves movie only at corners of elements
+# MOVIE_COARSE saves movie only at corners of elements
MOVIE_VOLUME_TYPE = 2
MOVIE_TOP_KM = -100.0
MOVIE_BOTTOM_KM = 1000.0
@@ -87,7 +87,7 @@
LOCAL_TMP_PATH = ./DATABASES_MPI
# interval at which we output time step info and max of norm of displacement
-NTSTEP_BETWEEN_OUTPUT_INFO = 50
+NTSTEP_BETWEEN_OUTPUT_INFO = 500
# interval in time steps for temporary writing of seismograms
NTSTEP_BETWEEN_OUTPUT_SEISMOS = 5000000
@@ -116,5 +116,5 @@
PRINT_SOURCE_TIME_FUNCTION = .false.
# set to true to use GPUs
-GPU_MODE = .false.
+GPU_MODE = .true.
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/regional_MiddleEast/DATA/Par_file
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/regional_MiddleEast/DATA/Par_file 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/EXAMPLES/regional_MiddleEast/DATA/Par_file 2012-04-02 06:04:51 UTC (rev 19915)
@@ -62,7 +62,7 @@
# start/stop: frames will be stored at MOVIE_START + i*NSTEP_BETWEEN_FRAMES, where i=(0,1,2..) and iNSTEP_BETWEEN_FRAMES <= MOVIE_STOP
# movie_volume_type: 1=strain, 2=time integral of strain, 3=\mu*time integral of strain
# type 4 saves the trace and deviatoric stress in the whole volume, 5=displacement, 6=velocity
-#MOVIE_VOLUME_COARSE saves movie only at corners of elements
+# MOVIE_COARSE saves movie only at corners of elements
MOVIE_VOLUME_TYPE = 2
MOVIE_TOP_KM = -100.0
MOVIE_BOTTOM_KM = 1000.0
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/Makefile.in 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/Makefile.in 2012-04-02 06:04:51 UTC (rev 19915)
@@ -65,6 +65,7 @@
create_header_file: xcreate_header_file
combine_vol_data: xcombine_vol_data
+combine_vol_data_vtk: xcombine_vol_data_vtk
combine_surf_data: xcombine_surf_data
convolve_source_timefunction: xconvolve_source_timefunction
create_movie_AVS_DX: xcreate_movie_AVS_DX
@@ -104,6 +105,9 @@
xcombine_vol_data: required
(cd src/auxiliaries ; make xcombine_vol_data)
+xcombine_vol_data_vtk: required
+ (cd src/auxiliaries ; make xcombine_vol_data_vtk)
+
xcombine_surf_data: required
(cd src/auxiliaries ; make xcombine_surf_data)
@@ -133,6 +137,7 @@
@echo " xcheck_buffers_corners_chunks"
@echo " xcheck_buffers_faces_chunks"
@echo " xcombine_vol_data"
+ @echo " xcombine_vol_data_vtk"
@echo " xcombine_surf_data"
@echo " xconvolve_source_timefunction"
@echo " xcreate_movie_AVS_DX"
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/UTILS/update_headers_change_word_f90.pl
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/UTILS/update_headers_change_word_f90.pl (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/UTILS/update_headers_change_word_f90.pl 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+#
+# Script to change the version number in f90 codes
+#
+# Author : Dimitri Komatitsch, EPS - Harvard University, May 1998
+#
+
+#
+# read all f90 and F90 (and *.h) files in the current directory
+# f90 files are supposed to have the extension "*.f90" or "*.F90" or "*.h"
+#
+
+#
+# known bug : does the changes also in constant strings, and not only
+# in the code (which is dangerous, but really easier to program...)
+#
+
+#
+# usage: ./update_headers_change_word_f90.pl
+# run in directory root SPECFEM3D/
+#
+
+
+ at objects = `ls src/*/*.f90 src/*/*.F90 src/*/*.h.in src/*/*.h src/*/*.c src/*/*.cu`;
+
+foreach $name (@objects) {
+ chop $name;
+
+# change tabs to white spaces
+ system("expand -2 < $name > _____tutu01_____");
+ $f90name = $name;
+ print STDOUT "Changing word in file $name ...\n";
+
+ open(FILEF77,"<_____tutu01_____");
+ open(FILEF90,">$f90name");
+
+# open the source file
+ while($line = <FILEF77>) {
+ chop $line;
+
+# suppress trailing white spaces and carriage return
+ $line =~ s/\s*$//;
+
+# change the version number and copyright information
+# $line =~ s#\(c\) California Institute of Technology and University of Pau, October 2007#\(c\) California Institute of Technology and University of Pau, November 2007#og;
+# $line =~ s#rmass_sigma#rmass_time_integral_of_sigma#og;
+
+# write the modified line to the output file
+ print FILEF90 "$line\n";
+
+ }
+
+ close(FILEF77);
+ close(FILEF90);
+
+}
+
+system("rm -f _____tutu01_____");
+
Property changes on: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/UTILS/update_headers_change_word_f90.pl
___________________________________________________________________
Name: svn:executable
+ *
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/setup/constants.h.in
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/setup/constants.h.in 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/setup/constants.h.in 2012-04-02 06:04:51 UTC (rev 19915)
@@ -503,12 +503,12 @@
! number of faces a given slice can share with other slices
! this is at most 2, except when there is only once slice per chunk
! in which case it is 4
- integer, parameter :: NUMFACES_SHARED = 2 !!!!! DK DK removed support for one slice only, was 4
+ integer, parameter :: NUMFACES_SHARED = 4
! number of corners a given slice can share with other slices
! this is at most 1, except when there is only once slice per chunk
! in which case it is 4
- integer, parameter :: NUMCORNERS_SHARED = 1 !!!!!! DK DK removed support for one slice only, was 4
+ integer, parameter :: NUMCORNERS_SHARED = 4
! number of slaves per corner
integer, parameter :: NUMSLAVES = 2
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/auxiliaries/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/auxiliaries/Makefile.in 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/auxiliaries/Makefile.in 2012-04-02 06:04:51 UTC (rev 19915)
@@ -70,34 +70,38 @@
#######################################
libspecfem_a_OBJECTS_COMMON = \
- $O/auto_ner.o \
- $O/broadcast_compute_parameters.o \
- $O/calendar.o \
- $O/count_number_of_sources.o \
- $O/create_name_database.o \
- $O/force_ftz.o \
- $O/get_model_parameters.o \
- $O/get_value_parameters.o \
- $O/gll_library.o \
- $O/hex_nodes.o \
- $O/intgrl.o \
- $O/lagrange_poly.o \
- $O/make_ellipticity.o \
- $O/make_gravity.o \
- $O/param_reader.o \
- $O/read_compute_parameters.o \
- $O/read_parameter_file.o \
- $O/read_value_parameters.o \
- $O/reduce.o \
- $O/rthetaphi_xyz.o \
- $O/spline_routines.o \
+ $O/auto_ner.shared.o \
+ $O/broadcast_compute_parameters.sharedmpi.o \
+ $O/calendar.shared.o \
+ $O/count_points.shared.o \
+ $O/count_number_of_sources.shared.o \
+ $O/count_elements.shared.o \
+ $O/create_name_database.shared.o \
+ $O/define_all_layers.shared.o \
+ $O/force_ftz.cc.o \
+ $O/get_model_parameters.shared.o \
+ $O/get_timestep_and_layers.shared.o \
+ $O/get_value_parameters.shared.o \
+ $O/gll_library.shared.o \
+ $O/hex_nodes.shared.o \
+ $O/intgrl.shared.o \
+ $O/lagrange_poly.shared.o \
+ $O/make_ellipticity.shared.o \
+ $O/make_gravity.shared.o \
+ $O/param_reader.cc.o \
+ $O/read_compute_parameters.shared.o \
+ $O/read_parameter_file.shared.o \
+ $O/read_value_parameters.shared.o \
+ $O/reduce.shared.o \
+ $O/rthetaphi_xyz.shared.o \
+ $O/spline_routines.shared.o \
$(EMPTY_MACRO)
libspecfem_a_OBJECTS_AUX = \
- $O/calendar.o \
+ $O/calendar.shared.o \
$O/create_movie_AVS_DX.o \
- $O/create_serial_name_database.o \
- $O/get_cmt.o \
+ $O/create_serial_name_database.shared.o \
+ $O/get_cmt.specfem.o \
$(EMPTY_MACRO)
@@ -118,6 +122,7 @@
xcombine_AVS_DX \
xcombine_paraview_strain_data \
xcombine_vol_data \
+ xcombine_vol_data_vtk \
xcombine_surf_data \
xconvolve_source_timefunction \
xcreate_movie_AVS_DX \
@@ -158,15 +163,18 @@
xcombine_AVS_DX: $O/combine_AVS_DX.o $(LIBSPECFEM_AUX)
${FCCOMPILE_CHECK} -o ${E}/xcombine_AVS_DX $O/combine_AVS_DX.o $(LIBSPECFEM_AUX)
-xcombine_paraview_strain_data: $O/combine_paraview_strain_data.o $O/write_c_binary.o
- ${FCCOMPILE_CHECK} -o ${E}/xcombine_paraview_strain_data $O/combine_paraview_strain_data.o $O/write_c_binary.o
+xcombine_paraview_strain_data: $O/combine_paraview_strain_data.solver.o $O/write_c_binary.cc.o
+ ${FCCOMPILE_CHECK} -o ${E}/xcombine_paraview_strain_data $O/combine_paraview_strain_data.solver.o $O/write_c_binary.cc.o
-xcombine_vol_data: $O/combine_vol_data.o $O/write_c_binary.o
- ${FCCOMPILE_CHECK} -o ${E}/xcombine_vol_data $O/combine_vol_data.o $O/write_c_binary.o
+xcombine_vol_data: $O/combine_vol_data.solver.o $O/write_c_binary.cc.o
+ ${FCCOMPILE_CHECK} -o ${E}/xcombine_vol_data $O/combine_vol_data.solver.o $O/write_c_binary.cc.o
-xcombine_surf_data: $O/combine_surf_data.o $O/write_c_binary.o
- ${FCCOMPILE_CHECK} -o ${E}/xcombine_surf_data $O/combine_surf_data.o $O/write_c_binary.o
+xcombine_vol_data_vtk: $O/combine_vol_data_vtk.solver.o $O/write_c_binary.cc.o
+ ${FCCOMPILE_CHECK} -o ${E}/xcombine_vol_data_vtk $O/combine_vol_data_vtk.solver.o $O/write_c_binary.cc.o
+xcombine_surf_data: $O/combine_surf_data.solver.o $O/write_c_binary.cc.o
+ ${FCCOMPILE_CHECK} -o ${E}/xcombine_surf_data $O/combine_surf_data.solver.o $O/write_c_binary.cc.o
+
xcreate_movie_AVS_DX: $O/create_movie_AVS_DX.o $(LIBSPECFEM_AUX)
${FCCOMPILE_CHECK} -o ${E}/xcreate_movie_AVS_DX $O/create_movie_AVS_DX.o $(LIBSPECFEM_AUX)
@@ -183,7 +191,8 @@
rm -f $O/* *.o work.pc* *.mod ${E}/xcombine_AVS_DX \
${E}/xcheck_buffers_1D ${E}/xcheck_buffers_2D ${E}/xcheck_buffers_corners_chunks \
${E}/xcheck_buffers_faces_chunks ${E}/xconvolve_source_timefunction \
- ${E}/xcreate_movie_AVS_DX ${E}/xcreate_movie_GMT_global ${E}/xcombine_vol_data \
+ ${E}/xcreate_movie_AVS_DX ${E}/xcreate_movie_GMT_global \
+ ${E}/xcombine_vol_data ${E}/xcombine_vol_data_vtk \
${E}/xcombine_surf_data ${E}/xextract_database PI*
#######################################
@@ -207,122 +216,28 @@
##
## shared
##
-$O/auto_ner.o: ${SETUP}/constants.h ${SHARED}/auto_ner.f90
- ${FCCOMPILE_CHECK} -c -o $O/auto_ner.o ${FCFLAGS_f90} ${SHARED}/auto_ner.f90
+$O/%.shared.o: ${SHARED}/%.f90 ${SETUP}/constants.h
+ ${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-$O/broadcast_compute_parameters.o: ${SETUP}/constants.h ${SHARED}/broadcast_compute_parameters.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/broadcast_compute_parameters.o ${FCFLAGS_f90} ${SHARED}/broadcast_compute_parameters.f90
+$O/%.sharedmpi.o: ${SHARED}/%.f90 ${SETUP}/constants.h
+ ${MPIFCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-$O/calendar.o: ${SHARED}/calendar.f90
- ${FCCOMPILE_CHECK} -c -o $O/calendar.o ${FCFLAGS_f90} ${SHARED}/calendar.f90
+$O/%.cc.o: ${SHARED}/%.c ${SETUP}/config.h
+ ${CC} -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
-$O/count_number_of_sources.o: ${SETUP}/constants.h ${SHARED}/count_number_of_sources.f90
- ${FCCOMPILE_CHECK} -c -o $O/count_number_of_sources.o ${FCFLAGS_f90} ${SHARED}/count_number_of_sources.f90
-
-$O/create_name_database.o: ${SETUP}/constants.h ${SHARED}/create_name_database.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_name_database.o ${FCFLAGS_f90} ${SHARED}/create_name_database.f90
-
-$O/create_serial_name_database.o: ${SETUP}/constants.h ${SHARED}/create_serial_name_database.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_serial_name_database.o ${FCFLAGS_f90} ${SHARED}/create_serial_name_database.f90
-
-$O/get_model_parameters.o: ${SETUP}/constants.h ${SHARED}/get_model_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_model_parameters.o ${FCFLAGS_f90} ${SHARED}/get_model_parameters.f90
-
-$O/get_value_parameters.o: ${SETUP}/constants.h ${SHARED}/get_value_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_value_parameters.o ${FCFLAGS_f90} ${SHARED}/get_value_parameters.f90
-
-$O/gll_library.o: ${SETUP}/constants.h ${SHARED}/gll_library.f90
- ${FCCOMPILE_CHECK} -c -o $O/gll_library.o ${FCFLAGS_f90} ${SHARED}/gll_library.f90
-
-$O/hex_nodes.o: ${SETUP}/constants.h ${SHARED}/hex_nodes.f90
- ${FCCOMPILE_CHECK} -c -o $O/hex_nodes.o ${FCFLAGS_f90} ${SHARED}/hex_nodes.f90
-
-$O/intgrl.o: ${SETUP}/constants.h ${SHARED}/intgrl.f90
- ${FCCOMPILE_CHECK} -c -o $O/intgrl.o ${FCFLAGS_f90} ${SHARED}/intgrl.f90
-
-$O/lagrange_poly.o: ${SETUP}/constants.h ${SHARED}/lagrange_poly.f90
- ${FCCOMPILE_CHECK} -c -o $O/lagrange_poly.o ${FCFLAGS_f90} ${SHARED}/lagrange_poly.f90
-
-$O/make_ellipticity.o: ${SETUP}/constants.h ${SHARED}/make_ellipticity.f90
- ${FCCOMPILE_CHECK} -c -o $O/make_ellipticity.o ${FCFLAGS_f90} ${SHARED}/make_ellipticity.f90
-
-$O/make_gravity.o: ${SETUP}/constants.h ${SHARED}/make_gravity.f90
- ${FCCOMPILE_CHECK} -c -o $O/make_gravity.o ${FCFLAGS_f90} ${SHARED}/make_gravity.f90
-
-### C compilation
-$O/force_ftz.o: ${SHARED}/force_ftz.c ${SETUP}/config.h
- ${CC} -c $(CPPFLAGS) $(CFLAGS) -o $O/force_ftz.o ${SHARED}/force_ftz.c
-
-$O/param_reader.o: ${SHARED}/param_reader.c ${SETUP}/config.h
- ${CC} -c $(CPPFLAGS) $(CFLAGS) -o $O/param_reader.o ${SHARED}/param_reader.c
-
-$O/read_compute_parameters.o: ${SETUP}/constants.h ${SHARED}/read_compute_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/read_compute_parameters.o ${FCFLAGS_f90} ${SHARED}/read_compute_parameters.f90
-
-$O/read_parameter_file.o: ${SETUP}/constants.h ${SHARED}/read_parameter_file.f90
- ${FCCOMPILE_CHECK} -c -o $O/read_parameter_file.o ${FCFLAGS_f90} ${SHARED}/read_parameter_file.f90
-
-$O/read_value_parameters.o: ${SETUP}/constants.h ${SHARED}/read_value_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/read_value_parameters.o ${FCFLAGS_f90} ${SHARED}/read_value_parameters.f90
-
-$O/reduce.o: ${SETUP}/constants.h ${SHARED}/reduce.f90
- ${FCCOMPILE_CHECK} -c -o $O/reduce.o ${FCFLAGS_f90} ${SHARED}/reduce.f90
-
-$O/rthetaphi_xyz.o: ${SETUP}/constants.h ${SHARED}/rthetaphi_xyz.f90
- ${FCCOMPILE_CHECK} -c -o $O/rthetaphi_xyz.o ${FCFLAGS_f90} ${SHARED}/rthetaphi_xyz.f90
-
-$O/spline_routines.o: ${SETUP}/constants.h ${SHARED}/spline_routines.f90
- ${FCCOMPILE_CHECK} -c -o $O/spline_routines.o ${FCFLAGS_f90} ${SHARED}/spline_routines.f90
-
-### C compilation
-$O/write_c_binary.o: ${SHARED}/write_c_binary.c ${SETUP}/config.h
- $(CC) $(CPPFLAGS) $(CFLAGS) -c -o $O/write_c_binary.o ${SHARED}/write_c_binary.c
-
##
-## object from solver
-##
-$O/get_cmt.o: ${SETUP}/constants.h ../specfem3D/get_cmt.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_cmt.o ${FCFLAGS_f90} ../specfem3D/get_cmt.f90
-
-
-##
## auxiliaries
##
-$O/check_buffers_1D.o: ${SETUP}/constants.h $S/check_buffers_1D.f90
- ${FCCOMPILE_CHECK} -c -o $O/check_buffers_1D.o ${FCFLAGS_f90} $S/check_buffers_1D.f90
+$O/%.o: $S/%.f90 ${SETUP}/constants.h
+ ${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-$O/check_buffers_2D.o: ${SETUP}/constants.h $S/check_buffers_2D.f90
- ${FCCOMPILE_CHECK} -c -o $O/check_buffers_2D.o ${FCFLAGS_f90} $S/check_buffers_2D.f90
+$O/%.solver.o: $S/%.f90 ${SETUP}/constants.h ${OUTPUT}/values_from_mesher.h
+ ${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-$O/check_buffers_corners_chunks.o: ${SETUP}/constants.h $S/check_buffers_corners_chunks.f90
- ${FCCOMPILE_CHECK} -c -o $O/check_buffers_corners_chunks.o ${FCFLAGS_f90} $S/check_buffers_corners_chunks.f90
+$O/%.specfem.o: ../specfem3D/%.f90 ${SETUP}/constants.h
+ ${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-$O/check_buffers_faces_chunks.o: ${SETUP}/constants.h $S/check_buffers_faces_chunks.f90
- ${FCCOMPILE_CHECK} -c -o $O/check_buffers_faces_chunks.o ${FCFLAGS_f90} $S/check_buffers_faces_chunks.f90
-$O/combine_AVS_DX.o: ${SETUP}/constants.h $S/combine_AVS_DX.f90
- ${FCCOMPILE_CHECK} -c -o $O/combine_AVS_DX.o ${FCFLAGS_f90} $S/combine_AVS_DX.f90
-
-$O/combine_paraview_strain_data.o: ${SETUP}/constants.h ${OUTPUT}/values_from_mesher.h $S/combine_paraview_strain_data.f90
- ${FCCOMPILE_CHECK} -c -o $O/combine_paraview_strain_data.o ${FCFLAGS_f90} $S/combine_paraview_strain_data.f90
-
-$O/combine_surf_data.o: ${SETUP}/constants.h ${OUTPUT}/values_from_mesher.h $S/combine_surf_data.f90
- ${FCCOMPILE_CHECK} -c -o $O/combine_surf_data.o ${FCFLAGS_f90} $S/combine_surf_data.f90
-
-$O/combine_vol_data.o: ${SETUP}/constants.h ${OUTPUT}/values_from_mesher.h $S/combine_vol_data.f90
- ${FCCOMPILE_CHECK} -c -o $O/combine_vol_data.o ${FCFLAGS_f90} $S/combine_vol_data.f90
-
-$O/convolve_source_timefunction.o: $S/convolve_source_timefunction.f90
- ${FCCOMPILE_CHECK} -c -o $O/convolve_source_timefunction.o ${FCFLAGS_f90} $S/convolve_source_timefunction.f90
-
-$O/create_movie_AVS_DX.o: ${SETUP}/constants.h $S/create_movie_AVS_DX.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_movie_AVS_DX.o ${FCFLAGS_f90} $S/create_movie_AVS_DX.f90
-
-$O/create_movie_GMT_global.o: ${SETUP}/constants.h $S/create_movie_GMT_global.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_movie_GMT_global.o ${FCFLAGS_f90} $S/create_movie_GMT_global.f90
-
-
-
###
### rule for the header file
###
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/auxiliaries/combine_vol_data_vtk.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/auxiliaries/combine_vol_data_vtk.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/auxiliaries/combine_vol_data_vtk.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,1162 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+program combine_vol_data_vtk
+
+ ! outputs vtk-files (ascii format)
+
+ ! 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,parameter :: MAX_NUM_NODES = 2000
+ integer iregion, ir, irs, ire, ires
+ character(len=256) :: sline, arg(7), filename, in_topo_dir, in_file_dir, outdir
+ character(len=256) :: prname_topo, prname_file, dimension_file
+ character(len=256) :: mesh_file
+ character(len=256) :: data_file, topo_file
+ integer, dimension(MAX_NUM_NODES) :: node_list, nspec, nglob, npoint, nelement
+ integer iproc, num_node, i,j,k,ispec, ios, it, di, dj, dk
+ integer np, ne, njunk
+
+ real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE) :: data
+ real(kind=CUSTOM_REAL),dimension(NGLOB_CRUST_MANTLE) :: xstore, ystore, zstore
+ integer ibool(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE)
+
+ integer num_ibool(NGLOB_CRUST_MANTLE)
+ logical mask_ibool(NGLOB_CRUST_MANTLE), HIGH_RESOLUTION_MESH
+
+ real x, y, z, dat
+ integer numpoin, iglob, n1, n2, n3, n4, n5, n6, n7, n8
+ integer iglob1, iglob2, iglob3, iglob4, iglob5, iglob6, iglob7, iglob8
+ integer ier
+ ! instead of taking the first value which appears for a global point, average the values
+ ! if there are more than one gll points for a global point (points on element corners, edges, faces)
+ logical,parameter:: AVERAGE_GLOBALPOINTS = .false.
+ integer:: ibool_count(NGLOB_CRUST_MANTLE)
+ real(kind=CUSTOM_REAL):: ibool_dat(NGLOB_CRUST_MANTLE)
+
+ ! note:
+ ! if one wants to remove the topography and ellipticity distortion, you would run the mesher again
+ ! but turning the flags: TOPOGRAPHY and ELLIPTICITY to .false.
+ ! then, use those as topo files: proc***_array_dims.txt and proc***_solver_data_2.bin
+ ! of course, this would also work by just turning ELLIPTICITY to .false. so that the CORRECT_ELLIPTICITY below
+ ! becomes unneccessary
+ !
+ ! puts point locations back into a perfectly spherical shape by removing the ellipticity factor;
+ ! useful for plotting spherical cuts at certain depths
+ logical,parameter:: CORRECT_ELLIPTICITY = .false.
+ integer :: nspl
+ double precision :: rspl(NR),espl(NR),espl2(NR)
+ logical,parameter :: ONE_CRUST = .false. ! if you want to correct a model with one layer only in PREM crust
+
+ integer, dimension(NSPEC_INNER_CORE) :: idoubling_inner_core ! to get rid of fictitious elements in central cube
+
+ ! global point data
+ real,dimension(:),allocatable :: total_dat
+ real,dimension(:,:),allocatable :: total_dat_xyz
+ integer,dimension(:,:),allocatable :: total_dat_con
+
+ ! starts here--------------------------------------------------------------------------------------------------
+ do i = 1, 7
+ call getarg(i,arg(i))
+ if (i < 7 .and. trim(arg(i)) == '') then
+ print *, ' '
+ print *, ' Usage: xcombine_vol_data slice_list filename input_topo_dir input_file_dir '
+ print *, ' output_dir high/low-resolution [region]'
+ print *, ' ***** Notice: now allow different input dir for topo and kernel files ******** '
+ print *, ' expect to have the topology and filename.bin(NGLLX,NGLLY,NGLLZ,nspec) '
+ print *, ' already collected to input_topo_dir and input_file_dir'
+ print *, ' output mesh files (filename_points.mesh, filename_elements.mesh) go to output_dir '
+ print *, ' give 0 for low resolution and 1 for high resolution'
+ print *, ' if region is not specified, all 3 regions will be collected, otherwise, only collect regions specified'
+ stop ' Reenter command line options'
+ endif
+ enddo
+
+ if (NSPEC_CRUST_MANTLE < NSPEC_OUTER_CORE .or. NSPEC_CRUST_MANTLE < NSPEC_INNER_CORE) &
+ stop 'This program needs that NSPEC_CRUST_MANTLE > NSPEC_OUTER_CORE and NSPEC_INNER_CORE'
+
+ ! get region id
+ if (trim(arg(7)) == '') then
+ iregion = 0
+ else
+ read(arg(7),*) iregion
+ endif
+ if (iregion > 3 .or. iregion < 0) stop 'Iregion = 0,1,2,3'
+ if (iregion == 0) then
+ irs = 1
+ ire = 3
+ else
+ irs = iregion
+ ire = irs
+ endif
+
+ ! get slices id
+ num_node = 0
+ open(unit = 20, file = trim(arg(1)), status = 'old',iostat = ios)
+ if (ios /= 0) then
+ print*,'no file: ',trim(arg(1))
+ stop 'Error opening slices file'
+ 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)
+ print *, 'slice list: '
+ print *, node_list(1:num_node)
+ print *, ' '
+
+ ! file to collect
+ filename = arg(2)
+
+ ! input and output dir
+ in_topo_dir= arg(3)
+ in_file_dir= arg(4)
+ outdir = arg(5)
+
+ ! resolution
+ read(arg(6),*) ires
+ if (ires == 0) then
+ HIGH_RESOLUTION_MESH = .false.
+ di = NGLLX-1; dj = NGLLY-1; dk = NGLLZ-1
+ else if( ires == 1 ) then
+ HIGH_RESOLUTION_MESH = .true.
+ di = 1; dj = 1; dk = 1
+ else if( ires == 2 ) then
+ HIGH_RESOLUTION_MESH = .false.
+ di = (NGLLX-1)/2.0; dj = (NGLLY-1)/2.0; dk = (NGLLZ-1)/2.0
+ endif
+ if( HIGH_RESOLUTION_MESH ) then
+ print *, ' high resolution ', HIGH_RESOLUTION_MESH
+ else
+ print *, ' low resolution ', HIGH_RESOLUTION_MESH
+ endif
+
+ ! sets up ellipticity splines in order to remove ellipticity from point coordinates
+ if( CORRECT_ELLIPTICITY ) call make_ellipticity(nspl,rspl,espl,espl2,ONE_CRUST)
+
+
+ do ir = irs, ire
+ print *, '----------- Region ', ir, '----------------'
+
+ ! figure out total number of points and elements for high-res mesh
+
+ do it = 1, num_node
+
+ iproc = node_list(it)
+
+ print *, 'Reading slice ', iproc
+ write(prname_topo,'(a,i6.6,a,i1,a)') trim(in_topo_dir)//'/proc',iproc,'_reg',ir,'_'
+ write(prname_file,'(a,i6.6,a,i1,a)') trim(in_file_dir)//'/proc',iproc,'_reg',ir,'_'
+
+
+ dimension_file = trim(prname_topo) //'array_dims.txt'
+ open(unit = 27,file = trim(dimension_file),status='old',action='read', iostat = ios)
+ if (ios /= 0) then
+ print*,'error ',ios
+ print*,'file:',trim(dimension_file)
+ stop 'Error opening file'
+ endif
+
+ read(27,*) nspec(it)
+ read(27,*) nglob(it)
+ close(27)
+
+ ! check
+ if( nspec(it) > NSPEC_CRUST_MANTLE ) stop 'error file nspec too big, please check compilation'
+ if( nglob(it) > NGLOB_CRUST_MANTLE ) stop 'error file nglob too big, please check compilation'
+
+ if (HIGH_RESOLUTION_MESH) then
+ npoint(it) = nglob(it)
+ nelement(it) = nspec(it) * (NGLLX-1) * (NGLLY-1) * (NGLLZ-1)
+ else if( ires == 0 ) then
+ npoint(it) = nglob(it)
+ nelement(it) = nspec(it)
+ else if (ires == 2 ) then
+ npoint(it) = nglob(it)
+ nelement(it) = nspec(it) * (NGLLX-1) * (NGLLY-1) * (NGLLZ-1) / 8
+ endif
+
+ enddo
+
+ print *, 'nspec(it) = ', nspec(1:num_node)
+ print *, 'nglob(it) = ', nglob(1:num_node)
+
+ !call write_integer_fd(efd,sum(nelement(1:num_node)))
+
+ ! VTK
+ print *
+ print *,'vtk inital total points: ',sum(npoint(1:num_node))
+ print *,'vkt inital total elements: ',sum(nelement(1:num_node))
+ print *
+
+ ! creates array to hold point data
+ allocate(total_dat(sum(npoint(1:num_node))),stat=ier)
+ if( ier /= 0 ) stop 'error allocating total_dat array'
+ total_dat(:) = 0.0
+ allocate(total_dat_xyz(3,sum(npoint(1:num_node))),stat=ier)
+ if( ier /= 0 ) stop 'error allocating total_dat_xyz array'
+ total_dat_xyz(:,:) = 0.0
+ allocate(total_dat_con(8,sum(nelement(1:num_node))),stat=ier)
+ if( ier /= 0 ) stop 'error allocating total_dat_con array'
+ total_dat_con(:,:) = 0
+
+ ! VTK
+ ! opens unstructured grid file
+ write(mesh_file,'(a,i1,a)') trim(outdir)//'/' // 'reg_',ir,'_'//trim(filename)//'.vtk'
+ open(IOVTK,file=mesh_file(1:len_trim(mesh_file)),status='unknown',iostat=ios)
+ if( ios /= 0 ) stop 'error opening vtk output file'
+ write(IOVTK,'(a)') '# vtk DataFile Version 3.1'
+ write(IOVTK,'(a)') 'material model VTK file'
+ write(IOVTK,'(a)') 'ASCII'
+ write(IOVTK,'(a)') 'DATASET UNSTRUCTURED_GRID'
+
+
+ np = 0
+ ne = 0
+
+ ! write points information
+ do it = 1, num_node
+
+ iproc = node_list(it)
+
+ data(:,:,:,:) = -1.e10
+
+ print *, ' '
+ print *, 'Reading slice ', iproc
+ write(prname_topo,'(a,i6.6,a,i1,a)') trim(in_topo_dir)//'/proc',iproc,'_reg',ir,'_'
+ write(prname_file,'(a,i6.6,a,i1,a)') trim(in_file_dir)//'/proc',iproc,'_reg',ir,'_'
+
+
+
+ ! filename.bin
+ data_file = trim(prname_file) // trim(filename) // '.bin'
+ open(unit = 27,file = trim(data_file),status='old',action='read', iostat = ios,form ='unformatted')
+ if (ios /= 0) then
+ print*,'error ',ios
+ print*,'file:',trim(data_file)
+ stop 'Error opening file'
+ endif
+ read(27,iostat=ios) data(:,:,:,1:nspec(it))
+ if( ios /= 0 ) then
+ print*,'read error ',ios
+ print*,'file:',trim(data_file)
+ stop 'error reading data'
+ endif
+ close(27)
+
+ print *,trim(data_file)
+ print *,' min/max value: ',minval(data(:,:,:,1:nspec(it))),maxval(data(:,:,:,1:nspec(it)))
+ print *
+
+ ! topology file
+ topo_file = trim(prname_topo) // 'solver_data_2' // '.bin'
+ open(unit = 28,file = trim(topo_file),status='old',action='read', iostat = ios, form='unformatted')
+ if (ios /= 0) then
+ print*,'error ',ios
+ print*,'file:',trim(topo_file)
+ stop 'Error opening file'
+ endif
+ xstore(:) = 0.0
+ ystore(:) = 0.0
+ zstore(:) = 0.0
+ ibool(:,:,:,:) = -1
+ read(28) xstore(1:nglob(it))
+ read(28) ystore(1:nglob(it))
+ read(28) zstore(1:nglob(it))
+ read(28) ibool(:,:,:,1:nspec(it))
+ if (ir==3) read(28) idoubling_inner_core(1:nspec(it)) ! flag that can indicate fictitious elements
+ close(28)
+
+ print *, trim(topo_file)
+
+
+ !average data on global points
+ ibool_count(:) = 0
+ ibool_dat(:) = 0.0
+ if( AVERAGE_GLOBALPOINTS ) then
+ do ispec=1,nspec(it)
+ ! checks if element counts
+ if (ir==3 ) then
+ ! inner core
+ ! nothing to do for fictitious elements in central cube
+ if( idoubling_inner_core(ispec) == IFLAG_IN_FICTITIOUS_CUBE) cycle
+ endif
+ ! counts and sums global point data
+ do k = 1, NGLLZ, dk
+ do j = 1, NGLLY, dj
+ do i = 1, NGLLX, di
+ iglob = ibool(i,j,k,ispec)
+
+ dat = data(i,j,k,ispec)
+
+ ibool_dat(iglob) = ibool_dat(iglob) + dat
+ ibool_count(iglob) = ibool_count(iglob) + 1
+ enddo
+ enddo
+ enddo
+ enddo
+ do iglob=1,nglob(it)
+ if( ibool_count(iglob) > 0 ) then
+ ibool_dat(iglob) = ibool_dat(iglob)/ibool_count(iglob)
+ endif
+ enddo
+ endif
+
+ mask_ibool(:) = .false.
+ num_ibool(:) = 0
+ numpoin = 0
+
+
+ ! write point file
+ do ispec=1,nspec(it)
+ ! checks if element counts
+ if (ir==3 ) then
+ ! inner core
+ ! nothing to do for fictitious elements in central cube
+ if( idoubling_inner_core(ispec) == IFLAG_IN_FICTITIOUS_CUBE) cycle
+ endif
+
+ ! writes out global point data
+ do k = 1, NGLLZ, dk
+ do j = 1, NGLLY, dj
+ do i = 1, NGLLX, di
+ iglob = ibool(i,j,k,ispec)
+ if( iglob == -1 ) cycle
+
+ ! takes the averaged data value for mesh
+ if( AVERAGE_GLOBALPOINTS ) then
+ if(.not. mask_ibool(iglob)) then
+ numpoin = numpoin + 1
+ x = xstore(iglob)
+ y = ystore(iglob)
+ z = zstore(iglob)
+
+ ! remove ellipticity
+ if( CORRECT_ELLIPTICITY ) call reverse_ellipticity(x,y,z,nspl,rspl,espl,espl2)
+
+ !dat = data(i,j,k,ispec)
+ dat = ibool_dat(iglob)
+
+ !call write_real_fd(pfd,x)
+ !call write_real_fd(pfd,y)
+ !call write_real_fd(pfd,z)
+ !call write_real_fd(pfd,dat)
+
+ ! VTK
+ total_dat(np+numpoin) = dat
+ total_dat_xyz(1,np+numpoin) = x
+ total_dat_xyz(2,np+numpoin) = y
+ total_dat_xyz(3,np+numpoin) = z
+
+ mask_ibool(iglob) = .true.
+ num_ibool(iglob) = numpoin
+ endif
+ else
+ if(.not. mask_ibool(iglob)) then
+ numpoin = numpoin + 1
+ x = xstore(iglob)
+ y = ystore(iglob)
+ z = zstore(iglob)
+
+ ! remove ellipticity
+ if( CORRECT_ELLIPTICITY ) call reverse_ellipticity(x,y,z,nspl,rspl,espl,espl2)
+
+ dat = data(i,j,k,ispec)
+
+ !call write_real_fd(pfd,x)
+ !call write_real_fd(pfd,y)
+ !call write_real_fd(pfd,z)
+ !call write_real_fd(pfd,dat)
+
+ ! VTK
+ total_dat(np+numpoin) = dat
+ total_dat_xyz(1,np+numpoin) = x
+ total_dat_xyz(2,np+numpoin) = y
+ total_dat_xyz(3,np+numpoin) = z
+
+ mask_ibool(iglob) = .true.
+ num_ibool(iglob) = numpoin
+ endif
+ endif
+ enddo ! i
+ enddo ! j
+ enddo ! k
+ enddo !ispec
+
+
+ ! no way to check the number of points for low-res
+ if (HIGH_RESOLUTION_MESH ) then
+ if( ir==3 ) then
+ npoint(it) = numpoin
+ elseif( numpoin /= npoint(it)) then
+ print*,'region:',ir
+ print*,'error number of points:',numpoin,npoint(it)
+ stop 'different number of points (high-res)'
+ endif
+ else if (.not. HIGH_RESOLUTION_MESH) then
+ npoint(it) = numpoin
+ endif
+
+ ! write elements file
+ numpoin = 0
+ do ispec = 1, nspec(it)
+ ! checks if element counts
+ if (ir==3 ) then
+ ! inner core
+ ! fictitious elements in central cube
+ if( idoubling_inner_core(ispec) == IFLAG_IN_FICTITIOUS_CUBE) then
+ ! connectivity must be given, otherwise element count would be wrong
+ ! maps "fictitious" connectivity, element is all with iglob = 1
+ !do k = 1, NGLLZ-1, dk
+ ! do j = 1, NGLLY-1, dj
+ ! do i = 1, NGLLX-1, di
+ !call write_integer_fd(efd,1)
+ !call write_integer_fd(efd,1)
+ !call write_integer_fd(efd,1)
+ !call write_integer_fd(efd,1)
+ !call write_integer_fd(efd,1)
+ !call write_integer_fd(efd,1)
+ !call write_integer_fd(efd,1)
+ !call write_integer_fd(efd,1)
+ ! enddo ! i
+ ! enddo ! j
+ !enddo ! k
+ ! takes next element
+ cycle
+ endif
+ endif
+
+ ! writes out element connectivity
+ do k = 1, NGLLZ-1, dk
+ do j = 1, NGLLY-1, dj
+ do i = 1, NGLLX-1, di
+
+ numpoin = numpoin + 1 ! counts elements
+
+ iglob1 = ibool(i,j,k,ispec)
+ iglob2 = ibool(i+di,j,k,ispec)
+ iglob3 = ibool(i+di,j+dj,k,ispec)
+ iglob4 = ibool(i,j+dj,k,ispec)
+ iglob5 = ibool(i,j,k+dk,ispec)
+ iglob6 = ibool(i+di,j,k+dk,ispec)
+ iglob7 = ibool(i+di,j+dj,k+dk,ispec)
+ iglob8 = ibool(i,j+dj,k+dk,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_fd(efd,n1)
+ !call write_integer_fd(efd,n2)
+ !call write_integer_fd(efd,n3)
+ !call write_integer_fd(efd,n4)
+ !call write_integer_fd(efd,n5)
+ !call write_integer_fd(efd,n6)
+ !call write_integer_fd(efd,n7)
+ !call write_integer_fd(efd,n8)
+
+ ! VTK
+ ! note: indices for vtk start at 0
+ total_dat_con(1,numpoin + ne) = n1
+ total_dat_con(2,numpoin + ne) = n2
+ total_dat_con(3,numpoin + ne) = n3
+ total_dat_con(4,numpoin + ne) = n4
+ total_dat_con(5,numpoin + ne) = n5
+ total_dat_con(6,numpoin + ne) = n6
+ total_dat_con(7,numpoin + ne) = n7
+ total_dat_con(8,numpoin + ne) = n8
+
+ enddo ! i
+ enddo ! j
+ enddo ! k
+ enddo ! ispec
+
+ np = np + npoint(it)
+ ne = ne + nelement(it)
+
+ enddo ! all slices for points
+
+ if (np /= sum(npoint(1:num_node))) stop 'Error: Number of total points are not consistent'
+ if (ne /= sum(nelement(1:num_node))) stop 'Error: Number of total elements are not consistent'
+
+ print *
+ print *, 'Total number of points: ', np
+ print *, 'Total number of elements: ', ne
+ print *
+
+ ! VTK
+ ! points
+ write(IOVTK, '(a,i16,a)') 'POINTS ', np, ' float'
+ do i = 1,np
+ write(IOVTK,'(3e18.6)') total_dat_xyz(1,i),total_dat_xyz(2,i),total_dat_xyz(3,i)
+ enddo
+ write(IOVTK,*) ""
+
+ ! cells
+ ! note: indices for vtk start at 0
+ write(IOVTK,'(a,i12,i12)') "CELLS ",ne,ne*9
+ do i = 1,ne
+ write(IOVTK,'(9i12)') 8,total_dat_con(1,i),total_dat_con(2,i),total_dat_con(3,i),total_dat_con(4,i), &
+ total_dat_con(5,i),total_dat_con(6,i),total_dat_con(7,i),total_dat_con(8,i)
+ enddo
+ write(IOVTK,*) ""
+
+ !call close_file_fd(pfd)
+ !call close_file_fd(efd)
+
+ ! add the critical piece: total number of points
+ !call open_file_fd(trim(pt_mesh_file2)//char(0),pfd)
+ !call write_integer_fd(pfd,np)
+ !call close_file_fd(pfd)
+
+ !command_name='cat '//trim(pt_mesh_file2)//' '//trim(pt_mesh_file1)//' '//trim(em_mesh_file)//' > '//trim(mesh_file)
+ !print *, ' '
+ !print *, 'cat mesh files: '
+ !print *, trim(command_name)
+ !call system(trim(command_name))
+
+ ! VTK
+ ! type: hexahedrons
+ write(IOVTK,'(a,i12)') "CELL_TYPES ",ne
+ write(IOVTK,*) (12,it=1,ne)
+ write(IOVTK,*) ""
+
+ write(IOVTK,'(a,i12)') "POINT_DATA ",np
+ write(IOVTK,'(a)') "SCALARS "//trim(filename)//" float"
+ write(IOVTK,'(a)') "LOOKUP_TABLE default"
+ do i = 1,np
+ write(IOVTK,*) total_dat(i)
+ enddo
+ write(IOVTK,*) ""
+ close(IOVTK)
+
+ ! free arrays for this region
+ deallocate(total_dat,total_dat_xyz,total_dat_con)
+
+
+ print *,'written: ',trim(mesh_file)
+ print *
+ enddo
+
+ print *, 'Done writing mesh files'
+ print *, ' '
+
+
+end program combine_vol_data_vtk
+
+!
+! ------------------------------------------------------------------------------------------------
+!
+
+
+ subroutine reverse_ellipticity(x,y,z,nspl,rspl,espl,espl2)
+
+ implicit none
+
+ include "constants.h"
+
+ real(kind=CUSTOM_REAL) :: x,y,z
+ integer nspl
+ double precision rspl(NR),espl(NR),espl2(NR)
+ double precision x1,y1,z1
+
+ double precision ell
+ double precision r,theta,phi,factor
+ double precision cost,p20
+
+ ! gets spherical coordinates
+ x1 = x
+ y1 = y
+ z1 = z
+ call xyz_2_rthetaphi_dble(x1,y1,z1,r,theta,phi)
+
+ cost=dcos(theta)
+ p20=0.5d0*(3.0d0*cost*cost-1.0d0)
+
+ ! get ellipticity using spline evaluation
+ call spline_evaluation(rspl,espl,espl2,nspl,r,ell)
+
+ factor=ONE-(TWO/3.0d0)*ell*p20
+
+ ! removes ellipticity factor
+ x = x / factor
+ y = y / factor
+ z = z / factor
+
+ end subroutine reverse_ellipticity
+
+!
+! ------------------------------------------------------------------------------------------------
+!
+
+! copy from make_ellipticity.f90 to avoid compiling issues
+
+ subroutine make_ellipticity(nspl,rspl,espl,espl2,ONE_CRUST)
+
+! creates a spline for the ellipticity profile in PREM
+! radius and density are non-dimensional
+
+ implicit none
+
+ include "constants.h"
+
+ integer nspl
+
+ logical ONE_CRUST
+
+! radius of the Earth for gravity calculation
+ double precision, parameter :: R_EARTH_ELLIPTICITY = 6371000.d0
+! radius of the ocean floor for gravity calculation
+ double precision, parameter :: ROCEAN_ELLIPTICITY = 6368000.d0
+
+ double precision rspl(NR),espl(NR),espl2(NR)
+
+ integer i
+ double precision ROCEAN,RMIDDLE_CRUST,RMOHO,R80,R220,R400,R600,R670, &
+ R771,RTOPDDOUBLEPRIME,RCMB,RICB
+ double precision r_icb,r_cmb,r_topddoubleprime,r_771,r_670,r_600
+ double precision r_400,r_220,r_80,r_moho,r_middle_crust,r_ocean,r_0
+ double precision r(NR),rho(NR),epsilonval(NR),eta(NR)
+ double precision radau(NR),z,k(NR),g_a,bom,exponentval,i_rho,i_radau
+ double precision s1(NR),s2(NR),s3(NR)
+ double precision yp1,ypn
+
+! PREM
+ ROCEAN = 6368000.d0
+ RMIDDLE_CRUST = 6356000.d0
+ RMOHO = 6346600.d0
+ R80 = 6291000.d0
+ R220 = 6151000.d0
+ R400 = 5971000.d0
+ R600 = 5771000.d0
+ R670 = 5701000.d0
+ R771 = 5600000.d0
+ RTOPDDOUBLEPRIME = 3630000.d0
+ RCMB = 3480000.d0
+ RICB = 1221000.d0
+
+! non-dimensionalize
+ r_icb = RICB/R_EARTH_ELLIPTICITY
+ r_cmb = RCMB/R_EARTH_ELLIPTICITY
+ r_topddoubleprime = RTOPDDOUBLEPRIME/R_EARTH_ELLIPTICITY
+ r_771 = R771/R_EARTH_ELLIPTICITY
+ r_670 = R670/R_EARTH_ELLIPTICITY
+ r_600 = R600/R_EARTH_ELLIPTICITY
+ r_400 = R400/R_EARTH_ELLIPTICITY
+ r_220 = R220/R_EARTH_ELLIPTICITY
+ r_80 = R80/R_EARTH_ELLIPTICITY
+ r_moho = RMOHO/R_EARTH_ELLIPTICITY
+ r_middle_crust = RMIDDLE_CRUST/R_EARTH_ELLIPTICITY
+ r_ocean = ROCEAN_ELLIPTICITY/R_EARTH_ELLIPTICITY
+ r_0 = 1.d0
+
+ do i=1,163
+ r(i) = r_icb*dble(i-1)/dble(162)
+ enddo
+ do i=164,323
+ r(i) = r_icb+(r_cmb-r_icb)*dble(i-164)/dble(159)
+ enddo
+ do i=324,336
+ r(i) = r_cmb+(r_topddoubleprime-r_cmb)*dble(i-324)/dble(12)
+ enddo
+ do i=337,517
+ r(i) = r_topddoubleprime+(r_771-r_topddoubleprime)*dble(i-337)/dble(180)
+ enddo
+ do i=518,530
+ r(i) = r_771+(r_670-r_771)*dble(i-518)/dble(12)
+ enddo
+ do i=531,540
+ r(i) = r_670+(r_600-r_670)*dble(i-531)/dble(9)
+ enddo
+ do i=541,565
+ r(i) = r_600+(r_400-r_600)*dble(i-541)/dble(24)
+ enddo
+ do i=566,590
+ r(i) = r_400+(r_220-r_400)*dble(i-566)/dble(24)
+ enddo
+ do i=591,609
+ r(i) = r_220+(r_80-r_220)*dble(i-591)/dble(18)
+ enddo
+ do i=610,619
+ r(i) = r_80+(r_moho-r_80)*dble(i-610)/dble(9)
+ enddo
+ do i=620,626
+ r(i) = r_moho+(r_middle_crust-r_moho)*dble(i-620)/dble(6)
+ enddo
+ do i=627,633
+ r(i) = r_middle_crust+(r_ocean-r_middle_crust)*dble(i-627)/dble(6)
+ enddo
+ do i=634,NR
+ r(i) = r_ocean+(r_0-r_ocean)*dble(i-634)/dble(6)
+ enddo
+
+
+! use PREM to get the density profile for ellipticity (fine for other 1D reference models)
+ do i=1,NR
+ call prem_density(r(i),rho(i),ONE_CRUST,RICB,RCMB,RTOPDDOUBLEPRIME, &
+ R600,R670,R220,R771,R400,R80,RMOHO,RMIDDLE_CRUST,ROCEAN)
+ radau(i)=rho(i)*r(i)*r(i)
+ enddo
+
+ eta(1)=0.0d0
+
+ k(1)=0.0d0
+
+ do i=2,NR
+ call intgrl(i_rho,r,1,i,rho,s1,s2,s3)
+ call intgrl(i_radau,r,1,i,radau,s1,s2,s3)
+ z=(2.0d0/3.0d0)*i_radau/(i_rho*r(i)*r(i))
+ eta(i)=(25.0d0/4.0d0)*((1.0d0-(3.0d0/2.0d0)*z)**2.0d0)-1.0d0
+ k(i)=eta(i)/(r(i)**3.0d0)
+ enddo
+
+ g_a=4.0D0*i_rho
+ bom=TWO_PI/(24.0d0*3600.0d0)
+ bom=bom/sqrt(PI*GRAV*RHOAV)
+ epsilonval(NR)=15.0d0*(bom**2.0d0)/(24.0d0*i_rho*(eta(NR)+2.0d0))
+
+ do i=1,NR-1
+ call intgrl(exponentval,r,i,NR,k,s1,s2,s3)
+ epsilonval(i)=epsilonval(NR)*exp(-exponentval)
+ enddo
+
+! get ready to spline epsilonval
+ nspl=1
+ rspl(1)=r(1)
+ espl(1)=epsilonval(1)
+ do i=2,NR
+ if(r(i) /= r(i-1)) then
+ nspl=nspl+1
+ rspl(nspl)=r(i)
+ espl(nspl)=epsilonval(i)
+ endif
+ enddo
+
+! spline epsilonval
+ yp1=0.0d0
+ ypn=(5.0d0/2.0d0)*(bom**2)/g_a-2.0d0*epsilonval(NR)
+ call spline_construction(rspl,espl,nspl,yp1,ypn,espl2)
+
+ end subroutine make_ellipticity
+
+!
+! ------------------------------------------------------------------------------------------------
+!
+
+! copy from model_prem.f90 to avoid compiling issues
+
+ subroutine prem_density(x,rho,ONE_CRUST,RICB,RCMB,RTOPDDOUBLEPRIME, &
+ R600,R670,R220,R771,R400,R80,RMOHO,RMIDDLE_CRUST,ROCEAN)
+
+ implicit none
+
+ include "constants.h"
+
+ double precision x,rho,RICB,RCMB,RTOPDDOUBLEPRIME, &
+ R600,R670,R220,R771,R400,R80,RMOHO,RMIDDLE_CRUST,ROCEAN
+
+ logical ONE_CRUST
+
+ double precision r
+
+ ! compute real physical radius in meters
+ r = x * R_EARTH
+
+ ! calculates density according to radius
+ if(r <= RICB) then
+ rho=13.0885d0-8.8381d0*x*x
+ else if(r > RICB .and. r <= RCMB) then
+ rho=12.5815d0-1.2638d0*x-3.6426d0*x*x-5.5281d0*x*x*x
+ else if(r > RCMB .and. r <= RTOPDDOUBLEPRIME) then
+ rho=7.9565d0-6.4761d0*x+5.5283d0*x*x-3.0807d0*x*x*x
+ else if(r > RTOPDDOUBLEPRIME .and. r <= R771) then
+ rho=7.9565d0-6.4761d0*x+5.5283d0*x*x-3.0807d0*x*x*x
+ else if(r > R771 .and. r <= R670) then
+ rho=7.9565d0-6.4761d0*x+5.5283d0*x*x-3.0807d0*x*x*x
+ else if(r > R670 .and. r <= R600) then
+ rho=5.3197d0-1.4836d0*x
+ else if(r > R600 .and. r <= R400) then
+ rho=11.2494d0-8.0298d0*x
+ else if(r > R400 .and. r <= R220) then
+ rho=7.1089d0-3.8045d0*x
+ else if(r > R220 .and. r <= R80) then
+ rho=2.6910d0+0.6924d0*x
+ else
+ if(r > R80 .and. r <= RMOHO) then
+ rho=2.6910d0+0.6924d0*x
+ else if(r > RMOHO .and. r <= RMIDDLE_CRUST) then
+ if(ONE_CRUST) then
+ rho=2.6d0
+ else
+ rho=2.9d0
+ endif
+ else if(r > RMIDDLE_CRUST .and. r <= ROCEAN) then
+ rho=2.6d0
+ else if(r > ROCEAN) then
+ rho=2.6d0
+ endif
+ endif
+
+ rho=rho*1000.0d0/RHOAV
+
+ end subroutine prem_density
+
+!
+! ------------------------------------------------------------------------------------------------
+!
+
+! copy from intgrl.f90 to avoid compiling issues
+
+
+ subroutine intgrl(sum,r,nir,ner,f,s1,s2,s3)
+
+! Computes the integral of f[i]*r[i]*r[i] from i=nir to i=ner for
+! radii values as in model PREM_an640
+
+ implicit none
+
+! Argument variables
+ integer ner,nir
+ double precision f(640),r(640),s1(640),s2(640)
+ double precision s3(640),sum
+
+! Local variables
+ double precision, parameter :: third = 1.0d0/3.0d0
+ double precision, parameter :: fifth = 1.0d0/5.0d0
+ double precision, parameter :: sixth = 1.0d0/6.0d0
+
+ double precision rji,yprime(640)
+ double precision s1l,s2l,s3l
+
+ integer i,j,n,kdis(28)
+ integer ndis,nir1
+
+
+
+ data kdis/163,323,336,517,530,540,565,590,609,619,626,633,16*0/
+
+ ndis = 12
+ n = 640
+
+ call deriv(f,yprime,n,r,ndis,kdis,s1,s2,s3)
+ nir1 = nir + 1
+ sum = 0.0d0
+ do i=nir1,ner
+ j = i-1
+ rji = r(i) - r(j)
+ s1l = s1(j)
+ s2l = s2(j)
+ s3l = s3(j)
+ sum = sum + r(j)*r(j)*rji*(f(j) &
+ + rji*(0.5d0*s1l + rji*(third*s2l + rji*0.25d0*s3l))) &
+ + 2.0d0*r(j)*rji*rji*(0.5d0*f(j) + rji*(third*s1l + rji*(0.25d0*s2l + rji*fifth*s3l))) &
+ + rji*rji*rji*(third*f(j) + rji*(0.25d0*s1l + rji*(fifth*s2l + rji*sixth*s3l)))
+ enddo
+
+ end subroutine intgrl
+
+! -------------------------------
+
+ subroutine deriv(y,yprime,n,r,ndis,kdis,s1,s2,s3)
+
+ implicit none
+
+! Argument variables
+ integer kdis(28),n,ndis
+ double precision r(n),s1(n),s2(n),s3(n)
+ double precision y(n),yprime(n)
+
+! Local variables
+ integer i,j,j1,j2
+ integer k,nd,ndp
+ double precision a0,b0,b1
+ double precision f(3,1000),h,h2,h2a
+ double precision h2b,h3a,ha,s13
+ double precision s21,s32,yy(3)
+
+ yy(1) = 0.d0
+ yy(2) = 0.d0
+ yy(3) = 0.d0
+
+ ndp=ndis+1
+ do 3 nd=1,ndp
+ if(nd == 1) goto 4
+ if(nd == ndp) goto 5
+ j1=kdis(nd-1)+1
+ j2=kdis(nd)-2
+ goto 6
+ 4 j1=1
+ j2=kdis(1)-2
+ goto 6
+ 5 j1=kdis(ndis)+1
+ j2=n-2
+ 6 if((j2+1-j1)>0) goto 11
+ j2=j2+2
+ yy(1)=(y(j2)-y(j1))/(r(j2)-r(j1))
+ s1(j1)=yy(1)
+ s1(j2)=yy(1)
+ s2(j1)=yy(2)
+ s2(j2)=yy(2)
+ s3(j1)=yy(3)
+ s3(j2)=yy(3)
+ goto 3
+ 11 a0=0.0d0
+ if(j1 == 1) goto 7
+ h=r(j1+1)-r(j1)
+ h2=r(j1+2)-r(j1)
+ yy(1)=h*h2*(h2-h)
+ h=h*h
+ h2=h2*h2
+ b0=(y(j1)*(h-h2)+y(j1+1)*h2-y(j1+2)*h)/yy(1)
+ goto 8
+ 7 b0=0.0d0
+ 8 b1=b0
+
+ if(j2 > 1000) stop 'error in subroutine deriv for j2'
+
+ do i=j1,j2
+ h=r(i+1)-r(i)
+ yy(1)=y(i+1)-y(i)
+ h2=h*h
+ ha=h-a0
+ h2a=h-2.0d0*a0
+ h3a=2.0d0*h-3.0d0*a0
+ h2b=h2*b0
+ s1(i)=h2/ha
+ s2(i)=-ha/(h2a*h2)
+ s3(i)=-h*h2a/h3a
+ f(1,i)=(yy(1)-h*b0)/(h*ha)
+ f(2,i)=(h2b-yy(1)*(2.0d0*h-a0))/(h*h2*h2a)
+ f(3,i)=-(h2b-3.0d0*yy(1)*ha)/(h*h3a)
+ a0=s3(i)
+ b0=f(3,i)
+ enddo
+
+ i=j2+1
+ h=r(i+1)-r(i)
+ yy(1)=y(i+1)-y(i)
+ h2=h*h
+ ha=h-a0
+ h2a=h*ha
+ h2b=h2*b0-yy(1)*(2.d0*h-a0)
+ s1(i)=h2/ha
+ f(1,i)=(yy(1)-h*b0)/h2a
+ ha=r(j2)-r(i+1)
+ yy(1)=-h*ha*(ha+h)
+ ha=ha*ha
+ yy(1)=(y(i+1)*(h2-ha)+y(i)*ha-y(j2)*h2)/yy(1)
+ s3(i)=(yy(1)*h2a+h2b)/(h*h2*(h-2.0d0*a0))
+ s13=s1(i)*s3(i)
+ s2(i)=f(1,i)-s13
+
+ do j=j1,j2
+ k=i-1
+ s32=s3(k)*s2(i)
+ s1(i)=f(3,k)-s32
+ s21=s2(k)*s1(i)
+ s3(k)=f(2,k)-s21
+ s13=s1(k)*s3(k)
+ s2(k)=f(1,k)-s13
+ i=k
+ enddo
+
+ s1(i)=b1
+ j2=j2+2
+ s1(j2)=yy(1)
+ s2(j2)=yy(2)
+ s3(j2)=yy(3)
+ 3 continue
+
+ do i=1,n
+ yprime(i)=s1(i)
+ enddo
+
+ end subroutine deriv
+
+!
+! ------------------------------------------------------------------------------------------------
+!
+
+! copy from spline_routines.f90 to avoid compiling issues
+
+! compute spline coefficients
+
+ subroutine spline_construction(xpoint,ypoint,npoint,tangent_first_point,tangent_last_point,spline_coefficients)
+
+ implicit none
+
+! tangent to the spline imposed at the first and last points
+ double precision, intent(in) :: tangent_first_point,tangent_last_point
+
+! number of input points and coordinates of the input points
+ integer, intent(in) :: npoint
+ double precision, dimension(npoint), intent(in) :: xpoint,ypoint
+
+! spline coefficients output by the routine
+ double precision, dimension(npoint), intent(out) :: spline_coefficients
+
+ integer :: i
+
+ double precision, dimension(:), allocatable :: temporary_array
+
+ allocate(temporary_array(npoint))
+
+ spline_coefficients(1) = - 1.d0 / 2.d0
+
+ temporary_array(1) = (3.d0/(xpoint(2)-xpoint(1)))*((ypoint(2)-ypoint(1))/(xpoint(2)-xpoint(1))-tangent_first_point)
+
+ do i = 2,npoint-1
+
+ spline_coefficients(i) = ((xpoint(i)-xpoint(i-1))/(xpoint(i+1)-xpoint(i-1))-1.d0) &
+ / ((xpoint(i)-xpoint(i-1))/(xpoint(i+1)-xpoint(i-1))*spline_coefficients(i-1)+2.d0)
+
+ temporary_array(i) = (6.d0*((ypoint(i+1)-ypoint(i))/(xpoint(i+1)-xpoint(i)) &
+ - (ypoint(i)-ypoint(i-1))/(xpoint(i)-xpoint(i-1)))/(xpoint(i+1)-xpoint(i-1)) &
+ - (xpoint(i)-xpoint(i-1))/(xpoint(i+1)-xpoint(i-1))*temporary_array(i-1)) &
+ / ((xpoint(i)-xpoint(i-1))/(xpoint(i+1)-xpoint(i-1))*spline_coefficients(i-1)+2.d0)
+
+ enddo
+
+ spline_coefficients(npoint) = ((3.d0/(xpoint(npoint)-xpoint(npoint-1))) &
+ * (tangent_last_point-(ypoint(npoint)-ypoint(npoint-1))/(xpoint(npoint)-xpoint(npoint-1))) &
+ - 1.d0/2.d0*temporary_array(npoint-1))/(1.d0/2.d0*spline_coefficients(npoint-1)+1.d0)
+
+ do i = npoint-1,1,-1
+ spline_coefficients(i) = spline_coefficients(i)*spline_coefficients(i+1) + temporary_array(i)
+ enddo
+
+ deallocate(temporary_array)
+
+ end subroutine spline_construction
+
+! --------------
+
+! evaluate a spline
+
+ subroutine spline_evaluation(xpoint,ypoint,spline_coefficients,npoint,x_evaluate_spline,y_spline_obtained)
+
+ implicit none
+
+! number of input points and coordinates of the input points
+ integer, intent(in) :: npoint
+ double precision, dimension(npoint), intent(in) :: xpoint,ypoint
+
+! spline coefficients to use
+ double precision, dimension(npoint), intent(in) :: spline_coefficients
+
+! abscissa at which we need to evaluate the value of the spline
+ double precision, intent(in):: x_evaluate_spline
+
+! ordinate evaluated by the routine for the spline at this abscissa
+ double precision, intent(out):: y_spline_obtained
+
+ integer :: index_loop,index_lower,index_higher
+
+ double precision :: coef1,coef2
+
+! initialize to the whole interval
+ index_lower = 1
+ index_higher = npoint
+
+! determine the right interval to use, by dichotomy
+ do while (index_higher - index_lower > 1)
+! compute the middle of the interval
+ index_loop = (index_higher + index_lower) / 2
+ if(xpoint(index_loop) > x_evaluate_spline) then
+ index_higher = index_loop
+ else
+ index_lower = index_loop
+ endif
+ enddo
+
+! test that the interval obtained does not have a size of zero
+! (this could happen for instance in the case of duplicates in the input list of points)
+ if(xpoint(index_higher) == xpoint(index_lower)) stop 'incorrect interval found in spline evaluation'
+
+ coef1 = (xpoint(index_higher) - x_evaluate_spline) / (xpoint(index_higher) - xpoint(index_lower))
+ coef2 = (x_evaluate_spline - xpoint(index_lower)) / (xpoint(index_higher) - xpoint(index_lower))
+
+ y_spline_obtained = coef1*ypoint(index_lower) + coef2*ypoint(index_higher) + &
+ ((coef1**3 - coef1)*spline_coefficients(index_lower) + &
+ (coef2**3 - coef2)*spline_coefficients(index_higher))*((xpoint(index_higher) - xpoint(index_lower))**2)/6.d0
+
+ end subroutine spline_evaluation
+
+
+!
+! ------------------------------------------------------------------------------------------------
+!
+
+! copy from rthetaphi_xyz.f90 to avoid compiling issues
+
+
+ subroutine xyz_2_rthetaphi_dble(x,y,z,r,theta,phi)
+
+! convert x y z to r theta phi, double precision call
+
+ implicit none
+
+ include "constants.h"
+
+ double precision x,y,z,r,theta,phi
+ double precision xmesh,ymesh,zmesh
+
+ xmesh = x
+ ymesh = y
+ zmesh = z
+
+ if(zmesh > -SMALL_VAL_ANGLE .and. zmesh <= ZERO) zmesh = -SMALL_VAL_ANGLE
+ if(zmesh < SMALL_VAL_ANGLE .and. zmesh >= ZERO) zmesh = SMALL_VAL_ANGLE
+
+ theta = datan2(dsqrt(xmesh*xmesh+ymesh*ymesh),zmesh)
+
+ if(xmesh > -SMALL_VAL_ANGLE .and. xmesh <= ZERO) xmesh = -SMALL_VAL_ANGLE
+ if(xmesh < SMALL_VAL_ANGLE .and. xmesh >= ZERO) xmesh = SMALL_VAL_ANGLE
+
+ phi = datan2(ymesh,xmesh)
+
+ r = dsqrt(xmesh*xmesh + ymesh*ymesh + zmesh*zmesh)
+
+ end subroutine xyz_2_rthetaphi_dble
+
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/create_header_file/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/create_header_file/Makefile.in 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/create_header_file/Makefile.in 2012-04-02 06:04:51 UTC (rev 19915)
@@ -70,20 +70,24 @@
#######################################
XCREATE_HEADER_OBJECTS = \
- $O/auto_ner.o \
- $O/count_number_of_sources.o \
- $O/euler_angles.o \
- $O/force_ftz.o \
- $O/get_model_parameters.o \
- $O/get_value_parameters.o \
- $O/memory_eval.o \
- $O/param_reader.o \
- $O/read_compute_parameters.o \
- $O/read_parameter_file.o \
- $O/read_value_parameters.o \
- $O/reduce.o \
- $O/rthetaphi_xyz.o \
- $O/save_header_file.o \
+ $O/auto_ner.shared.o \
+ $O/count_elements.shared.o \
+ $O/count_number_of_sources.shared.o \
+ $O/count_points.shared.o \
+ $O/define_all_layers.shared.o \
+ $O/euler_angles.shared.o \
+ $O/force_ftz.cc.o \
+ $O/get_model_parameters.shared.o \
+ $O/get_timestep_and_layers.shared.o \
+ $O/get_value_parameters.shared.o \
+ $O/memory_eval.shared.o \
+ $O/param_reader.cc.o \
+ $O/read_compute_parameters.shared.o \
+ $O/read_parameter_file.shared.o \
+ $O/read_value_parameters.shared.o \
+ $O/reduce.shared.o \
+ $O/rthetaphi_xyz.shared.o \
+ $O/save_header_file.shared.o \
$(EMPTY_MACRO)
@@ -134,56 +138,19 @@
##
## shared
##
-$O/auto_ner.o: ${SETUP}/constants.h ${SHARED}/auto_ner.f90
- ${FCCOMPILE_CHECK} -c -o $O/auto_ner.o ${FCFLAGS_f90} ${SHARED}/auto_ner.f90
+$O/%.shared.o: ${SHARED}/%.f90 ${SETUP}/constants.h
+ ${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-$O/count_number_of_sources.o: ${SETUP}/constants.h ${SHARED}/count_number_of_sources.f90
- ${FCCOMPILE_CHECK} -c -o $O/count_number_of_sources.o ${FCFLAGS_f90} ${SHARED}/count_number_of_sources.f90
+$O/%.sharedmpi.o: ${SHARED}/%.f90 ${SETUP}/constants.h
+ ${MPIFCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-$O/euler_angles.o: ${SETUP}/constants.h ${SHARED}/euler_angles.f90
- ${FCCOMPILE_CHECK} -c -o $O/euler_angles.o ${FCFLAGS_f90} ${SHARED}/euler_angles.f90
+$O/%.cc.o: ${SHARED}/%.c ${SETUP}/config.h
+ ${CC} -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
-$O/get_model_parameters.o: ${SETUP}/constants.h ${SHARED}/get_model_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_model_parameters.o ${FCFLAGS_f90} ${SHARED}/get_model_parameters.f90
-$O/get_value_parameters.o: ${SETUP}/constants.h ${SHARED}/get_value_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_value_parameters.o ${FCFLAGS_f90} ${SHARED}/get_value_parameters.f90
-
-$O/memory_eval.o: ${SETUP}/constants.h ${SHARED}/memory_eval.f90
- ${FCCOMPILE_CHECK} -c -o $O/memory_eval.o ${FCFLAGS_f90} ${SHARED}/memory_eval.f90
-
-$O/force_ftz.o: ${SHARED}/force_ftz.c ${SETUP}/config.h
- ${CC} -c $(CPPFLAGS) $(CFLAGS) -o $O/force_ftz.o ${SHARED}/force_ftz.c
-
-$O/param_reader.o: ${SHARED}/param_reader.c ${SETUP}/config.h
- ${CC} -c $(CPPFLAGS) $(CFLAGS) -o $O/param_reader.o ${SHARED}/param_reader.c
-
-$O/read_compute_parameters.o: ${SETUP}/constants.h ${SHARED}/read_compute_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/read_compute_parameters.o ${FCFLAGS_f90} ${SHARED}/read_compute_parameters.f90
-
-$O/read_parameter_file.o: ${SETUP}/constants.h ${SHARED}/read_parameter_file.f90
- ${FCCOMPILE_CHECK} -c -o $O/read_parameter_file.o ${FCFLAGS_f90} ${SHARED}/read_parameter_file.f90
-
-$O/read_value_parameters.o: ${SETUP}/constants.h ${SHARED}/read_value_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/read_value_parameters.o ${FCFLAGS_f90} ${SHARED}/read_value_parameters.f90
-
-$O/reduce.o: ${SETUP}/constants.h ${SHARED}/reduce.f90
- ${FCCOMPILE_CHECK} -c -o $O/reduce.o ${FCFLAGS_f90} ${SHARED}/reduce.f90
-
-$O/rthetaphi_xyz.o: ${SETUP}/constants.h ${SHARED}/rthetaphi_xyz.f90
- ${FCCOMPILE_CHECK} -c -o $O/rthetaphi_xyz.o ${FCFLAGS_f90} ${SHARED}/rthetaphi_xyz.f90
-
-$O/save_header_file.o: ${SETUP}/constants.h ${SHARED}/save_header_file.f90
- ${FCCOMPILE_CHECK} -c -o $O/save_header_file.o ${FCFLAGS_f90} ${SHARED}/save_header_file.f90
-
-$O/spline_routines.o: ${SETUP}/constants.h ${SHARED}/spline_routines.f90
- ${FCCOMPILE_CHECK} -c -o $O/spline_routines.o ${FCFLAGS_f90} ${SHARED}/spline_routines.f90
-
-
##
-## create_header_file
+## rule for create_header_file
##
-$O/create_header_file.o: $S/create_header_file.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_header_file.o ${FCFLAGS_f90} $S/create_header_file.f90
+$O/%.o: $S/%.f90 ${SETUP}/constants.h
+ ${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/cuda/specfem3D_gpu_cuda_method_stubs.c
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/cuda/specfem3D_gpu_cuda_method_stubs.c 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/cuda/specfem3D_gpu_cuda_method_stubs.c 2012-04-02 06:04:51 UTC (rev 19915)
@@ -1,4 +1,4 @@
-/*
+/*
!=====================================================================
!
! S p e c f e m 3 D V e r s i o n 2 . 0
@@ -33,8 +33,8 @@
typedef float realw;
-
+
//
// src/cuda/assemble_MPI_scalar_cuda.cu
//
@@ -42,12 +42,12 @@
void FC_FUNC_(transfer_boun_pot_from_device,
TRANSFER_BOUN_POT_FROM_DEVICE)(long* Mesh_pointer_f,
realw* send_potential_dot_dot_buffer,
- int* FORWARD_OR_ADJOINT){}
+ int* FORWARD_OR_ADJOINT){}
void FC_FUNC_(transfer_asmbl_pot_to_device,
TRANSFER_ASMBL_POT_TO_DEVICE)(long* Mesh_pointer,
realw* buffer_recv_scalar,
- int* FORWARD_OR_ADJOINT) {}
+ int* FORWARD_OR_ADJOINT) {}
//
@@ -58,13 +58,13 @@
TRANSFER_BOUN_ACCEL_FROM_DEVICE)(long* Mesh_pointer_f,
realw* send_accel_buffer,
int* IREGION,
- int* FORWARD_OR_ADJOINT){}
+ int* FORWARD_OR_ADJOINT){}
void FC_FUNC_(transfer_asmbl_accel_to_device,
TRANSFER_ASMBL_ACCEL_TO_DEVICE)(long* Mesh_pointer,
realw* buffer_recv_vector,
int* IREGION,
- int* FORWARD_OR_ADJOINT) {}
+ int* FORWARD_OR_ADJOINT) {}
//
@@ -72,58 +72,58 @@
//
void FC_FUNC_(pause_for_debug,
- PAUSE_FOR_DEBUG)() {}
+ PAUSE_FOR_DEBUG)() {}
void FC_FUNC_(output_free_device_memory,
- OUTPUT_FREE_DEVICE_MEMORY)(int* myrank) {}
+ OUTPUT_FREE_DEVICE_MEMORY)(int* myrank) {}
void FC_FUNC_(get_free_device_memory,
- get_FREE_DEVICE_MEMORY)(realw* free, realw* used, realw* total ) {}
+ get_FREE_DEVICE_MEMORY)(realw* free, realw* used, realw* total ) {}
void FC_FUNC_(check_max_norm_displ_gpu,
- CHECK_MAX_NORM_DISPL_GPU)(int* size, realw* displ,long* Mesh_pointer_f,int* announceID) {}
+ CHECK_MAX_NORM_DISPL_GPU)(int* size, realw* displ,long* Mesh_pointer_f,int* announceID) {}
void FC_FUNC_(check_max_norm_vector,
- CHECK_MAX_NORM_VECTOR)(int* size, realw* vector1, int* announceID) {}
+ CHECK_MAX_NORM_VECTOR)(int* size, realw* vector1, int* announceID) {}
void FC_FUNC_(check_max_norm_displ,
- CHECK_MAX_NORM_DISPL)(int* size, realw* displ, int* announceID) {}
+ CHECK_MAX_NORM_DISPL)(int* size, realw* displ, int* announceID) {}
void FC_FUNC_(check_max_norm_b_displ_gpu,
- CHECK_MAX_NORM_B_DISPL_GPU)(int* size, realw* b_displ,long* Mesh_pointer_f,int* announceID) {}
+ CHECK_MAX_NORM_B_DISPL_GPU)(int* size, realw* b_displ,long* Mesh_pointer_f,int* announceID) {}
void FC_FUNC_(check_max_norm_b_accel_gpu,
- CHECK_MAX_NORM_B_ACCEL_GPU)(int* size, realw* b_accel,long* Mesh_pointer_f,int* announceID) {}
+ CHECK_MAX_NORM_B_ACCEL_GPU)(int* size, realw* b_accel,long* Mesh_pointer_f,int* announceID) {}
void FC_FUNC_(check_max_norm_b_veloc_gpu,
- CHECK_MAX_NORM_B_VELOC_GPU)(int* size, realw* b_veloc,long* Mesh_pointer_f,int* announceID) {}
+ CHECK_MAX_NORM_B_VELOC_GPU)(int* size, realw* b_veloc,long* Mesh_pointer_f,int* announceID) {}
void FC_FUNC_(check_max_norm_b_displ,
- CHECK_MAX_NORM_B_DISPL)(int* size, realw* b_displ,int* announceID) {}
+ CHECK_MAX_NORM_B_DISPL)(int* size, realw* b_displ,int* announceID) {}
void FC_FUNC_(check_max_norm_b_accel,
- CHECK_MAX_NORM_B_ACCEL)(int* size, realw* b_accel,int* announceID) {}
+ CHECK_MAX_NORM_B_ACCEL)(int* size, realw* b_accel,int* announceID) {}
void FC_FUNC_(check_error_vectors,
- CHECK_ERROR_VECTORS)(int* sizef, realw* vector1,realw* vector2) {}
+ CHECK_ERROR_VECTORS)(int* sizef, realw* vector1,realw* vector2) {}
void FC_FUNC_(get_max_accel,
- GET_MAX_ACCEL)(int* itf,int* sizef,long* Mesh_pointer) {}
+ GET_MAX_ACCEL)(int* itf,int* sizef,long* Mesh_pointer) {}
void FC_FUNC_(check_norm_acoustic_from_device,
CHECK_NORM_ACOUSTIC_FROM_DEVICE)(realw* norm,
long* Mesh_pointer_f,
- int* SIMULATION_TYPE) {}
+ int* SIMULATION_TYPE) {}
void FC_FUNC_(check_norm_elastic_from_device,
CHECK_NORM_ELASTIC_FROM_DEVICE)(realw* norm,
long* Mesh_pointer_f,
- int* SIMULATION_TYPE) {}
+ int* SIMULATION_TYPE) {}
void FC_FUNC_(check_norm_strain_from_device,
CHECK_NORM_STRAIN_FROM_DEVICE)(realw* strain_norm,
realw* strain_norm2,
- long* Mesh_pointer_f) {}
+ long* Mesh_pointer_f) {}
//
@@ -133,12 +133,12 @@
void FC_FUNC_(compute_add_sources_el_cuda,
COMPUTE_ADD_SOURCES_EL_CUDA)(long* Mesh_pointer_f,
int* NSOURCESf,
- double* h_stf_pre_compute) {}
+ double* h_stf_pre_compute) {}
void FC_FUNC_(compute_add_sources_el_s3_cuda,
COMPUTE_ADD_SOURCES_EL_S3_CUDA)(long* Mesh_pointer_f,
int* NSOURCESf,
- double* h_stf_pre_compute) {}
+ double* h_stf_pre_compute) {}
void FC_FUNC_(add_sources_el_sim_type_2_or_3,
ADD_SOURCES_EL_SIM_TYPE_2_OR_3)(long* Mesh_pointer,
@@ -146,7 +146,7 @@
realw* h_adj_sourcearrays,
int* h_islice_selected_rec,
int* h_ispec_selected_rec,
- int* time_index) {}
+ int* time_index) {}
//
@@ -154,25 +154,25 @@
//
void FC_FUNC_(compute_coupling_fluid_cmb_cuda,
- COMPUTE_COUPLING_FLUID_CMB_CUDA)(long* Mesh_pointer_f) {}
+ COMPUTE_COUPLING_FLUID_CMB_CUDA)(long* Mesh_pointer_f) {}
void FC_FUNC_(compute_coupling_fluid_icb_cuda,
- COMPUTE_COUPLING_FLUID_ICB_CUDA)(long* Mesh_pointer_f) {}
+ COMPUTE_COUPLING_FLUID_ICB_CUDA)(long* Mesh_pointer_f) {}
void FC_FUNC_(compute_coupling_cmb_fluid_cuda,
COMPUTE_COUPLING_CMB_FLUID_CUDA)(long* Mesh_pointer_f,
double RHO_TOP_OC,
realw minus_g_cmb,
- int GRAVITY_VAL) {}
+ int GRAVITY_VAL) {}
void FC_FUNC_(compute_coupling_icb_fluid_cuda,
COMPUTE_COUPLING_ICB_FLUID_CUDA)(long* Mesh_pointer_f,
double RHO_BOTTOM_OC,
realw minus_g_icb,
- int GRAVITY_VAL) {}
+ int GRAVITY_VAL) {}
void FC_FUNC_(compute_coupling_ocean_cuda,
- COMPUTE_COUPLING_OCEAN_CUDA)(long* Mesh_pointer_f) {}
+ COMPUTE_COUPLING_OCEAN_CUDA)(long* Mesh_pointer_f) {}
//
@@ -181,7 +181,7 @@
void FC_FUNC_(compute_forces_crust_mantle_cuda,
COMPUTE_FORCES_CRUST_MANTLE_CUDA)(long* Mesh_pointer_f,
- int* iphase) {}
+ int* iphase) {}
//
@@ -190,7 +190,7 @@
void FC_FUNC_(compute_forces_inner_core_cuda,
COMPUTE_FORCES_INNER_CORE_CUDA)(long* Mesh_pointer_f,
- int* iphase) {}
+ int* iphase) {}
//
@@ -201,7 +201,7 @@
COMPUTE_FORCES_OUTER_CORE_CUDA)(long* Mesh_pointer_f,
int* iphase,
realw* time_f,
- realw* b_time_f) {}
+ realw* b_time_f) {}
//
@@ -209,22 +209,22 @@
//
void FC_FUNC_(compute_kernels_cm_cuda,
- COMPUTE_KERNELS_CM_CUDA)(long* Mesh_pointer,realw* deltat_f) {}
+ COMPUTE_KERNELS_CM_CUDA)(long* Mesh_pointer,realw* deltat_f) {}
void FC_FUNC_(compute_kernels_ic_cuda,
- COMPUTE_KERNELS_IC_CUDA)(long* Mesh_pointer,realw* deltat_f) {}
+ COMPUTE_KERNELS_IC_CUDA)(long* Mesh_pointer,realw* deltat_f) {}
void FC_FUNC_(compute_kernels_oc_cuda,
- COMPUTE_KERNELS_OC_CUDA)(long* Mesh_pointer,realw* deltat_f) {}
+ COMPUTE_KERNELS_OC_CUDA)(long* Mesh_pointer,realw* deltat_f) {}
void FC_FUNC_(compute_kernels_strgth_noise_cu,
COMPUTE_KERNELS_STRGTH_NOISE_CU)(long* Mesh_pointer,
realw* h_noise_surface_movie,
- realw* deltat_f) {}
+ realw* deltat_f) {}
void FC_FUNC_(compute_kernels_hess_cuda,
COMPUTE_KERNELS_HESS_CUDA)(long* Mesh_pointer,
- realw* deltat_f) {}
+ realw* deltat_f) {}
//
@@ -234,7 +234,7 @@
void FC_FUNC_(compute_stacey_acoustic_cuda,
COMPUTE_STACEY_ACOUSTIC_CUDA)(long* Mesh_pointer_f,
realw* absorb_potential,
- int* itype) {}
+ int* itype) {}
//
@@ -244,7 +244,7 @@
void FC_FUNC_(compute_stacey_elastic_cuda,
COMPUTE_STACEY_ELASTIC_CUDA)(long* Mesh_pointer_f,
realw* absorb_field,
- int* itype) {}
+ int* itype) {}
//
@@ -258,7 +258,7 @@
realw* deltatover2_F,
realw* b_deltat_F,
realw* b_deltatsqover2_F,
- realw* b_deltatover2_F) {}
+ realw* b_deltatover2_F) {}
void FC_FUNC_(it_update_displacement_cm_cuda,
IT_UPDATE_DISPLACMENT_CM_CUDA)(long* Mesh_pointer_f,
@@ -267,7 +267,7 @@
realw* deltatover2_F,
realw* b_deltat_F,
realw* b_deltatsqover2_F,
- realw* b_deltatover2_F) {}
+ realw* b_deltatover2_F) {}
void FC_FUNC_(it_update_displacement_oc_cuda,
IT_UPDATE_DISPLACEMENT_OC_cuda)(long* Mesh_pointer_f,
@@ -276,56 +276,56 @@
realw* deltatover2_F,
realw* b_deltat_F,
realw* b_deltatsqover2_F,
- realw* b_deltatover2_F) {}
+ realw* b_deltatover2_F) {}
void FC_FUNC_(kernel_3_a_cuda,
KERNEL_3_A_CUDA)(long* Mesh_pointer,
realw* deltatover2_F,
int* SIMULATION_TYPE_f,
realw* b_deltatover2_F,
- int* OCEANS) {}
+ int* OCEANS) {}
void FC_FUNC_(kernel_3_b_cuda,
KERNEL_3_B_CUDA)(long* Mesh_pointer,
realw* deltatover2_F,
int* SIMULATION_TYPE_f,
realw* b_deltatover2_F,
- int* OCEANS) {}
+ int* OCEANS) {}
void FC_FUNC_(kernel_3_outer_core_cuda,
KERNEL_3_OUTER_CORE_CUDA)(long* Mesh_pointer,
realw* deltatover2_F,
int* SIMULATION_TYPE_f,
- realw* b_deltatover2_F) {}
+ realw* b_deltatover2_F) {}
//
// src/cuda/noise_tomography_cuda.cu
//
-void FC_FUNC_(fortranflush,FORTRANFLUSH)(int* rank){}
+void FC_FUNC_(fortranflush,FORTRANFLUSH)(int* rank){}
-void FC_FUNC_(fortranprint,FORTRANPRINT)(int* id) {}
+void FC_FUNC_(fortranprint,FORTRANPRINT)(int* id) {}
-void FC_FUNC_(fortranprintf,FORTRANPRINTF)(realw* val) {}
+void FC_FUNC_(fortranprintf,FORTRANPRINTF)(realw* val) {}
-void FC_FUNC_(fortranprintd,FORTRANPRINTD)(double* val) {}
+void FC_FUNC_(fortranprintd,FORTRANPRINTD)(double* val) {}
-void FC_FUNC_(make_displ_rand,MAKE_DISPL_RAND)(long* Mesh_pointer_f,realw* h_displ) {}
+void FC_FUNC_(make_displ_rand,MAKE_DISPL_RAND)(long* Mesh_pointer_f,realw* h_displ) {}
void FC_FUNC_(noise_transfer_surface_to_host,
NOISE_TRANSFER_SURFACE_TO_HOST)(long* Mesh_pointer_f,
- realw* h_noise_surface_movie) {}
+ realw* h_noise_surface_movie) {}
void FC_FUNC_(noise_add_source_master_rec_cu,
NOISE_ADD_SOURCE_MASTER_REC_CU)(long* Mesh_pointer_f,
int* it_f,
int* irec_master_noise_f,
- int* islice_selected_rec) {}
+ int* islice_selected_rec) {}
void FC_FUNC_(noise_add_surface_movie_cuda,
NOISE_ADD_SURFACE_MOVIE_CUDA)(long* Mesh_pointer_f,
- realw* h_noise_surface_movie) {}
+ realw* h_noise_surface_movie) {}
//
@@ -333,10 +333,10 @@
//
void FC_FUNC_(prepare_cuda_device,
- PREPARE_CUDA_DEVICE)(int* myrank_f,int* ncuda_devices) {
+ PREPARE_CUDA_DEVICE)(int* myrank_f,int* ncuda_devices) {
fprintf(stderr,"ERROR: GPU_MODE enabled without GPU/CUDA Support. To enable GPU support, reconfigure with --with-cuda flag.\n");
exit(1);
-}
+}
void FC_FUNC_(prepare_constants_device,
PREPARE_CONSTANTS_DEVICE)(long* Mesh_pointer,
@@ -371,7 +371,7 @@
int* SAVE_BOUNDARY_MESH_f,
int* USE_MESH_COLORING_GPU_f,
int* ANISOTROPIC_KL_f,
- int* APPROXIMATE_HESS_KL_f) {}
+ int* APPROXIMATE_HESS_KL_f) {}
void FC_FUNC_(prepare_fields_rotation_device,
PREPARE_FIELDS_ROTATION_DEVICE)(long* Mesh_pointer_f,
@@ -384,7 +384,7 @@
realw* b_A_array_rotation,
realw* b_B_array_rotation,
int* NSPEC_OUTER_CORE_ROTATION
- ) {}
+ ) {}
void FC_FUNC_(prepare_fields_gravity_device,
PREPARE_FIELDS_gravity_DEVICE)(long* Mesh_pointer_f,
@@ -395,7 +395,7 @@
realw* density_table,
realw* h_wgll_cube,
int* NRAD_GRAVITY
- ) {}
+ ) {}
void FC_FUNC_(prepare_fields_attenuat_device,
PREPARE_FIELDS_ATTENUAT_DEVICE)(long* Mesh_pointer_f,
@@ -415,7 +415,7 @@
realw* one_minus_sum_beta_inner_core,
realw* alphaval,realw* betaval,realw* gammaval,
realw* b_alphaval,realw* b_betaval,realw* b_gammaval
- ) {}
+ ) {}
void FC_FUNC_(prepare_fields_strain_device,
PREPARE_FIELDS_STRAIN_DEVICE)(long* Mesh_pointer_f,
@@ -443,7 +443,7 @@
realw* b_epsilondev_yz_inner_core,
realw* eps_trace_over_3_inner_core,
realw* b_eps_trace_over_3_inner_core
- ) {}
+ ) {}
void FC_FUNC_(prepare_fields_absorb_device,
PREPARE_FIELDS_ABSORB_DEVICE)(long* Mesh_pointer_f,
@@ -475,7 +475,7 @@
realw* jacobian2D_ymin_outer_core, realw* jacobian2D_ymax_outer_core,
realw* jacobian2D_bottom_outer_core,
realw* vp_outer_core
- ) {}
+ ) {}
void FC_FUNC_(prepare_mpi_buffers_device,
PREPARE_MPI_BUFFERS_DEVICE)(long* Mesh_pointer_f,
@@ -491,7 +491,7 @@
int* max_nibool_interfaces_outer_core,
int* nibool_interfaces_outer_core,
int* ibool_interfaces_outer_core
- ){}
+ ){}
void FC_FUNC_(prepare_fields_noise_device,
PREPARE_FIELDS_NOISE_DEVICE)(long* Mesh_pointer_f,
@@ -503,7 +503,7 @@
realw* normal_y_noise,
realw* normal_z_noise,
realw* mask_noise,
- realw* jacobian2D_top_crust_mantle) {}
+ realw* jacobian2D_top_crust_mantle) {}
void FC_FUNC_(prepare_crust_mantle_device,
PREPARE_CRUST_MANTLE_DEVICE)(long* Mesh_pointer_f,
@@ -534,7 +534,7 @@
int* nspec_inner,
int* NSPEC2D_TOP_CM,
int* NSPEC2D_BOTTOM_CM
- ) {}
+ ) {}
void FC_FUNC_(prepare_outer_core_device,
PREPARE_OUTER_CORE_DEVICE)(long* Mesh_pointer_f,
@@ -557,7 +557,7 @@
int* nspec_inner,
int* NSPEC2D_TOP_OC,
int* NSPEC2D_BOTTOM_OC
- ) {}
+ ) {}
void FC_FUNC_(prepare_inner_core_device,
PREPARE_INNER_CORE_DEVICE)(long* Mesh_pointer_f,
@@ -576,11 +576,11 @@
int* phase_ispec_inner,
int* nspec_outer,
int* nspec_inner,
- int* NSPEC2D_TOP_IC) {}
+ int* NSPEC2D_TOP_IC) {}
void FC_FUNC_(prepare_oceans_device,
PREPARE_OCEANS_DEVICE)(long* Mesh_pointer_f,
- realw* h_rmass_ocean_load) {}
+ realw* h_rmass_ocean_load) {}
void FC_FUNC_(prepare_fields_elastic_device,
PREPARE_FIELDS_ELASTIC_DEVICE)(long* Mesh_pointer_f,
@@ -635,10 +635,10 @@
realw *c46store,
realw *c55store,
realw *c56store,
- realw *c66store){}
+ realw *c66store){}
void FC_FUNC_(prepare_cleanup_device,
- PREPARE_CLEANUP_DEVICE)(long* Mesh_pointer_f) {}
+ PREPARE_CLEANUP_DEVICE)(long* Mesh_pointer_f) {}
//
@@ -646,82 +646,82 @@
//
void FC_FUNC_(transfer_fields_cm_to_device,
- TRANSFER_FIELDS_CM_TO_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {}
+ TRANSFER_FIELDS_CM_TO_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_fields_ic_to_device,
- TRANSFER_FIELDS_IC_TO_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {}
+ TRANSFER_FIELDS_IC_TO_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_fields_oc_to_device,
- TRANSFER_FIELDS_OC_TO_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {}
+ TRANSFER_FIELDS_OC_TO_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_b_fields_cm_to_device,
TRANSFER_FIELDS_B_CM_TO_DEVICE)(int* size, realw* b_displ, realw* b_veloc, realw* b_accel,
- long* Mesh_pointer_f) {}
+ long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_b_fields_ic_to_device,
TRANSFER_FIELDS_B_IC_TO_DEVICE)(int* size, realw* b_displ, realw* b_veloc, realw* b_accel,
- long* Mesh_pointer_f) {}
+ long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_b_fields_oc_to_device,
TRANSFER_FIELDS_B_OC_TO_DEVICE)(int* size, realw* b_displ, realw* b_veloc, realw* b_accel,
- long* Mesh_pointer_f) {}
+ long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_fields_cm_from_device,
- TRANSFER_FIELDS_CM_FROM_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {}
+ TRANSFER_FIELDS_CM_FROM_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_fields_ic_from_device,
- TRANSFER_FIELDS_IC_FROM_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {}
+ TRANSFER_FIELDS_IC_FROM_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_fields_oc_from_device,
- TRANSFER_FIELDS_OC_FROM_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {}
+ TRANSFER_FIELDS_OC_FROM_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_b_fields_cm_from_device,
TRANSFER_B_FIELDS_CM_FROM_DEVICE)(int* size, realw* b_displ, realw* b_veloc, realw* b_accel,
- long* Mesh_pointer_f) {}
+ long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_b_fields_ic_from_device,
TRANSFER_B_FIELDS_IC_FROM_DEVICE)(int* size, realw* b_displ, realw* b_veloc, realw* b_accel,
- long* Mesh_pointer_f) {}
+ long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_b_fields_oc_from_device,
TRANSFER_B_FIELDS_OC_FROM_DEVICE)(int* size, realw* b_displ, realw* b_veloc, realw* b_accel,
- long* Mesh_pointer_f) {}
+ long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_accel_cm_to_device,
- TRANSFER_ACCEL_CM_TO_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {}
+ TRANSFER_ACCEL_CM_TO_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_displ_cm_from_device,
- TRANSFER_DISPL_CM_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {}
+ TRANSFER_DISPL_CM_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_b_displ_cm_from_device,
- TRANSFER_B_DISPL_CM_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {}
+ TRANSFER_B_DISPL_CM_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_displ_ic_from_device,
- TRANSFER_DISPL_IC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {}
+ TRANSFER_DISPL_IC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_b_displ_ic_from_device,
- TRANSFER_B_DISPL_IC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {}
+ TRANSFER_B_DISPL_IC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_displ_oc_from_device,
- TRANSFER_DISPL_OC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {}
+ TRANSFER_DISPL_OC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_b_displ_oc_from_device,
- TRANSFER_B_DISPL_OC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {}
+ TRANSFER_B_DISPL_OC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_veloc_cm_from_device,
- TRANSFER_DISPL_CM_FROM_DEVICE)(int* size, realw* veloc, long* Mesh_pointer_f) {}
+ TRANSFER_DISPL_CM_FROM_DEVICE)(int* size, realw* veloc, long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_accel_cm_from_device,
- TRANSFER_ACCEL_CM_FROM_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {}
+ TRANSFER_ACCEL_CM_FROM_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_b_accel_cm_from_device,
- TRANSFER_B_ACCEL_CM_FROM_DEVICE)(int* size, realw* b_accel,long* Mesh_pointer_f) {}
+ TRANSFER_B_ACCEL_CM_FROM_DEVICE)(int* size, realw* b_accel,long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_accel_ic_from_device,
- TRANSFER_ACCEL_IC_FROM_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {}
+ TRANSFER_ACCEL_IC_FROM_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_accel_oc_from_device,
- TRANSFER_ACCEL_OC_FROM_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {}
+ TRANSFER_ACCEL_OC_FROM_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {}
void FC_FUNC_(transfer_strain_cm_from_device,
TRANSFER_STRAIN_CM_FROM_DEVICE)(long* Mesh_pointer,
@@ -730,7 +730,7 @@
realw* epsilondev_yy,
realw* epsilondev_xy,
realw* epsilondev_xz,
- realw* epsilondev_yz) {}
+ realw* epsilondev_yz) {}
void FC_FUNC_(transfer_b_strain_cm_to_device,
TRANSFER_B_STRAIN_CM_TO_DEVICE)(long* Mesh_pointer,
@@ -738,7 +738,7 @@
realw* epsilondev_yy,
realw* epsilondev_xy,
realw* epsilondev_xz,
- realw* epsilondev_yz) {}
+ realw* epsilondev_yz) {}
void FC_FUNC_(transfer_strain_ic_from_device,
TRANSFER_STRAIN_IC_FROM_DEVICE)(long* Mesh_pointer,
@@ -747,7 +747,7 @@
realw* epsilondev_yy,
realw* epsilondev_xy,
realw* epsilondev_xz,
- realw* epsilondev_yz) {}
+ realw* epsilondev_yz) {}
void FC_FUNC_(transfer_b_strain_ic_to_device,
TRANSFER_B_STRAIN_IC_TO_DEVICE)(long* Mesh_pointer,
@@ -755,17 +755,17 @@
realw* epsilondev_yy,
realw* epsilondev_xy,
realw* epsilondev_xz,
- realw* epsilondev_yz) {}
+ realw* epsilondev_yz) {}
void FC_FUNC_(transfer_rotation_from_device,
TRANSFER_ROTATION_FROM_DEVICE)(long* Mesh_pointer,
realw* A_array_rotation,
- realw* B_array_rotation) {}
+ realw* B_array_rotation) {}
void FC_FUNC_(transfer_b_rotation_to_device,
TRANSFER_B_ROTATION_TO_DEVICE)(long* Mesh_pointer,
realw* A_array_rotation,
- realw* B_array_rotation) {}
+ realw* B_array_rotation) {}
void FC_FUNC_(transfer_kernels_cm_to_host,
TRANSFER_KERNELS_CM_TO_HOST)(long* Mesh_pointer,
@@ -773,30 +773,30 @@
realw* h_alpha_kl,
realw* h_beta_kl,
realw* h_cijkl_kl,
- int* NSPEC) {}
+ int* NSPEC) {}
void FC_FUNC_(transfer_kernels_ic_to_host,
TRANSFER_KERNELS_IC_TO_HOST)(long* Mesh_pointer,
realw* h_rho_kl,
realw* h_alpha_kl,
realw* h_beta_kl,
- int* NSPEC) {}
+ int* NSPEC) {}
void FC_FUNC_(transfer_kernels_oc_to_host,
TRANSFER_KERNELS_OC_TO_HOST)(long* Mesh_pointer,
realw* h_rho_kl,
realw* h_alpha_kl,
- int* NSPEC) {}
+ int* NSPEC) {}
void FC_FUNC_(transfer_kernels_noise_to_host,
TRANSFER_KERNELS_NOISE_TO_HOST)(long* Mesh_pointer,
realw* h_Sigma_kl,
- int* NSPEC) {}
+ int* NSPEC) {}
void FC_FUNC_(transfer_kernels_hess_cm_tohost,
TRANSFER_KERNELS_HESS_CM_TOHOST)(long* Mesh_pointer,
realw* h_hess_kl,
- int* NSPEC) {}
+ int* NSPEC) {}
//
@@ -816,7 +816,7 @@
int* number_receiver_global,
int* ispec_selected_rec,
int* ispec_selected_source,
- int* ibool) {}
+ int* ibool) {}
void FC_FUNC_(transfer_station_ac_from_device,
TRANSFER_STATION_AC_FROM_DEVICE)(
@@ -831,5 +831,5 @@
int* ispec_selected_rec,
int* ispec_selected_source,
int* ibool,
- int* SIMULATION_TYPEf) {}
+ int* SIMULATION_TYPEf) {}
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/Makefile.in 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/Makefile.in 2012-04-02 06:04:51 UTC (rev 19915)
@@ -70,27 +70,36 @@
#######################################
libspecfem_a_OBJECTS_COMMON = \
- $O/auto_ner.o \
- $O/broadcast_compute_parameters.o \
- $O/calendar.o \
- $O/count_number_of_sources.o \
- $O/create_name_database.o \
- $O/force_ftz.o \
- $O/get_model_parameters.o \
- $O/get_value_parameters.o \
- $O/gll_library.o \
- $O/hex_nodes.o \
- $O/intgrl.o \
- $O/lagrange_poly.o \
- $O/make_ellipticity.o \
- $O/make_gravity.o \
- $O/param_reader.o \
- $O/read_compute_parameters.o \
- $O/read_parameter_file.o \
- $O/read_value_parameters.o \
- $O/reduce.o \
- $O/rthetaphi_xyz.o \
- $O/spline_routines.o \
+ $O/auto_ner.shared.o \
+ $O/broadcast_compute_parameters.sharedmpi.o \
+ $O/calendar.shared.o \
+ $O/count_elements.shared.o \
+ $O/count_number_of_sources.shared.o \
+ $O/count_points.shared.o \
+ $O/create_name_database.shared.o \
+ $O/define_all_layers.shared.o \
+ $O/euler_angles.shared.o \
+ $O/force_ftz.cc.o \
+ $O/get_model_parameters.shared.o \
+ $O/get_timestep_and_layers.shared.o \
+ $O/get_value_parameters.shared.o \
+ $O/gll_library.shared.o \
+ $O/hex_nodes.shared.o \
+ $O/intgrl.shared.o \
+ $O/lagrange_poly.shared.o \
+ $O/make_ellipticity.shared.o \
+ $O/make_gravity.shared.o \
+ $O/memory_eval.shared.o \
+ $O/model_prem.shared.o \
+ $O/model_topo_bathy.sharedmpi.o \
+ $O/param_reader.cc.o \
+ $O/read_compute_parameters.shared.o \
+ $O/read_parameter_file.shared.o \
+ $O/read_value_parameters.shared.o \
+ $O/reduce.shared.o \
+ $O/rthetaphi_xyz.shared.o \
+ $O/save_header_file.shared.o \
+ $O/spline_routines.shared.o \
$(EMPTY_MACRO)
@@ -103,15 +112,14 @@
$O/calc_jacobian.o \
$O/compute_coordinates_grid.o \
$O/compute_element_properties.o \
+ $O/compute_volumes.o \
$O/create_central_cube.o \
- $O/create_chunk_buffers.o \
+ $O/create_chunk_buffers.mpi.o \
$O/create_doubling_elements.o \
$O/create_mass_matrices.o \
- $O/create_regions_mesh.o \
- $O/get_perm_color.o \
+ $O/create_regions_mesh.mpi.o \
$O/create_regular_elements.o \
$O/define_superbrick.o \
- $O/euler_angles.o \
$O/get_absorb.o \
$O/get_ellipticity.o \
$O/get_global.o \
@@ -121,38 +129,36 @@
$O/get_MPI_1D_buffers.o \
$O/get_MPI_cutplanes_eta.o \
$O/get_MPI_cutplanes_xi.o \
+ $O/get_perm_color.o \
$O/get_shape2D.o \
$O/get_shape3D.o \
+ $O/initialize_layers.o \
$O/lgndr.o \
- $O/memory_eval.o \
- $O/model_sea99_s.o \
+ $O/model_1dref.o \
$O/model_1066a.o \
$O/model_ak135.o \
$O/model_aniso_inner_core.o \
- $O/model_aniso_mantle.o \
- $O/model_atten3D_QRFSI12.o \
- $O/model_attenuation.o \
- $O/model_crust.o \
- $O/model_eucrust.o \
- $O/model_epcrust.o \
- $O/model_crustmaps.o \
- $O/model_gll.o \
- $O/model_heterogen_mantle.o \
+ $O/model_aniso_mantle.mpi.o \
+ $O/model_atten3D_QRFSI12.mpi.o \
+ $O/model_attenuation.mpi.o \
+ $O/model_crust.mpi.o \
+ $O/model_crustmaps.mpi.o \
+ $O/model_eucrust.mpi.o \
+ $O/model_epcrust.mpi.o \
+ $O/model_gapp2.mpi.o \
+ $O/model_gll.mpi.o \
+ $O/model_heterogen_mantle.mpi.o \
$O/model_iasp91.o \
$O/model_jp1d.o \
- $O/model_jp3d.o \
- $O/model_ppm.o \
- $O/model_gapp2.o \
- $O/model_prem.o \
- $O/model_1dref.o \
- $O/model_s20rts.o \
- $O/model_s40rts.o \
- $O/model_s362ani.o \
+ $O/model_jp3d.mpi.o \
+ $O/model_ppm.mpi.o \
+ $O/model_s20rts.mpi.o \
+ $O/model_s40rts.mpi.o \
+ $O/model_s362ani.mpi.o \
$O/model_sea1d.o \
- $O/model_topo_bathy.o \
+ $O/model_sea99_s.mpi.o \
$O/moho_stretching.o \
$O/save_arrays_solver.o \
- $O/save_header_file.o \
$O/sort_array_coordinates.o \
$O/stretching_function.o \
$O/write_AVS_DX_global_chunks_data.o \
@@ -161,6 +167,18 @@
$O/write_AVS_DX_surface_data.o \
$(EMPTY_MACRO)
+MESHER_ARRAY_OBJECTS = \
+ $O/meshfem3D_models.mpi.o \
+ $O/meshfem3D_par.o \
+ $O/compute_area.mpi.o \
+ $O/create_addressing.o \
+ $O/create_meshes.mpi.o \
+ $O/finalize_mesher.mpi.o \
+ $O/initialize_mesher.mpi.o \
+ $O/meshfem3D.mpi.o \
+ $O/setup_counters.o \
+ $O/setup_model.o \
+ $(EMPTY_MACRO)
LIBSPECFEM_MESHER = $O/libspecfem_mesher.a
@@ -192,7 +210,7 @@
####
# rules for the main programs
-XMESHFEM_OBJECTS = $O/meshfem3D_models.o $O/meshfem3D.o $O/exit_mpi.o $(LIBSPECFEM_MESHER)
+XMESHFEM_OBJECTS = $(MESHER_ARRAY_OBJECTS) $O/exit_mpi.sharedmpi.o $(LIBSPECFEM_MESHER)
xmeshfem3D: $(XMESHFEM_OBJECTS)
## use MPI here
@@ -224,288 +242,25 @@
##
## shared
##
-$O/auto_ner.o: ${SETUP}/constants.h ${SHARED}/auto_ner.f90
- ${FCCOMPILE_CHECK} -c -o $O/auto_ner.o ${FCFLAGS_f90} ${SHARED}/auto_ner.f90
+$O/%.shared.o: ${SHARED}/%.f90 ${SETUP}/constants.h
+ ${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-$O/broadcast_compute_parameters.o: ${SETUP}/constants.h ${SHARED}/broadcast_compute_parameters.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/broadcast_compute_parameters.o ${FCFLAGS_f90} ${SHARED}/broadcast_compute_parameters.f90
+$O/%.sharedmpi.o: ${SHARED}/%.f90 ${SETUP}/constants.h
+ ${MPIFCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-$O/calendar.o: ${SHARED}/calendar.f90
- ${FCCOMPILE_CHECK} -c -o $O/calendar.o ${FCFLAGS_f90} ${SHARED}/calendar.f90
+$O/%.cc.o: ${SHARED}/%.c ${SETUP}/config.h
+ ${CC} -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
-$O/count_number_of_sources.o: ${SETUP}/constants.h ${SHARED}/count_number_of_sources.f90
- ${FCCOMPILE_CHECK} -c -o $O/count_number_of_sources.o ${FCFLAGS_f90} ${SHARED}/count_number_of_sources.f90
-$O/create_name_database.o: ${SETUP}/constants.h ${SHARED}/create_name_database.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_name_database.o ${FCFLAGS_f90} ${SHARED}/create_name_database.f90
+#######################################
-$O/create_serial_name_database.o: ${SETUP}/constants.h ${SHARED}/create_serial_name_database.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_serial_name_database.o ${FCFLAGS_f90} ${SHARED}/create_serial_name_database.f90
-
-$O/euler_angles.o: ${SETUP}/constants.h ${SHARED}/euler_angles.f90
- ${FCCOMPILE_CHECK} -c -o $O/euler_angles.o ${FCFLAGS_f90} ${SHARED}/euler_angles.f90
-
-$O/exit_mpi.o: ${SETUP}/constants.h ${SHARED}/exit_mpi.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/exit_mpi.o ${FCFLAGS_f90} ${SHARED}/exit_mpi.f90
-
-$O/get_model_parameters.o: ${SETUP}/constants.h ${SHARED}/get_model_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_model_parameters.o ${FCFLAGS_f90} ${SHARED}/get_model_parameters.f90
-
-$O/get_value_parameters.o: ${SETUP}/constants.h ${SHARED}/get_value_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_value_parameters.o ${FCFLAGS_f90} ${SHARED}/get_value_parameters.f90
-
-$O/gll_library.o: ${SETUP}/constants.h ${SHARED}/gll_library.f90
- ${FCCOMPILE_CHECK} -c -o $O/gll_library.o ${FCFLAGS_f90} ${SHARED}/gll_library.f90
-
-$O/hex_nodes.o: ${SETUP}/constants.h ${SHARED}/hex_nodes.f90
- ${FCCOMPILE_CHECK} -c -o $O/hex_nodes.o ${FCFLAGS_f90} ${SHARED}/hex_nodes.f90
-
-$O/intgrl.o: ${SETUP}/constants.h ${SHARED}/intgrl.f90
- ${FCCOMPILE_CHECK} -c -o $O/intgrl.o ${FCFLAGS_f90} ${SHARED}/intgrl.f90
-
-$O/lagrange_poly.o: ${SETUP}/constants.h ${SHARED}/lagrange_poly.f90
- ${FCCOMPILE_CHECK} -c -o $O/lagrange_poly.o ${FCFLAGS_f90} ${SHARED}/lagrange_poly.f90
-
-$O/make_ellipticity.o: ${SETUP}/constants.h ${SHARED}/make_ellipticity.f90
- ${FCCOMPILE_CHECK} -c -o $O/make_ellipticity.o ${FCFLAGS_f90} ${SHARED}/make_ellipticity.f90
-
-$O/make_gravity.o: ${SETUP}/constants.h ${SHARED}/make_gravity.f90
- ${FCCOMPILE_CHECK} -c -o $O/make_gravity.o ${FCFLAGS_f90} ${SHARED}/make_gravity.f90
-
-$O/memory_eval.o: ${SETUP}/constants.h ${SHARED}/memory_eval.f90
- ${FCCOMPILE_CHECK} -c -o $O/memory_eval.o ${FCFLAGS_f90} ${SHARED}/memory_eval.f90
-
-$O/model_prem.o: ${SETUP}/constants.h ${SHARED}/model_prem.f90
- ${FCCOMPILE_CHECK} -c -o $O/model_prem.o ${FCFLAGS_f90} ${SHARED}/model_prem.f90
-
-$O/force_ftz.o: ${SHARED}/force_ftz.c ${SETUP}/config.h
- ${CC} -c $(CPPFLAGS) $(CFLAGS) -o $O/force_ftz.o ${SHARED}/force_ftz.c
-
-$O/param_reader.o: ${SHARED}/param_reader.c ${SETUP}/config.h
- ${CC} -c $(CPPFLAGS) $(CFLAGS) -o $O/param_reader.o ${SHARED}/param_reader.c
-
-$O/read_compute_parameters.o: ${SETUP}/constants.h ${SHARED}/read_compute_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/read_compute_parameters.o ${FCFLAGS_f90} ${SHARED}/read_compute_parameters.f90
-
-$O/read_parameter_file.o: ${SETUP}/constants.h ${SHARED}/read_parameter_file.f90
- ${FCCOMPILE_CHECK} -c -o $O/read_parameter_file.o ${FCFLAGS_f90} ${SHARED}/read_parameter_file.f90
-
-$O/read_value_parameters.o: ${SETUP}/constants.h ${SHARED}/read_value_parameters.f90
- ${FCCOMPILE_CHECK} -c -o $O/read_value_parameters.o ${FCFLAGS_f90} ${SHARED}/read_value_parameters.f90
-
-$O/reduce.o: ${SETUP}/constants.h ${SHARED}/reduce.f90
- ${FCCOMPILE_CHECK} -c -o $O/reduce.o ${FCFLAGS_f90} ${SHARED}/reduce.f90
-
-$O/rthetaphi_xyz.o: ${SETUP}/constants.h ${SHARED}/rthetaphi_xyz.f90
- ${FCCOMPILE_CHECK} -c -o $O/rthetaphi_xyz.o ${FCFLAGS_f90} ${SHARED}/rthetaphi_xyz.f90
-
-$O/save_header_file.o: ${SETUP}/constants.h ${SHARED}/save_header_file.f90
- ${FCCOMPILE_CHECK} -c -o $O/save_header_file.o ${FCFLAGS_f90} ${SHARED}/save_header_file.f90
-
-$O/spline_routines.o: ${SETUP}/constants.h ${SHARED}/spline_routines.f90
- ${FCCOMPILE_CHECK} -c -o $O/spline_routines.o ${FCFLAGS_f90} ${SHARED}/spline_routines.f90
-
-
-##
-## shared objects with mpi compilation
-##
-$O/model_topo_bathy.o: ${SETUP}/constants.h ${SHARED}/model_topo_bathy.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_topo_bathy.o ${FCFLAGS_f90} ${SHARED}/model_topo_bathy.f90
-
###
### meshfem3D objects
###
-$O/add_missing_nodes.o: ${SETUP}/constants.h $S/add_missing_nodes.f90
- ${FCCOMPILE_CHECK} -c -o $O/add_missing_nodes.o ${FCFLAGS_f90} $S/add_missing_nodes.f90
+$O/%.o: $S/%.f90 ${SETUP}/constants.h
+ ${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-$O/add_topography.o: ${SETUP}/constants.h $S/add_topography.f90
- ${FCCOMPILE_CHECK} -c -o $O/add_topography.o ${FCFLAGS_f90} $S/add_topography.f90
+$O/%.mpi.o: $S/%.f90 ${SETUP}/constants.h
+ ${MPIFCCOMPILE_NO_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-$O/add_topography_410_650.o: ${SETUP}/constants.h $S/add_topography_410_650.f90
- ${FCCOMPILE_CHECK} -c -o $O/add_topography_410_650.o ${FCFLAGS_f90} $S/add_topography_410_650.f90
-
-$O/add_topography_cmb.o: ${SETUP}/constants.h $S/add_topography_cmb.f90
- ${FCCOMPILE_CHECK} -c -o $O/add_topography_cmb.o ${FCFLAGS_f90} $S/add_topography_cmb.f90
-
-$O/add_topography_icb.o: ${SETUP}/constants.h $S/add_topography_icb.f90
- ${FCCOMPILE_CHECK} -c -o $O/add_topography_icb.o ${FCFLAGS_f90} $S/add_topography_icb.f90
-
-$O/calc_jacobian.o: ${SETUP}/constants.h $S/calc_jacobian.f90
- ${FCCOMPILE_CHECK} -c -o $O/calc_jacobian.o ${FCFLAGS_f90} $S/calc_jacobian.f90
-
-$O/compute_coordinates_grid.o: ${SETUP}/constants.h $S/compute_coordinates_grid.f90
- ${FCCOMPILE_CHECK} -c -o $O/compute_coordinates_grid.o ${FCFLAGS_f90} $S/compute_coordinates_grid.f90
-
-$O/compute_element_properties.o: ${SETUP}/constants.h $S/compute_element_properties.f90
- ${FCCOMPILE_CHECK} -c -o $O/compute_element_properties.o ${FCFLAGS_f90} $S/compute_element_properties.f90
-
-$O/create_central_cube.o: ${SETUP}/constants.h $S/create_central_cube.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_central_cube.o ${FCFLAGS_f90} $S/create_central_cube.f90
-
-$O/create_doubling_elements.o: ${SETUP}/constants.h $S/create_doubling_elements.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_doubling_elements.o ${FCFLAGS_f90} $S/create_doubling_elements.f90
-
-$O/create_mass_matrices.o: ${SETUP}/constants.h $S/create_mass_matrices.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_mass_matrices.o ${FCFLAGS_f90} $S/create_mass_matrices.f90
-
-$O/create_regions_mesh.o: ${SETUP}/constants.h $S/create_regions_mesh.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/create_regions_mesh.o ${FCFLAGS_f90} $S/create_regions_mesh.f90
-
-$O/get_perm_color.o: ${SETUP}/constants.h $S/get_perm_color.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_perm_color.o ${FCFLAGS_f90} $S/get_perm_color.f90
-
-$O/create_regular_elements.o: ${SETUP}/constants.h $S/create_regular_elements.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_regular_elements.o ${FCFLAGS_f90} $S/create_regular_elements.f90
-
-$O/define_superbrick.o: ${SETUP}/constants.h $S/define_superbrick.f90
- ${FCCOMPILE_CHECK} -c -o $O/define_superbrick.o ${FCFLAGS_f90} $S/define_superbrick.f90
-
-$O/get_absorb.o: ${SETUP}/constants.h $S/get_absorb.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_absorb.o ${FCFLAGS_f90} $S/get_absorb.f90
-
-$O/get_ellipticity.o: ${SETUP}/constants.h $S/get_ellipticity.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_ellipticity.o ${FCFLAGS_f90} $S/get_ellipticity.f90
-
-$O/get_global.o: ${SETUP}/constants.h $S/get_global.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_global.o ${FCFLAGS_f90} $S/get_global.f90
-
-$O/get_jacobian_boundaries.o: ${SETUP}/constants.h $S/get_jacobian_boundaries.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_jacobian_boundaries.o ${FCFLAGS_f90} $S/get_jacobian_boundaries.f90
-
-$O/get_jacobian_discontinuities.o: ${SETUP}/constants.h $S/get_jacobian_discontinuities.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_jacobian_discontinuities.o ${FCFLAGS_f90} $S/get_jacobian_discontinuities.f90
-
-$O/get_model.o: ${SETUP}/constants.h $S/get_model.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_model.o ${FCFLAGS_f90} $S/get_model.f90
-
-$O/get_MPI_1D_buffers.o: ${SETUP}/constants.h $S/get_MPI_1D_buffers.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_MPI_1D_buffers.o ${FCFLAGS_f90} $S/get_MPI_1D_buffers.f90
-
-$O/get_MPI_cutplanes_xi.o: ${SETUP}/constants.h $S/get_MPI_cutplanes_xi.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_MPI_cutplanes_xi.o ${FCFLAGS_f90} $S/get_MPI_cutplanes_xi.f90
-
-$O/get_MPI_cutplanes_eta.o: ${SETUP}/constants.h $S/get_MPI_cutplanes_eta.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_MPI_cutplanes_eta.o ${FCFLAGS_f90} $S/get_MPI_cutplanes_eta.f90
-
-$O/get_shape2D.o: ${SETUP}/constants.h $S/get_shape2D.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_shape2D.o ${FCFLAGS_f90} $S/get_shape2D.f90
-
-$O/get_shape3D.o: ${SETUP}/constants.h $S/get_shape3D.f90
- ${FCCOMPILE_CHECK} -c -o $O/get_shape3D.o ${FCFLAGS_f90} $S/get_shape3D.f90
-
-$O/lgndr.o: ${SETUP}/constants.h $S/lgndr.f90
- ${FCCOMPILE_CHECK} -c -o $O/lgndr.o ${FCFLAGS_f90} $S/lgndr.f90
-
-$O/model_iasp91.o: ${SETUP}/constants.h $S/model_iasp91.f90
- ${FCCOMPILE_CHECK} -c -o $O/model_iasp91.o ${FCFLAGS_f90} $S/model_iasp91.f90
-
-$O/model_1066a.o: ${SETUP}/constants.h $S/model_1066a.f90
- ${FCCOMPILE_CHECK} -c -o $O/model_1066a.o ${FCFLAGS_f90} $S/model_1066a.f90
-
-$O/model_ak135.o: ${SETUP}/constants.h $S/model_ak135.f90
- ${FCCOMPILE_CHECK} -c -o $O/model_ak135.o ${FCFLAGS_f90} $S/model_ak135.f90
-
-$O/model_aniso_inner_core.o: ${SETUP}/constants.h $S/model_aniso_inner_core.f90
- ${FCCOMPILE_CHECK} -c -o $O/model_aniso_inner_core.o ${FCFLAGS_f90} $S/model_aniso_inner_core.f90
-
-$O/model_1dref.o: ${SETUP}/constants.h $S/model_1dref.f90
- ${FCCOMPILE_CHECK} -c -o $O/model_1dref.o ${FCFLAGS_f90} $S/model_1dref.f90
-
-$O/model_jp1d.o: ${SETUP}/constants.h $S/model_jp1d.f90
- ${FCCOMPILE_CHECK} -c -o $O/model_jp1d.o ${FCFLAGS_f90} $S/model_jp1d.f90
-
-$O/model_sea1d.o: ${SETUP}/constants.h $S/model_sea1d.f90
- ${FCCOMPILE_CHECK} -c -o $O/model_sea1d.o ${FCFLAGS_f90} $S/model_sea1d.f90
-
-$O/moho_stretching.o: ${SETUP}/constants.h $S/moho_stretching.f90
- ${FCCOMPILE_CHECK} -c -o $O/moho_stretching.o ${FCFLAGS_f90} $S/moho_stretching.f90
-
-$O/netlib_specfun_erf.o: $S/netlib_specfun_erf.f90
- ${FCCOMPILE_CHECK} -c -o $O/netlib_specfun_erf.o ${FCFLAGS_f90} $S/netlib_specfun_erf.f90
-
-$O/recompute_jacobian.o: ${SETUP}/constants.h $S/recompute_jacobian.f90
- ${FCCOMPILE_CHECK} -c -o $O/recompute_jacobian.o ${FCFLAGS_f90} $S/recompute_jacobian.f90
-
-$O/save_arrays_solver.o: ${SETUP}/constants.h $S/save_arrays_solver.f90
- ${FCCOMPILE_CHECK} -c -o $O/save_arrays_solver.o ${FCFLAGS_f90} $S/save_arrays_solver.f90
-
-$O/sort_array_coordinates.o: ${SETUP}/constants.h $S/sort_array_coordinates.f90
- ${FCCOMPILE_CHECK} -c -o $O/sort_array_coordinates.o ${FCFLAGS_f90} $S/sort_array_coordinates.f90
-
-$O/stretching_function.o: ${SETUP}/constants.h $S/stretching_function.f90
- ${FCCOMPILE_CHECK} -c -o $O/stretching_function.o ${FCFLAGS_f90} $S/stretching_function.f90
-
-$O/write_AVS_DX_global_faces_data.o: ${SETUP}/constants.h $S/write_AVS_DX_global_faces_data.f90
- ${FCCOMPILE_CHECK} -c -o $O/write_AVS_DX_global_faces_data.o ${FCFLAGS_f90} $S/write_AVS_DX_global_faces_data.f90
-
-$O/write_AVS_DX_global_chunks_data.o: ${SETUP}/constants.h $S/write_AVS_DX_global_chunks_data.f90
- ${FCCOMPILE_CHECK} -c -o $O/write_AVS_DX_global_chunks_data.o ${FCFLAGS_f90} $S/write_AVS_DX_global_chunks_data.f90
-
-$O/write_AVS_DX_surface_data.o: ${SETUP}/constants.h $S/write_AVS_DX_surface_data.f90
- ${FCCOMPILE_CHECK} -c -o $O/write_AVS_DX_surface_data.o ${FCFLAGS_f90} $S/write_AVS_DX_surface_data.f90
-
-$O/write_AVS_DX_global_data.o: ${SETUP}/constants.h $S/write_AVS_DX_global_data.f90
- ${FCCOMPILE_CHECK} -c -o $O/write_AVS_DX_global_data.o ${FCFLAGS_f90} $S/write_AVS_DX_global_data.f90
-
-##
-## meshfem3D objects with mpi compilation
-##
-$O/create_chunk_buffers.o: ${SETUP}/constants.h $S/create_chunk_buffers.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/create_chunk_buffers.o ${FCFLAGS_f90} $S/create_chunk_buffers.f90
-
-$O/meshfem3D.o: ${SETUP}/constants.h $S/meshfem3D.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/meshfem3D.o ${FCFLAGS_f90} $S/meshfem3D.f90
-
-$O/meshfem3D_models.o: ${SETUP}/constants.h $S/meshfem3D_models.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/meshfem3D_models.o ${FCFLAGS_f90} $S/meshfem3D_models.f90
-
-$O/model_aniso_mantle.o: ${SETUP}/constants.h $S/model_aniso_mantle.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_aniso_mantle.o ${FCFLAGS_f90} $S/model_aniso_mantle.f90
-
-$O/model_atten3D_QRFSI12.o: ${SETUP}/constants.h $S/model_atten3D_QRFSI12.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_atten3D_QRFSI12.o ${FCFLAGS_f90} $S/model_atten3D_QRFSI12.f90
-
-$O/model_attenuation.o: ${SETUP}/constants.h $S/model_attenuation.f90 $O/model_ak135.o $O/model_1066a.o $O/model_1dref.o
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_attenuation.o ${FCFLAGS_f90} $S/model_attenuation.f90
-
-$O/model_crust.o: ${SETUP}/constants.h $S/model_crust.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_crust.o ${FCFLAGS_f90} $S/model_crust.f90
-
-$O/model_eucrust.o: ${SETUP}/constants.h $S/model_eucrust.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_eucrust.o ${FCFLAGS_f90} $S/model_eucrust.f90
-
-$O/model_epcrust.o: ${SETUP}/constants.h $S/model_epcrust.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_epcrust.o ${FCFLAGS_f90} $S/model_epcrust.f90
-
-$O/model_crustmaps.o: ${SETUP}/constants.h $S/model_crustmaps.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_crustmaps.o ${FCFLAGS_f90} $S/model_crustmaps.f90
-
-$O/model_gll.o: ${SETUP}/constants.h $S/model_gll.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_gll.o ${FCFLAGS_f90} $S/model_gll.f90
-
-$O/model_heterogen_mantle.o: ${SETUP}/constants.h $S/model_heterogen_mantle.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_heterogen_mantle.o ${FCFLAGS_f90} $S/model_heterogen_mantle.f90
-
-$O/model_jp3d.o: ${SETUP}/constants.h $S/model_jp3d.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_jp3d.o ${FCFLAGS_f90} $S/model_jp3d.f90
-
-$O/model_ppm.o: ${SETUP}/constants.h $S/model_ppm.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_ppm.o ${FCFLAGS_f90} $S/model_ppm.f90
-
-$O/model_gapp2.o: ${SETUP}/constants.h $S/model_gapp2.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_gapp2.o ${FCFLAGS_f90} $S/model_gapp2.f90
-
-$O/model_s20rts.o: ${SETUP}/constants.h $S/model_s20rts.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_s20rts.o ${FCFLAGS_f90} $S/model_s20rts.f90
-
-$O/model_s40rts.o: ${SETUP}/constants.h $S/model_s40rts.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_s40rts.o ${FCFLAGS_f90} $S/model_s40rts.f90
-
-$O/model_s362ani.o: ${SETUP}/constants.h $S/model_s362ani.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_s362ani.o ${FCFLAGS_f90} $S/model_s362ani.f90
-
-$O/model_sea99_s.o: ${SETUP}/constants.h $S/model_sea99_s.f90
- ${MPIFCCOMPILE_CHECK} -c -o $O/model_sea99_s.o ${FCFLAGS_f90} $S/model_sea99_s.f90
-
-
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/compute_area.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/compute_area.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/compute_area.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,104 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+
+ subroutine compute_area(myrank,NCHUNKS,iregion_code, &
+ area_local_bottom,area_local_top,&
+ volume_local,volume_total, &
+ RCMB,RICB,R_CENTRAL_CUBE)
+
+ use meshfem3D_models_par
+
+ implicit none
+
+ include 'mpif.h'
+
+ integer :: myrank,NCHUNKS,iregion_code
+
+ double precision :: area_local_bottom,area_local_top,volume_local
+ double precision :: volume_total
+ double precision :: RCMB,RICB,R_CENTRAL_CUBE
+
+ ! local parameters
+ double precision :: volume_total_region,area_total_bottom,area_total_top
+ integer :: ier
+
+ ! use MPI reduction to compute total area and volume
+ volume_total_region = ZERO
+ area_total_bottom = ZERO
+ area_total_top = ZERO
+ call MPI_REDUCE(area_local_bottom,area_total_bottom,1,MPI_DOUBLE_PRECISION,MPI_SUM,0, &
+ MPI_COMM_WORLD,ier)
+ call MPI_REDUCE(area_local_top,area_total_top,1,MPI_DOUBLE_PRECISION,MPI_SUM,0, &
+ MPI_COMM_WORLD,ier)
+ call MPI_REDUCE(volume_local,volume_total_region,1,MPI_DOUBLE_PRECISION,MPI_SUM,0, &
+ MPI_COMM_WORLD,ier)
+
+ if(myrank == 0) then
+ ! sum volume over all the regions
+ volume_total = volume_total + volume_total_region
+
+ ! check volume of chunk, and bottom and top area
+ write(IMAIN,*)
+ write(IMAIN,*) ' calculated top area: ',area_total_top
+
+ ! compare to exact theoretical value
+ if(NCHUNKS == 6 .and. .not. TOPOGRAPHY) then
+ select case(iregion_code)
+ case(IREGION_CRUST_MANTLE)
+ write(IMAIN,*) ' exact area: ',dble(NCHUNKS)*(4.0d0/6.0d0)*PI*R_UNIT_SPHERE**2
+ case(IREGION_OUTER_CORE)
+ write(IMAIN,*) ' exact area: ',dble(NCHUNKS)*(4.0d0/6.0d0)*PI*(RCMB/R_EARTH)**2
+ case(IREGION_INNER_CORE)
+ write(IMAIN,*) ' exact area: ',dble(NCHUNKS)*(4.0d0/6.0d0)*PI*(RICB/R_EARTH)**2
+ case default
+ call exit_MPI(myrank,'incorrect region code')
+ end select
+ endif
+
+ write(IMAIN,*)
+ write(IMAIN,*) 'calculated bottom area: ',area_total_bottom
+
+ ! compare to exact theoretical value
+ if(NCHUNKS == 6 .and. .not. TOPOGRAPHY) then
+ select case(iregion_code)
+ case(IREGION_CRUST_MANTLE)
+ write(IMAIN,*) ' exact area: ',dble(NCHUNKS)*(4.0d0/6.0d0)*PI*(RCMB/R_EARTH)**2
+ case(IREGION_OUTER_CORE)
+ write(IMAIN,*) ' exact area: ',dble(NCHUNKS)*(4.0d0/6.0d0)*PI*(RICB/R_EARTH)**2
+ case(IREGION_INNER_CORE)
+ write(IMAIN,*) ' similar area (central cube): ',dble(NCHUNKS)*(2.*(R_CENTRAL_CUBE / R_EARTH)/sqrt(3.))**2
+ case default
+ call exit_MPI(myrank,'incorrect region code')
+ end select
+ endif
+
+ endif
+
+
+ end subroutine compute_area
+
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/compute_volumes.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/compute_volumes.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/compute_volumes.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,111 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+
+ subroutine compute_volumes(volume_local,area_local_bottom,area_local_top, &
+ nspec,wxgll,wygll,wzgll,xixstore,xiystore,xizstore, &
+ etaxstore,etaystore,etazstore,gammaxstore,gammaystore,gammazstore, &
+ NSPEC2D_BOTTOM,jacobian2D_bottom,NSPEC2D_TOP,jacobian2D_top)
+
+ implicit none
+
+ include "constants.h"
+
+ double precision :: volume_local,area_local_bottom,area_local_top
+
+ integer :: nspec
+ double precision :: wxgll(NGLLX),wygll(NGLLY),wzgll(NGLLZ)
+
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,nspec) :: &
+ xixstore,xiystore,xizstore,etaxstore,etaystore,etazstore,gammaxstore,gammaystore,gammazstore
+
+ integer :: NSPEC2D_BOTTOM,NSPEC2D_TOP
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_BOTTOM) :: jacobian2D_bottom
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_TOP) :: jacobian2D_top
+
+ ! local parameters
+ double precision :: weight
+ real(kind=CUSTOM_REAL) :: xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl,jacobianl
+ integer :: i,j,k,ispec
+
+ ! initializes
+ volume_local = ZERO
+ area_local_bottom = ZERO
+ area_local_top = ZERO
+
+ ! calculates volume of all elements in mesh
+ do ispec = 1,nspec
+ do k = 1,NGLLZ
+ do j = 1,NGLLY
+ do i = 1,NGLLX
+
+ weight = wxgll(i)*wygll(j)*wzgll(k)
+
+ ! compute the jacobian
+ xixl = xixstore(i,j,k,ispec)
+ xiyl = xiystore(i,j,k,ispec)
+ xizl = xizstore(i,j,k,ispec)
+ etaxl = etaxstore(i,j,k,ispec)
+ etayl = etaystore(i,j,k,ispec)
+ etazl = etazstore(i,j,k,ispec)
+ gammaxl = gammaxstore(i,j,k,ispec)
+ gammayl = gammaystore(i,j,k,ispec)
+ gammazl = gammazstore(i,j,k,ispec)
+
+ jacobianl = 1._CUSTOM_REAL / (xixl*(etayl*gammazl-etazl*gammayl) &
+ - xiyl*(etaxl*gammazl-etazl*gammaxl) &
+ + xizl*(etaxl*gammayl-etayl*gammaxl))
+
+ volume_local = volume_local + dble(jacobianl)*weight
+
+ enddo
+ enddo
+ enddo
+ enddo
+
+ ! area of bottom surface
+ do ispec = 1,NSPEC2D_BOTTOM
+ do i=1,NGLLX
+ do j=1,NGLLY
+ weight=wxgll(i)*wygll(j)
+ area_local_bottom = area_local_bottom + dble(jacobian2D_bottom(i,j,ispec))*weight
+ enddo
+ enddo
+ enddo
+
+ ! area of top surface
+ do ispec = 1,NSPEC2D_TOP
+ do i=1,NGLLX
+ do j=1,NGLLY
+ weight=wxgll(i)*wygll(j)
+ area_local_top = area_local_top + dble(jacobian2D_top(i,j,ispec))*weight
+ enddo
+ enddo
+ enddo
+
+ end subroutine compute_volumes
+
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_addressing.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_addressing.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_addressing.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,76 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+
+ subroutine create_addressing(myrank,NCHUNKS,NPROC,NPROC_ETA,NPROC_XI,NPROCTOT, &
+ addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice, &
+ OUTPUT_FILES)
+
+ implicit none
+
+ include "constants.h"
+
+ integer :: myrank,NCHUNKS,NPROC,NPROC_ETA,NPROC_XI,NPROCTOT
+
+ integer, dimension(NCHUNKS,0:NPROC_XI-1,0:NPROC_ETA-1) :: addressing
+ integer, dimension(0:NPROCTOT-1) :: ichunk_slice,iproc_xi_slice,iproc_eta_slice
+
+ character(len=150) OUTPUT_FILES
+
+ ! local parameters
+ integer ichunk,iproc_eta,iproc_xi,iprocnum,ier
+
+ ! initializes
+ addressing(:,:,:) = 0
+ ichunk_slice(:) = 0
+ iproc_xi_slice(:) = 0
+ iproc_eta_slice(:) = 0
+
+ ! loop on all the chunks to create global slice addressing for solver
+ if(myrank == 0) then
+ open(unit=IOUT,file=trim(OUTPUT_FILES)//'/addressing.txt',status='unknown',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening addressing.txt')
+ write(IMAIN,*) 'creating global slice addressing'
+ write(IMAIN,*)
+ endif
+
+ do ichunk = 1,NCHUNKS
+ do iproc_eta=0,NPROC_ETA-1
+ do iproc_xi=0,NPROC_XI-1
+ iprocnum = (ichunk-1)*NPROC + iproc_eta * NPROC_XI + iproc_xi
+ addressing(ichunk,iproc_xi,iproc_eta) = iprocnum
+ ichunk_slice(iprocnum) = ichunk
+ iproc_xi_slice(iprocnum) = iproc_xi
+ iproc_eta_slice(iprocnum) = iproc_eta
+ if(myrank == 0) write(IOUT,*) iprocnum,ichunk,iproc_xi,iproc_eta
+ enddo
+ enddo
+ enddo
+
+ if(myrank == 0) close(IOUT)
+
+ end subroutine create_addressing
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_central_cube.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_central_cube.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_central_cube.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -232,7 +232,7 @@
! determine where we cut the central cube to share it between CHUNK_AB & CHUNK_AB_ANTIPODE
! in the case of mod(NPROC_XI,2)/=0, the cut is asymetric and the bigger part is for CHUNK_AB
- if (mod(NPROC_XI,2)/=0) then
+ if (mod(NPROC_XI,2)/=0 .and. NPROC_XI > 1) then
if (ichunk == CHUNK_AB) then
nz_inf_limit = ((nz_central_cube*2)/NPROC_XI)*floor(NPROC_XI/2.d0)
elseif (ichunk == CHUNK_AB_ANTIPODE) then
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_meshes.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_meshes.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_meshes.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,157 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+ subroutine create_meshes()
+
+ use meshfem3D_par
+ implicit none
+
+ ! get addressing for this process
+ ichunk = ichunk_slice(myrank)
+ iproc_xi = iproc_xi_slice(myrank)
+ iproc_eta = iproc_eta_slice(myrank)
+
+ ! volume of the slice
+ volume_total = ZERO
+
+ ! make sure everybody is synchronized
+ call sync_all()
+
+ !----
+ !---- loop on all the regions of the mesh
+ !----
+
+ ! number of regions in full Earth
+ do iregion_code = 1,MAX_NUM_REGIONS
+
+ if(myrank == 0) then
+ write(IMAIN,*)
+ write(IMAIN,*) '*******************************************'
+ write(IMAIN,*) 'creating mesh in region ',iregion_code
+ select case(iregion_code)
+ case(IREGION_CRUST_MANTLE)
+ write(IMAIN,*) 'this region is the crust and mantle'
+ case(IREGION_OUTER_CORE)
+ write(IMAIN,*) 'this region is the outer core'
+ case(IREGION_INNER_CORE)
+ write(IMAIN,*) 'this region is the inner core'
+ case default
+ call exit_MPI(myrank,'incorrect region code')
+ end select
+ write(IMAIN,*) '*******************************************'
+ write(IMAIN,*)
+ endif
+
+ ! compute maximum number of points
+ npointot = NSPEC(iregion_code) * NGLLX * NGLLY * NGLLZ
+
+ ! use dynamic allocation to allocate memory for arrays
+ allocate(idoubling(NSPEC(iregion_code)))
+ allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)))
+ allocate(xstore(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)))
+ allocate(ystore(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)))
+ allocate(zstore(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)))
+
+ ! this for non blocking MPI
+ allocate(is_on_a_slice_edge(NSPEC(iregion_code)))
+
+ ! create all the regions of the mesh
+ ! perform two passes in this part to be able to save memory
+ do ipass = 1,2
+ call create_regions_mesh(iregion_code,ibool,idoubling,is_on_a_slice_edge, &
+ xstore,ystore,zstore,rmins,rmaxs, &
+ iproc_xi,iproc_eta,ichunk,NSPEC(iregion_code),nspec_tiso, &
+ volume_local,area_local_bottom,area_local_top, &
+ nglob(iregion_code),npointot, &
+ NSTEP,DT, &
+ NEX_XI,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
+ NSPEC2DMAX_XMIN_XMAX(iregion_code),NSPEC2DMAX_YMIN_YMAX(iregion_code), &
+ NSPEC2D_BOTTOM(iregion_code),NSPEC2D_TOP(iregion_code), &
+ NPROC_XI,NPROC_ETA,NSPEC2D_XI_FACE, &
+ NSPEC2D_ETA_FACE,NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER, &
+ myrank,LOCAL_PATH,rotation_matrix,ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD, &
+ SAVE_MESH_FILES,NCHUNKS,INCLUDE_CENTRAL_CUBE,ABSORBING_CONDITIONS, &
+ R_CENTRAL_CUBE,RICB,RHO_OCEANS,RCMB,R670,RMOHO,RMOHO_FICTITIOUS_IN_MESHER,&
+ RTOPDDOUBLEPRIME,R600,R220,R771,R400,R120,R80,RMIDDLE_CRUST,ROCEAN, &
+ ner,ratio_sampling_array,doubling_index,r_bottom,r_top,&
+ this_region_has_a_doubling,ratio_divide_central_cube, &
+ CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, &
+ mod(iproc_xi_slice(myrank),2),mod(iproc_eta_slice(myrank),2), &
+ ipass)
+ enddo
+
+ ! checks number of anisotropic elements found in the mantle
+ if(iregion_code /= IREGION_CRUST_MANTLE .and. nspec_tiso /= 0 ) &
+ call exit_MPI(myrank,'found anisotropic elements outside of the mantle')
+
+ if( TRANSVERSE_ISOTROPY ) then
+ if(iregion_code == IREGION_CRUST_MANTLE .and. nspec_tiso == 0) &
+ call exit_MPI(myrank,'found no anisotropic elements in the mantle')
+ endif
+
+ ! computes total area and volume
+ call compute_area(myrank,NCHUNKS,iregion_code, &
+ area_local_bottom,area_local_top,&
+ volume_local,volume_total, &
+ RCMB,RICB,R_CENTRAL_CUBE)
+
+ ! create chunk buffers if more than one chunk
+ if(NCHUNKS > 1) then
+ call create_chunk_buffers(iregion_code,NSPEC(iregion_code),ibool,idoubling, &
+ xstore,ystore,zstore, &
+ nglob(iregion_code), &
+ NSPEC2DMAX_XMIN_XMAX(iregion_code),NSPEC2DMAX_YMIN_YMAX(iregion_code), &
+ NPROC_XI,NPROC_ETA,NPROC,NPROCTOT, &
+ NGLOB1D_RADIAL_CORNER,maxval(NGLOB1D_RADIAL_CORNER(iregion_code,:)), &
+ NGLOB2DMAX_XMIN_XMAX(iregion_code),NGLOB2DMAX_YMIN_YMAX(iregion_code), &
+ myrank,LOCAL_PATH,addressing, &
+ ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS)
+ else
+ if(myrank == 0) then
+ write(IMAIN,*)
+ write(IMAIN,*) 'only one chunk, no need to create chunk buffers'
+ write(IMAIN,*)
+ endif
+ endif
+
+ ! deallocate arrays used for that region
+ deallocate(idoubling)
+ deallocate(ibool)
+ deallocate(xstore)
+ deallocate(ystore)
+ deallocate(zstore)
+
+ ! this for non blocking MPI
+ deallocate(is_on_a_slice_edge)
+
+ ! make sure everybody is synchronized
+ call sync_all()
+
+ ! end of loop on all the regions
+ enddo
+
+ end subroutine create_meshes
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_regions_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_regions_mesh.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/create_regions_mesh.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -41,8 +41,10 @@
R_CENTRAL_CUBE,RICB,RHO_OCEANS,RCMB,R670,RMOHO,RMOHO_FICTITIOUS_IN_MESHER,&
RTOPDDOUBLEPRIME,R600,R220,R771,R400,R120,R80,RMIDDLE_CRUST,ROCEAN, &
ner,ratio_sampling_array,doubling_index,r_bottom,r_top, &
- this_region_has_a_doubling,ipass,ratio_divide_central_cube, &
- CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA,offset_proc_xi,offset_proc_eta)
+ this_region_has_a_doubling,ratio_divide_central_cube, &
+ CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, &
+ offset_proc_xi,offset_proc_eta, &
+ ipass)
! creates the different regions of the mesh
@@ -263,6 +265,12 @@
! flags for transverse isotropic elements
logical, dimension(:), allocatable :: ispec_is_tiso
+ ! user output
+ if(myrank == 0 ) then
+ if(ipass == 1 ) write(IMAIN,*) 'first pass'
+ if(ipass == 2 ) write(IMAIN,*) 'second pass'
+ endif
+
! create the name for the database of the current slide and region
call create_name_database(prname,myrank,iregion_code,LOCAL_PATH)
@@ -450,7 +458,7 @@
if(ier /= 0) stop 'error in allocate 17'
! initialize number of layers
- call crm_initialize_layers(myrank,ipass,xigll,yigll,zigll,wxgll,wygll,wzgll, &
+ call initialize_layers(myrank,ipass,xigll,yigll,zigll,wxgll,wygll,wzgll, &
shape3D,dershape3D,shape2D_x,shape2D_y,shape2D_bottom,shape2D_top, &
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
iaddx,iaddy,iaddz,nspec,xstore,ystore,zstore,ibool,idoubling, &
@@ -518,6 +526,10 @@
ilayer = perm_layer(ilayer_loop)
+ ! user output
+ if(myrank == 0 ) write(IMAIN,*) ' creating layer ',ilayer_loop-ifirst_region+1, &
+ 'out of ',ilast_region-ifirst_region+1
+
! determine the radii that define the shell
rmin = rmins(ilayer)
rmax = rmaxs(ilayer)
@@ -611,7 +623,10 @@
enddo !ilayer_loop
! define central cube in inner core
- if(INCLUDE_CENTRAL_CUBE .and. iregion_code == IREGION_INNER_CORE) &
+ if(INCLUDE_CENTRAL_CUBE .and. iregion_code == IREGION_INNER_CORE) then
+ ! user output
+ if(myrank == 0 ) write(IMAIN,*) ' creating central cube'
+
call create_central_cube(myrank,ichunk,ispec,iaddx,iaddy,iaddz, &
nspec,NEX_XI,NEX_PER_PROC_XI,NEX_PER_PROC_ETA,R_CENTRAL_CUBE, &
iproc_xi,iproc_eta,NPROC_XI,NPROC_ETA,ratio_divide_central_cube, &
@@ -629,8 +644,8 @@
nspec_ani,nspec_stacey,nspec_att,Qmu_store,tau_e_store,tau_s,T_c_source,&
rho_vp,rho_vs,ABSORBING_CONDITIONS,ACTUALLY_STORE_ARRAYS,xigll,yigll,zigll, &
ispec_is_tiso)
+ endif
-
! check total number of spectral elements created
if(ispec /= nspec) call exit_MPI(myrank,'ispec should equal nspec')
@@ -649,7 +664,10 @@
where(idoubling == IFLAG_IN_FICTITIOUS_CUBE) is_on_a_slice_edge = .false.
! only create global addressing and the MPI buffers in the first pass
- if(ipass == 1) then
+ select case(ipass)
+ case( 1 )
+ ! user output
+ if(myrank == 0 ) write(IMAIN,*) ' creating global addressing'
!uncomment: adds model smoothing for point profile models
! if( THREE_D_MODEL == THREE_D_MODEL_PPM ) then
@@ -769,8 +787,10 @@
deallocate(locval,stat=ier); if(ier /= 0) stop 'error in deallocate'
deallocate(ifseg,stat=ier); if(ier /= 0) stop 'error in deallocate'
-! only create mass matrix and save all the final arrays in the second pass
- else if(ipass == 2) then
+ ! only create mass matrix and save all the final arrays in the second pass
+ case( 2 )
+ ! user output
+ if(myrank == 0 ) write(IMAIN,*) ' creating mass matrix'
! copy the theoretical number of points for the second pass
nglob = nglob_theor
@@ -781,201 +801,204 @@
!nspec_tiso = count(idoubling(1:nspec) == IFLAG_220_80) + count(idoubling(1:nspec) == IFLAG_80_MOHO)
nspec_tiso = count(ispec_is_tiso(:))
-!****************************************************************************************************
-! Mila
+ !****************************************************************************************************
+ ! Mila
- if(SORT_MESH_INNER_OUTER) then
+ if(SORT_MESH_INNER_OUTER) then
-!!!! David Michea: detection of the edges, coloring and permutation separately
- allocate(perm(nspec))
+ !!!! David Michea: detection of the edges, coloring and permutation separately
+ allocate(perm(nspec))
-! implement mesh coloring for GPUs if needed, to create subsets of disconnected elements
-! to remove dependencies and the need for atomic operations in the sum of elemental contributions in the solver
- if(USE_MESH_COLORING_GPU) then
+ ! implement mesh coloring for GPUs if needed, to create subsets of disconnected elements
+ ! to remove dependencies and the need for atomic operations in the sum of elemental contributions in the solver
+ if(USE_MESH_COLORING_GPU) then
- allocate(first_elem_number_in_this_color(MAX_NUMBER_OF_COLORS + 1))
+ ! user output
+ if(myrank == 0 ) write(IMAIN,*) ' creating mesh coloring'
- call get_perm_color_faster(is_on_a_slice_edge,ibool,perm,nspec,nglob, &
- nb_colors_outer_elements,nb_colors_inner_elements,nspec_outer,first_elem_number_in_this_color,myrank)
+ allocate(first_elem_number_in_this_color(MAX_NUMBER_OF_COLORS + 1))
-! for the last color, the next color is fictitious and its first (fictitious) element number is nspec + 1
- first_elem_number_in_this_color(nb_colors_outer_elements + nb_colors_inner_elements + 1) = nspec + 1
+ call get_perm_color_faster(is_on_a_slice_edge,ibool,perm,nspec,nglob, &
+ nb_colors_outer_elements,nb_colors_inner_elements,nspec_outer,first_elem_number_in_this_color,myrank)
- allocate(num_of_elems_in_this_color(nb_colors_outer_elements + nb_colors_inner_elements))
+ ! for the last color, the next color is fictitious and its first (fictitious) element number is nspec + 1
+ first_elem_number_in_this_color(nb_colors_outer_elements + nb_colors_inner_elements + 1) = nspec + 1
-! save mesh coloring
- open(unit=99,file=prname(1:len_trim(prname))//'num_of_elems_in_this_color.dat',status='unknown')
+ allocate(num_of_elems_in_this_color(nb_colors_outer_elements + nb_colors_inner_elements))
-! number of colors for outer elements
- write(99,*) nb_colors_outer_elements
+ ! save mesh coloring
+ open(unit=99,file=prname(1:len_trim(prname))//'num_of_elems_in_this_color.dat',status='unknown')
-! number of colors for inner elements
- write(99,*) nb_colors_inner_elements
+ ! number of colors for outer elements
+ write(99,*) nb_colors_outer_elements
-! number of elements in each color
- do icolor = 1, nb_colors_outer_elements + nb_colors_inner_elements
- num_of_elems_in_this_color(icolor) = first_elem_number_in_this_color(icolor+1) - first_elem_number_in_this_color(icolor)
- write(99,*) num_of_elems_in_this_color(icolor)
- enddo
- close(99)
+ ! number of colors for inner elements
+ write(99,*) nb_colors_inner_elements
-! check that the sum of all the numbers of elements found in each color is equal
-! to the total number of elements in the mesh
- if(sum(num_of_elems_in_this_color) /= nspec) then
- print *,'nspec = ',nspec
- print *,'total number of elements in all the colors of the mesh = ',sum(num_of_elems_in_this_color)
- stop 'incorrect total number of elements in all the colors of the mesh'
- endif
+ ! number of elements in each color
+ do icolor = 1, nb_colors_outer_elements + nb_colors_inner_elements
+ num_of_elems_in_this_color(icolor) = first_elem_number_in_this_color(icolor+1) &
+ - first_elem_number_in_this_color(icolor)
+ write(99,*) num_of_elems_in_this_color(icolor)
+ enddo
+ close(99)
-! check that the sum of all the numbers of elements found in each color for the outer elements is equal
-! to the total number of outer elements found in the mesh
- if(sum(num_of_elems_in_this_color(1:nb_colors_outer_elements)) /= nspec_outer) then
- print *,'nspec_outer = ',nspec_outer
- print *,'total number of elements in all the colors of the mesh for outer elements = ',sum(num_of_elems_in_this_color)
- stop 'incorrect total number of elements in all the colors of the mesh for outer elements'
- endif
+ ! check that the sum of all the numbers of elements found in each color is equal
+ ! to the total number of elements in the mesh
+ if(sum(num_of_elems_in_this_color) /= nspec) then
+ print *,'nspec = ',nspec
+ print *,'total number of elements in all the colors of the mesh = ',sum(num_of_elems_in_this_color)
+ stop 'incorrect total number of elements in all the colors of the mesh'
+ endif
- call MPI_ALLREDUCE(nspec_outer,nspec_outer_min_global,1,MPI_INTEGER,MPI_MIN,MPI_COMM_WORLD,ier)
- call MPI_ALLREDUCE(nspec_outer,nspec_outer_max_global,1,MPI_INTEGER,MPI_MAX,MPI_COMM_WORLD,ier)
+ ! check that the sum of all the numbers of elements found in each color for the outer elements is equal
+ ! to the total number of outer elements found in the mesh
+ if(sum(num_of_elems_in_this_color(1:nb_colors_outer_elements)) /= nspec_outer) then
+ print *,'nspec_outer = ',nspec_outer
+ print *,'total number of elements in all the colors of the mesh for outer elements = ', &
+ sum(num_of_elems_in_this_color)
+ stop 'incorrect total number of elements in all the colors of the mesh for outer elements'
+ endif
- deallocate(first_elem_number_in_this_color)
- deallocate(num_of_elems_in_this_color)
+ call MPI_ALLREDUCE(nspec_outer,nspec_outer_min_global,1,MPI_INTEGER,MPI_MIN,MPI_COMM_WORLD,ier)
+ call MPI_ALLREDUCE(nspec_outer,nspec_outer_max_global,1,MPI_INTEGER,MPI_MAX,MPI_COMM_WORLD,ier)
- else
+ deallocate(first_elem_number_in_this_color)
+ deallocate(num_of_elems_in_this_color)
-!! DK DK for regular C + MPI version for CPUs: do not use colors but nonetheless put all the outer elements
-!! DK DK first in order to be able to overlap non-blocking MPI communications with calculations
+ else
-!! DK DK nov 2010, for Rosa Badia / StarSs:
-!! no need for mesh coloring, but need to implement inner/outer subsets for non blocking MPI for StarSs
- ispec_counter = 0
- perm(:) = 0
+ !! DK DK for regular C + MPI version for CPUs: do not use colors but nonetheless put all the outer elements
+ !! DK DK first in order to be able to overlap non-blocking MPI communications with calculations
-! first generate all the outer elements
- do ispec = 1,nspec
- if(is_on_a_slice_edge(ispec)) then
- ispec_counter = ispec_counter + 1
- perm(ispec) = ispec_counter
- endif
- enddo
+ !! DK DK nov 2010, for Rosa Badia / StarSs:
+ !! no need for mesh coloring, but need to implement inner/outer subsets for non blocking MPI for StarSs
+ ispec_counter = 0
+ perm(:) = 0
-! make sure we have detected some outer elements
- if(ispec_counter <= 0) stop 'fatal error: no outer elements detected!'
+ ! first generate all the outer elements
+ do ispec = 1,nspec
+ if(is_on_a_slice_edge(ispec)) then
+ ispec_counter = ispec_counter + 1
+ perm(ispec) = ispec_counter
+ endif
+ enddo
-! store total number of outer elements
- nspec_outer = ispec_counter
+ ! make sure we have detected some outer elements
+ if(ispec_counter <= 0) stop 'fatal error: no outer elements detected!'
-! then generate all the inner elements
- do ispec = 1,nspec
- if(.not. is_on_a_slice_edge(ispec)) then
- ispec_counter = ispec_counter + 1
- perm(ispec) = ispec_counter
- endif
- enddo
+ ! store total number of outer elements
+ nspec_outer = ispec_counter
-! test that all the elements have been used once and only once
- if(ispec_counter /= nspec) stop 'fatal error: ispec_counter not equal to nspec'
+ ! then generate all the inner elements
+ do ispec = 1,nspec
+ if(.not. is_on_a_slice_edge(ispec)) then
+ ispec_counter = ispec_counter + 1
+ perm(ispec) = ispec_counter
+ endif
+ enddo
-! do basic checks
- if(minval(perm) /= 1) stop 'minval(perm) should be 1'
- if(maxval(perm) /= nspec) stop 'maxval(perm) should be nspec'
+ ! test that all the elements have been used once and only once
+ if(ispec_counter /= nspec) stop 'fatal error: ispec_counter not equal to nspec'
- call MPI_ALLREDUCE(nspec_outer,nspec_outer_min_global,1,MPI_INTEGER,MPI_MIN,MPI_COMM_WORLD,ier)
- call MPI_ALLREDUCE(nspec_outer,nspec_outer_max_global,1,MPI_INTEGER,MPI_MAX,MPI_COMM_WORLD,ier)
+ ! do basic checks
+ if(minval(perm) /= 1) stop 'minval(perm) should be 1'
+ if(maxval(perm) /= nspec) stop 'maxval(perm) should be nspec'
- endif
+ call MPI_ALLREDUCE(nspec_outer,nspec_outer_min_global,1,MPI_INTEGER,MPI_MIN,MPI_COMM_WORLD,ier)
+ call MPI_ALLREDUCE(nspec_outer,nspec_outer_max_global,1,MPI_INTEGER,MPI_MAX,MPI_COMM_WORLD,ier)
-!! DK DK and Manh Ha, Nov 2011: added this to use the new mesher in the CUDA or C / StarSs test codes
+ endif ! USE_MESH_COLORING_GPU
- if (myrank == 0 .and. iregion_code == IREGION_CRUST_MANTLE) then
+ !! DK DK and Manh Ha, Nov 2011: added this to use the new mesher in the CUDA or C / StarSs test codes
-! write a header file for the Fortran version of the solver
- open(unit=99,file=prname(1:len_trim(prname))//'values_from_mesher_f90.h',status='unknown')
- write(99,*) 'integer, parameter :: NSPEC = ',nspec
- write(99,*) 'integer, parameter :: NGLOB = ',nglob
-!!! DK DK use 1000 time steps only for the scaling tests
- write(99,*) 'integer, parameter :: NSTEP = 1000 !!!!!!!!!!! ',nstep
- write(99,*) 'real(kind=4), parameter :: deltat = ',DT
- write(99,*)
- write(99,*) 'integer, parameter :: NGLOB2DMAX_XMIN_XMAX = ',npoin2D_xi
- write(99,*) 'integer, parameter :: NGLOB2DMAX_YMIN_YMAX = ',npoin2D_eta
- write(99,*) 'integer, parameter :: NGLOB2DMAX_ALL = ',max(npoin2D_xi,npoin2D_eta)
- write(99,*) 'integer, parameter :: NPROC_XI = ',NPROC_XI
- write(99,*) 'integer, parameter :: NPROC_ETA = ',NPROC_ETA
- write(99,*)
- write(99,*) '! element number of the source and of the station'
- write(99,*) '! after permutation of the elements by mesh coloring'
- write(99,*) '! and inner/outer set splitting in the mesher'
- write(99,*) 'integer, parameter :: NSPEC_SOURCE = ',perm(NSPEC/3)
- write(99,*) 'integer, parameter :: RANK_SOURCE = 0'
- write(99,*)
- write(99,*) 'integer, parameter :: RANK_STATION = (NPROC_XI*NPROC_ETA - 1)'
- write(99,*) 'integer, parameter :: NSPEC_STATION = ',perm(2*NSPEC/3)
+ if (myrank == 0 .and. iregion_code == IREGION_CRUST_MANTLE) then
+ ! write a header file for the Fortran version of the solver
+ open(unit=99,file=prname(1:len_trim(prname))//'values_from_mesher_f90.h',status='unknown')
+ write(99,*) 'integer, parameter :: NSPEC = ',nspec
+ write(99,*) 'integer, parameter :: NGLOB = ',nglob
+ !!! DK DK use 1000 time steps only for the scaling tests
+ write(99,*) 'integer, parameter :: NSTEP = 1000 !!!!!!!!!!! ',nstep
+ write(99,*) 'real(kind=4), parameter :: deltat = ',DT
+ write(99,*)
+ write(99,*) 'integer, parameter :: NGLOB2DMAX_XMIN_XMAX = ',npoin2D_xi
+ write(99,*) 'integer, parameter :: NGLOB2DMAX_YMIN_YMAX = ',npoin2D_eta
+ write(99,*) 'integer, parameter :: NGLOB2DMAX_ALL = ',max(npoin2D_xi,npoin2D_eta)
+ write(99,*) 'integer, parameter :: NPROC_XI = ',NPROC_XI
+ write(99,*) 'integer, parameter :: NPROC_ETA = ',NPROC_ETA
+ write(99,*)
+ write(99,*) '! element number of the source and of the station'
+ write(99,*) '! after permutation of the elements by mesh coloring'
+ write(99,*) '! and inner/outer set splitting in the mesher'
+ write(99,*) 'integer, parameter :: NSPEC_SOURCE = ',perm(NSPEC/3)
+ write(99,*) 'integer, parameter :: RANK_SOURCE = 0'
+ write(99,*)
+ write(99,*) 'integer, parameter :: RANK_STATION = (NPROC_XI*NPROC_ETA - 1)'
+ write(99,*) 'integer, parameter :: NSPEC_STATION = ',perm(2*NSPEC/3)
-! save coordinates of the seismic source
-! write(99,*) xstore(2,2,2,10);
-! write(99,*) ystore(2,2,2,10);
-! write(99,*) zstore(2,2,2,10);
+ ! save coordinates of the seismic source
+ ! write(99,*) xstore(2,2,2,10);
+ ! write(99,*) ystore(2,2,2,10);
+ ! write(99,*) zstore(2,2,2,10);
-! save coordinates of the seismic station
-! write(99,*) xstore(2,2,2,nspec-10);
-! write(99,*) ystore(2,2,2,nspec-10);
-! write(99,*) zstore(2,2,2,nspec-10);
- close(99)
+ ! save coordinates of the seismic station
+ ! write(99,*) xstore(2,2,2,nspec-10);
+ ! write(99,*) ystore(2,2,2,nspec-10);
+ ! write(99,*) zstore(2,2,2,nspec-10);
+ close(99)
-!! write a header file for the C version of the solver
- open(unit=99,file=prname(1:len_trim(prname))//'values_from_mesher_C.h',status='unknown')
- write(99,*) '#define NSPEC ',nspec
- write(99,*) '#define NGLOB ',nglob
-!! write(99,*) '#define NSTEP ',nstep
-!!! DK DK use 1000 time steps only for the scaling tests
- write(99,*) '// #define NSTEP ',nstep
- write(99,*) '#define NSTEP 1000'
-! put an "f" at the end to force single precision
- write(99,"('#define deltat ',e18.10,'f')") DT
- write(99,*) '#define NGLOB2DMAX_XMIN_XMAX ',npoin2D_xi
- write(99,*) '#define NGLOB2DMAX_YMIN_YMAX ',npoin2D_eta
- write(99,*) '#define NGLOB2DMAX_ALL ',max(npoin2D_xi,npoin2D_eta)
- write(99,*) '#define NPROC_XI ',NPROC_XI
- write(99,*) '#define NPROC_ETA ',NPROC_ETA
- write(99,*)
- write(99,*) '// element and MPI slice number of the source and the station'
- write(99,*) '// after permutation of the elements by mesh coloring'
- write(99,*) '// and inner/outer set splitting in the mesher'
- write(99,*) '#define RANK_SOURCE 0'
- write(99,*) '#define NSPEC_SOURCE ',perm(NSPEC/3)
- write(99,*)
- write(99,*) '#define RANK_STATION (NPROC_XI*NPROC_ETA - 1)'
- write(99,*) '#define NSPEC_STATION ',perm(2*NSPEC/3)
- close(99)
+ !! write a header file for the C version of the solver
+ open(unit=99,file=prname(1:len_trim(prname))//'values_from_mesher_C.h',status='unknown')
+ write(99,*) '#define NSPEC ',nspec
+ write(99,*) '#define NGLOB ',nglob
+ !! write(99,*) '#define NSTEP ',nstep
+ !!! DK DK use 1000 time steps only for the scaling tests
+ write(99,*) '// #define NSTEP ',nstep
+ write(99,*) '#define NSTEP 1000'
+ ! put an "f" at the end to force single precision
+ write(99,"('#define deltat ',e18.10,'f')") DT
+ write(99,*) '#define NGLOB2DMAX_XMIN_XMAX ',npoin2D_xi
+ write(99,*) '#define NGLOB2DMAX_YMIN_YMAX ',npoin2D_eta
+ write(99,*) '#define NGLOB2DMAX_ALL ',max(npoin2D_xi,npoin2D_eta)
+ write(99,*) '#define NPROC_XI ',NPROC_XI
+ write(99,*) '#define NPROC_ETA ',NPROC_ETA
+ write(99,*)
+ write(99,*) '// element and MPI slice number of the source and the station'
+ write(99,*) '// after permutation of the elements by mesh coloring'
+ write(99,*) '// and inner/outer set splitting in the mesher'
+ write(99,*) '#define RANK_SOURCE 0'
+ write(99,*) '#define NSPEC_SOURCE ',perm(NSPEC/3)
+ write(99,*)
+ write(99,*) '#define RANK_STATION (NPROC_XI*NPROC_ETA - 1)'
+ write(99,*) '#define NSPEC_STATION ',perm(2*NSPEC/3)
+ close(99)
- open(unit=99,file=prname(1:len_trim(prname))//'values_from_mesher_nspec_outer.h',status='unknown')
- write(99,*) '#define NSPEC_OUTER ',nspec_outer_max_global
- write(99,*) '// NSPEC_OUTER_min = ',nspec_outer_min_global
- write(99,*) '// NSPEC_OUTER_max = ',nspec_outer_max_global
- close(99)
+ open(unit=99,file=prname(1:len_trim(prname))//'values_from_mesher_nspec_outer.h',status='unknown')
+ write(99,*) '#define NSPEC_OUTER ',nspec_outer_max_global
+ write(99,*) '// NSPEC_OUTER_min = ',nspec_outer_min_global
+ write(99,*) '// NSPEC_OUTER_max = ',nspec_outer_max_global
+ close(99)
- endif
+ endif
-!! DK DK and Manh Ha, Nov 2011: added this to use the new mesher in the CUDA or C / StarSs test codes
+ !! DK DK and Manh Ha, Nov 2011: added this to use the new mesher in the CUDA or C / StarSs test codes
- deallocate(perm)
+ deallocate(perm)
- else
-!
- print *,'SORT_MESH_INNER_OUTER must always been set to .true. even for the regular C version for CPUs'
- print *,'in order to be able to use non blocking MPI to overlap communications'
-! print *,'generating identity permutation'
-! do ispec = 1,nspec
-! perm(ispec) = ispec
-! enddo
- stop 'please set SORT_MESH_INNER_OUTER to .true. and recompile the whole code'
+ else
+ print *,'SORT_MESH_INNER_OUTER must always been set to .true. even for the regular C version for CPUs'
+ print *,'in order to be able to use non blocking MPI to overlap communications'
+ ! print *,'generating identity permutation'
+ ! do ispec = 1,nspec
+ ! perm(ispec) = ispec
+ ! enddo
+ stop 'please set SORT_MESH_INNER_OUTER to .true. and recompile the whole code'
- endif
+ endif ! SORT_MESH_INNER_OUTER
-!!!! David Michea: end of mesh coloring
+ !!!! David Michea: end of mesh coloring
-!****************************************************************************************************
+ !****************************************************************************************************
! precomputes jacobian for 2d absorbing boundary surfaces
call get_jacobian_boundaries(myrank,iboun,nspec,xstore,ystore,zstore, &
@@ -1014,8 +1037,11 @@
nglob_oceans,rmass_ocean_load,NSPEC2D_TOP,ibelm_top,jacobian2D_top, &
xstore,ystore,zstore,RHO_OCEANS)
+ ! user output
+ if(myrank == 0 ) write(IMAIN,*) ' saving binary files'
+
! save the binary files
- call save_arrays_solver(rho_vp,rho_vs,nspec_stacey, &
+ call save_arrays_solver(myrank,rho_vp,rho_vs,nspec_stacey, &
prname,iregion_code,xixstore,xiystore,xizstore, &
etaxstore,etaystore,etazstore,gammaxstore,gammaystore,gammazstore, &
xstore,ystore,zstore,rhostore,dvpstore, &
@@ -1052,7 +1078,10 @@
call exit_mpi(myrank,'Not the same number of 670 surface elements')
! writing surface topology databases
- open(unit=27,file=prname(1:len_trim(prname))//'boundary_disc.bin',status='unknown',form='unformatted')
+ open(unit=27,file=prname(1:len_trim(prname))//'boundary_disc.bin', &
+ status='unknown',form='unformatted',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening boundary_disc.bin file')
+
write(27) NSPEC2D_MOHO, NSPEC2D_400, NSPEC2D_670
write(27) ibelm_moho_top
write(27) ibelm_moho_bot
@@ -1067,16 +1096,16 @@
endif
! compute volume, bottom and top area of that part of the slice
- call crm_compute_volumes(volume_local,area_local_bottom,area_local_top, &
+ call compute_volumes(volume_local,area_local_bottom,area_local_top, &
nspec,wxgll,wygll,wzgll,xixstore,xiystore,xizstore, &
etaxstore,etaystore,etazstore,gammaxstore,gammaystore,gammazstore, &
NSPEC2D_BOTTOM,jacobian2D_bottom,NSPEC2D_TOP,jacobian2D_top)
- else
+ case default
stop 'there cannot be more than two passes in mesh creation'
- endif ! end of test if first or second pass
+ end select ! end of test if first or second pass
deallocate(stretch_tab)
deallocate(perm_layer)
@@ -1137,243 +1166,3 @@
end subroutine create_regions_mesh
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-
- subroutine crm_initialize_layers(myrank,ipass,xigll,yigll,zigll,wxgll,wygll,wzgll, &
- shape3D,dershape3D,shape2D_x,shape2D_y,shape2D_bottom,shape2D_top, &
- dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
- iaddx,iaddy,iaddz,nspec,xstore,ystore,zstore,ibool,idoubling, &
- iboun,iMPIcut_xi,iMPIcut_eta,ispec2D_moho_top,ispec2D_moho_bot, &
- ispec2D_400_top,ispec2D_400_bot,ispec2D_670_top,ispec2D_670_bot, &
- NEX_PER_PROC_ETA,nex_eta_moho,RMOHO,R400,R670,r_moho,r_400,r_670, &
- ONE_CRUST,NUMBER_OF_MESH_LAYERS,layer_shift, &
- iregion_code,ifirst_region,ilast_region, &
- first_layer_aniso,last_layer_aniso,nb_layer_above_aniso,is_on_a_slice_edge)
-
-! create the different regions of the mesh
-
- implicit none
-
- include "constants.h"
-
- integer :: myrank,ipass
-
- double precision xigll(NGLLX),yigll(NGLLY),zigll(NGLLZ)
- double precision wxgll(NGLLX),wygll(NGLLY),wzgll(NGLLZ)
-
- double precision shape3D(NGNOD,NGLLX,NGLLY,NGLLZ),dershape3D(NDIM,NGNOD,NGLLX,NGLLY,NGLLZ)
-
- double precision shape2D_x(NGNOD2D,NGLLY,NGLLZ),shape2D_y(NGNOD2D,NGLLX,NGLLZ)
- double precision shape2D_bottom(NGNOD2D,NGLLX,NGLLY),shape2D_top(NGNOD2D,NGLLX,NGLLY)
- double precision dershape2D_x(NDIM2D,NGNOD2D,NGLLY,NGLLZ),dershape2D_y(NDIM2D,NGNOD2D,NGLLX,NGLLZ)
- double precision dershape2D_bottom(NDIM2D,NGNOD2D,NGLLX,NGLLY),dershape2D_top(NDIM2D,NGNOD2D,NGLLX,NGLLY)
-
- integer, dimension(NGNOD) :: iaddx,iaddy,iaddz
-
- integer nspec
- double precision xstore(NGLLX,NGLLY,NGLLZ,nspec)
- double precision ystore(NGLLX,NGLLY,NGLLZ,nspec)
- double precision zstore(NGLLX,NGLLY,NGLLZ,nspec)
- integer ibool(NGLLX,NGLLY,NGLLZ,nspec)
- integer idoubling(nspec)
-
- logical iboun(6,nspec)
- logical iMPIcut_xi(2,nspec),iMPIcut_eta(2,nspec)
-
- integer ispec2D_moho_top,ispec2D_moho_bot,ispec2D_400_top,ispec2D_400_bot, &
- ispec2D_670_top,ispec2D_670_bot
- integer NEX_PER_PROC_ETA,nex_eta_moho
- double precision RMOHO,R400,R670
- double precision r_moho,r_400,r_670
-
- logical ONE_CRUST
- integer NUMBER_OF_MESH_LAYERS,layer_shift
-
- ! code for the four regions of the mesh
- integer iregion_code,ifirst_region,ilast_region
- integer first_layer_aniso,last_layer_aniso,nb_layer_above_aniso
-
-! this for non blocking MPI
- logical, dimension(nspec) :: is_on_a_slice_edge
-
-! 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)
-
-! create the shape of the corner nodes of a regular mesh element
- call hex_nodes(iaddx,iaddy,iaddz)
-
-! reference element has size one here, not two
- iaddx(:) = iaddx(:) / 2
- iaddy(:) = iaddy(:) / 2
- iaddz(:) = iaddz(:) / 2
-
-! sets number of layers
- if (ONE_CRUST) then
- NUMBER_OF_MESH_LAYERS = MAX_NUMBER_OF_MESH_LAYERS - 1
- layer_shift = 0
- else
- NUMBER_OF_MESH_LAYERS = MAX_NUMBER_OF_MESH_LAYERS
- layer_shift = 1
- endif
-
- if (.not. ADD_4TH_DOUBLING) NUMBER_OF_MESH_LAYERS = NUMBER_OF_MESH_LAYERS - 1
-
-! define the first and last layers that define this region
- if(iregion_code == IREGION_CRUST_MANTLE) then
- ifirst_region = 1
- ilast_region = 10 + layer_shift
-
- else if(iregion_code == IREGION_OUTER_CORE) then
- ifirst_region = 11 + layer_shift
- ilast_region = NUMBER_OF_MESH_LAYERS - 1
-
- else if(iregion_code == IREGION_INNER_CORE) then
- ifirst_region = NUMBER_OF_MESH_LAYERS
- ilast_region = NUMBER_OF_MESH_LAYERS
-
- else
- call exit_MPI(myrank,'incorrect region code detected')
- endif
-
-! to consider anisotropic elements first and to build the mesh from the bottom to the top of the region
- if (ONE_CRUST) then
- first_layer_aniso=2
- last_layer_aniso=3
- nb_layer_above_aniso = 1
- else
- first_layer_aniso=3
- last_layer_aniso=4
- nb_layer_above_aniso = 2
- endif
-
-! initialize mesh arrays
- idoubling(:) = 0
-
- xstore(:,:,:,:) = 0.d0
- ystore(:,:,:,:) = 0.d0
- zstore(:,:,:,:) = 0.d0
-
- if(ipass == 1) ibool(:,:,:,:) = 0
-
- ! initialize boundary arrays
- iboun(:,:) = .false.
- iMPIcut_xi(:,:) = .false.
- iMPIcut_eta(:,:) = .false.
- is_on_a_slice_edge(:) = .false.
-
- ! boundary mesh
- ispec2D_moho_top = 0; ispec2D_moho_bot = 0
- ispec2D_400_top = 0; ispec2D_400_bot = 0
- ispec2D_670_top = 0; ispec2D_670_bot = 0
-
- nex_eta_moho = NEX_PER_PROC_ETA
-
- r_moho = RMOHO/R_EARTH; r_400 = R400 / R_EARTH; r_670 = R670/R_EARTH
-
- end subroutine crm_initialize_layers
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine crm_compute_volumes(volume_local,area_local_bottom,area_local_top, &
- nspec,wxgll,wygll,wzgll,xixstore,xiystore,xizstore, &
- etaxstore,etaystore,etazstore,gammaxstore,gammaystore,gammazstore, &
- NSPEC2D_BOTTOM,jacobian2D_bottom,NSPEC2D_TOP,jacobian2D_top)
-
- implicit none
-
- include "constants.h"
-
- double precision :: volume_local,area_local_bottom,area_local_top
-
- integer :: nspec
- double precision :: wxgll(NGLLX),wygll(NGLLY),wzgll(NGLLZ)
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,nspec) :: &
- xixstore,xiystore,xizstore,etaxstore,etaystore,etazstore,gammaxstore,gammaystore,gammazstore
-
- integer :: NSPEC2D_BOTTOM,NSPEC2D_TOP
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_BOTTOM) :: jacobian2D_bottom
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_TOP) :: jacobian2D_top
-
- ! local parameters
- double precision :: weight
- real(kind=CUSTOM_REAL) :: xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl,jacobianl
- integer :: i,j,k,ispec
-
- ! initializes
- volume_local = ZERO
- area_local_bottom = ZERO
- area_local_top = ZERO
-
- do ispec = 1,nspec
- do k = 1,NGLLZ
- do j = 1,NGLLY
- do i = 1,NGLLX
-
- weight = wxgll(i)*wygll(j)*wzgll(k)
-
- ! compute the jacobian
- xixl = xixstore(i,j,k,ispec)
- xiyl = xiystore(i,j,k,ispec)
- xizl = xizstore(i,j,k,ispec)
- etaxl = etaxstore(i,j,k,ispec)
- etayl = etaystore(i,j,k,ispec)
- etazl = etazstore(i,j,k,ispec)
- gammaxl = gammaxstore(i,j,k,ispec)
- gammayl = gammaystore(i,j,k,ispec)
- gammazl = gammazstore(i,j,k,ispec)
-
- jacobianl = 1._CUSTOM_REAL / (xixl*(etayl*gammazl-etazl*gammayl) &
- - xiyl*(etaxl*gammazl-etazl*gammaxl) &
- + xizl*(etaxl*gammayl-etayl*gammaxl))
-
- volume_local = volume_local + dble(jacobianl)*weight
-
- enddo
- enddo
- enddo
- enddo
-
- do ispec = 1,NSPEC2D_BOTTOM
- do i=1,NGLLX
- do j=1,NGLLY
- weight=wxgll(i)*wygll(j)
- area_local_bottom = area_local_bottom + dble(jacobian2D_bottom(i,j,ispec))*weight
- enddo
- enddo
- enddo
-
- do ispec = 1,NSPEC2D_TOP
- do i=1,NGLLX
- do j=1,NGLLY
- weight=wxgll(i)*wygll(j)
- area_local_top = area_local_top + dble(jacobian2D_top(i,j,ispec))*weight
- enddo
- enddo
- enddo
-
-
- end subroutine crm_compute_volumes
-
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/finalize_mesher.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/finalize_mesher.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/finalize_mesher.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,167 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+
+ subroutine finalize_mesher()
+
+ use meshfem3D_par
+ implicit none
+
+ ! standard include of the MPI library
+ include 'mpif.h'
+
+ !--- print number of points and elements in the mesh for each region
+ if(myrank == 0) then
+
+ ! check volume of chunk
+ write(IMAIN,*)
+ write(IMAIN,*) 'calculated volume: ',volume_total
+ if(.not. TOPOGRAPHY) then
+ ! take the central cube into account
+ ! it is counted 6 times because of the fictitious elements
+ if(INCLUDE_CENTRAL_CUBE) then
+ write(IMAIN,*) ' exact volume: ', &
+ dble(NCHUNKS)*((4.0d0/3.0d0)*PI*(R_UNIT_SPHERE**3)+5.*(2.*(R_CENTRAL_CUBE/R_EARTH)/sqrt(3.))**3)/6.d0
+ else
+ write(IMAIN,*) ' exact volume: ', &
+ dble(NCHUNKS)*((4.0d0/3.0d0)*PI*(R_UNIT_SPHERE**3)-(2.*(R_CENTRAL_CUBE/R_EARTH)/sqrt(3.))**3)/6.d0
+ endif
+ endif
+
+ ! infos output
+ numelem_crust_mantle = NSPEC(IREGION_CRUST_MANTLE)
+ numelem_outer_core = NSPEC(IREGION_OUTER_CORE)
+ numelem_inner_core = NSPEC(IREGION_INNER_CORE)
+
+ numelem_total = numelem_crust_mantle + numelem_outer_core + numelem_inner_core
+
+ write(IMAIN,*)
+ write(IMAIN,*) 'Repartition of elements in regions:'
+ write(IMAIN,*) '----------------------------------'
+ write(IMAIN,*)
+ write(IMAIN,*) 'total number of elements in each slice: ',numelem_total
+ write(IMAIN,*)
+ write(IMAIN,*) ' - crust and mantle: ',sngl(100.d0*dble(numelem_crust_mantle)/dble(numelem_total)),' %'
+ write(IMAIN,*) ' - outer core: ',sngl(100.d0*dble(numelem_outer_core)/dble(numelem_total)),' %'
+ write(IMAIN,*) ' - inner core: ',sngl(100.d0*dble(numelem_inner_core)/dble(numelem_total)),' %'
+ write(IMAIN,*)
+ write(IMAIN,*) 'for some mesh statistics, see comments in file OUTPUT_FILES/values_from_mesher.h'
+ write(IMAIN,*)
+
+ ! load balancing
+ write(IMAIN,*) 'Load balancing = 100 % by definition'
+ write(IMAIN,*)
+
+ write(IMAIN,*)
+ write(IMAIN,*) 'total number of time steps in the solver will be: ',NSTEP
+ write(IMAIN,*)
+
+ write(IMAIN,*)
+ write(IMAIN,*) 'time-stepping of the solver will be: ',DT
+ 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,*)
+
+ ! evaluate the amount of static memory needed by the solver
+ call memory_eval(OCEANS,ABSORBING_CONDITIONS,ATTENUATION,ANISOTROPIC_3D_MANTLE,&
+ TRANSVERSE_ISOTROPY,ANISOTROPIC_INNER_CORE,ROTATION,&
+ ONE_CRUST,doubling_index,this_region_has_a_doubling,&
+ ner,NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_sampling_array,&
+ NSPEC,nglob,SIMULATION_TYPE,MOVIE_VOLUME,SAVE_FORWARD, &
+ NSPECMAX_ANISO_IC,NSPECMAX_ISO_MANTLE,NSPECMAX_TISO_MANTLE, &
+ NSPECMAX_ANISO_MANTLE,NSPEC_CRUST_MANTLE_ATTENUAT, &
+ NSPEC_INNER_CORE_ATTENUATION, &
+ NSPEC_CRUST_MANTLE_STR_OR_ATT,NSPEC_INNER_CORE_STR_OR_ATT, &
+ NSPEC_CRUST_MANTLE_STR_AND_ATT,NSPEC_INNER_CORE_STR_AND_ATT, &
+ NSPEC_CRUST_MANTLE_STRAIN_ONLY,NSPEC_INNER_CORE_STRAIN_ONLY, &
+ NSPEC_CRUST_MANTLE_ADJOINT, &
+ NSPEC_OUTER_CORE_ADJOINT,NSPEC_INNER_CORE_ADJOINT, &
+ NGLOB_CRUST_MANTLE_ADJOINT,NGLOB_OUTER_CORE_ADJOINT, &
+ NGLOB_INNER_CORE_ADJOINT,NSPEC_OUTER_CORE_ROT_ADJOINT, &
+ NSPEC_CRUST_MANTLE_STACEY,NSPEC_OUTER_CORE_STACEY, &
+ NGLOB_CRUST_MANTLE_OCEANS,NSPEC_OUTER_CORE_ROTATION,static_memory_size)
+
+ NGLOB1D_RADIAL_TEMP(:) = &
+ (/maxval(NGLOB1D_RADIAL_CORNER(1,:)),maxval(NGLOB1D_RADIAL_CORNER(2,:)),maxval(NGLOB1D_RADIAL_CORNER(3,:))/)
+
+ ! create include file for the solver
+ call save_header_file(NSPEC,nglob,NEX_XI,NEX_ETA,NPROC,NPROCTOT, &
+ TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE,ANISOTROPIC_INNER_CORE, &
+ ELLIPTICITY,GRAVITY,ROTATION,OCEANS,ATTENUATION,ATTENUATION_3D, &
+ ANGULAR_WIDTH_XI_IN_DEGREES,ANGULAR_WIDTH_ETA_IN_DEGREES,NCHUNKS, &
+ INCLUDE_CENTRAL_CUBE,CENTER_LONGITUDE_IN_DEGREES,&
+ CENTER_LATITUDE_IN_DEGREES,GAMMA_ROTATION_AZIMUTH,NSOURCES,NSTEP, &
+ static_memory_size,NGLOB1D_RADIAL_TEMP, &
+ NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX,NSPEC2D_TOP,NSPEC2D_BOTTOM, &
+ NSPEC2DMAX_YMIN_YMAX,NSPEC2DMAX_XMIN_XMAX, &
+ NPROC_XI,NPROC_ETA, &
+ NSPECMAX_ANISO_IC,NSPECMAX_ISO_MANTLE,NSPECMAX_TISO_MANTLE, &
+ NSPECMAX_ANISO_MANTLE,NSPEC_CRUST_MANTLE_ATTENUAT, &
+ NSPEC_INNER_CORE_ATTENUATION, &
+ NSPEC_CRUST_MANTLE_STR_OR_ATT,NSPEC_INNER_CORE_STR_OR_ATT, &
+ NSPEC_CRUST_MANTLE_STR_AND_ATT,NSPEC_INNER_CORE_STR_AND_ATT, &
+ NSPEC_CRUST_MANTLE_STRAIN_ONLY,NSPEC_INNER_CORE_STRAIN_ONLY, &
+ NSPEC_CRUST_MANTLE_ADJOINT, &
+ NSPEC_OUTER_CORE_ADJOINT,NSPEC_INNER_CORE_ADJOINT, &
+ NGLOB_CRUST_MANTLE_ADJOINT,NGLOB_OUTER_CORE_ADJOINT, &
+ NGLOB_INNER_CORE_ADJOINT,NSPEC_OUTER_CORE_ROT_ADJOINT, &
+ NSPEC_CRUST_MANTLE_STACEY,NSPEC_OUTER_CORE_STACEY, &
+ NGLOB_CRUST_MANTLE_OCEANS,NSPEC_OUTER_CORE_ROTATION, &
+ SIMULATION_TYPE,SAVE_FORWARD,MOVIE_VOLUME)
+
+ endif ! end of section executed by main process only
+
+ ! deallocate arrays used for mesh generation
+ deallocate(addressing)
+ deallocate(ichunk_slice)
+ deallocate(iproc_xi_slice)
+ deallocate(iproc_eta_slice)
+
+ ! elapsed time since beginning of mesh generation
+ if(myrank == 0) then
+ tCPU = MPI_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,*)
+ ! close main output file
+ close(IMAIN)
+ endif
+
+ ! synchronize all the processes to make sure everybody has finished
+ call sync_all()
+
+ end subroutine finalize_mesher
+
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/get_jacobian_boundaries.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/get_jacobian_boundaries.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/get_jacobian_boundaries.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -26,9 +26,9 @@
!=====================================================================
subroutine get_jacobian_boundaries(myrank,iboun,nspec,xstore,ystore,zstore, &
- dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
- ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
- nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
+ dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
+ ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
+ nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
jacobian2D_xmin,jacobian2D_xmax, &
jacobian2D_ymin,jacobian2D_ymax, &
jacobian2D_bottom,jacobian2D_top, &
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/initialize_layers.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/initialize_layers.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/initialize_layers.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,176 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+
+ subroutine initialize_layers(myrank,ipass,xigll,yigll,zigll,wxgll,wygll,wzgll, &
+ shape3D,dershape3D,shape2D_x,shape2D_y,shape2D_bottom,shape2D_top, &
+ dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
+ iaddx,iaddy,iaddz,nspec,xstore,ystore,zstore,ibool,idoubling, &
+ iboun,iMPIcut_xi,iMPIcut_eta,ispec2D_moho_top,ispec2D_moho_bot, &
+ ispec2D_400_top,ispec2D_400_bot,ispec2D_670_top,ispec2D_670_bot, &
+ NEX_PER_PROC_ETA,nex_eta_moho,RMOHO,R400,R670,r_moho,r_400,r_670, &
+ ONE_CRUST,NUMBER_OF_MESH_LAYERS,layer_shift, &
+ iregion_code,ifirst_region,ilast_region, &
+ first_layer_aniso,last_layer_aniso,nb_layer_above_aniso,is_on_a_slice_edge)
+
+! create the different regions of the mesh
+
+ implicit none
+
+ include "constants.h"
+
+ integer :: myrank,ipass
+
+ double precision xigll(NGLLX),yigll(NGLLY),zigll(NGLLZ)
+ double precision wxgll(NGLLX),wygll(NGLLY),wzgll(NGLLZ)
+
+ double precision shape3D(NGNOD,NGLLX,NGLLY,NGLLZ),dershape3D(NDIM,NGNOD,NGLLX,NGLLY,NGLLZ)
+
+ double precision shape2D_x(NGNOD2D,NGLLY,NGLLZ),shape2D_y(NGNOD2D,NGLLX,NGLLZ)
+ double precision shape2D_bottom(NGNOD2D,NGLLX,NGLLY),shape2D_top(NGNOD2D,NGLLX,NGLLY)
+ double precision dershape2D_x(NDIM2D,NGNOD2D,NGLLY,NGLLZ),dershape2D_y(NDIM2D,NGNOD2D,NGLLX,NGLLZ)
+ double precision dershape2D_bottom(NDIM2D,NGNOD2D,NGLLX,NGLLY),dershape2D_top(NDIM2D,NGNOD2D,NGLLX,NGLLY)
+
+ integer, dimension(NGNOD) :: iaddx,iaddy,iaddz
+
+ integer nspec
+ double precision xstore(NGLLX,NGLLY,NGLLZ,nspec)
+ double precision ystore(NGLLX,NGLLY,NGLLZ,nspec)
+ double precision zstore(NGLLX,NGLLY,NGLLZ,nspec)
+ integer ibool(NGLLX,NGLLY,NGLLZ,nspec)
+ integer idoubling(nspec)
+
+ logical iboun(6,nspec)
+ logical iMPIcut_xi(2,nspec),iMPIcut_eta(2,nspec)
+
+ integer ispec2D_moho_top,ispec2D_moho_bot,ispec2D_400_top,ispec2D_400_bot, &
+ ispec2D_670_top,ispec2D_670_bot
+ integer NEX_PER_PROC_ETA,nex_eta_moho
+ double precision RMOHO,R400,R670
+ double precision r_moho,r_400,r_670
+
+ logical ONE_CRUST
+ integer NUMBER_OF_MESH_LAYERS,layer_shift
+
+ ! code for the four regions of the mesh
+ integer iregion_code,ifirst_region,ilast_region
+ integer first_layer_aniso,last_layer_aniso,nb_layer_above_aniso
+
+! this for non blocking MPI
+ logical, dimension(nspec) :: is_on_a_slice_edge
+
+! 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)
+
+! create the shape of the corner nodes of a regular mesh element
+ call hex_nodes(iaddx,iaddy,iaddz)
+
+! reference element has size one here, not two
+ iaddx(:) = iaddx(:) / 2
+ iaddy(:) = iaddy(:) / 2
+ iaddz(:) = iaddz(:) / 2
+
+! sets number of layers
+ if (ONE_CRUST) then
+ NUMBER_OF_MESH_LAYERS = MAX_NUMBER_OF_MESH_LAYERS - 1
+ layer_shift = 0
+ else
+ NUMBER_OF_MESH_LAYERS = MAX_NUMBER_OF_MESH_LAYERS
+ layer_shift = 1
+ endif
+
+ if (.not. ADD_4TH_DOUBLING) NUMBER_OF_MESH_LAYERS = NUMBER_OF_MESH_LAYERS - 1
+
+! define the first and last layers that define this region
+ if(iregion_code == IREGION_CRUST_MANTLE) then
+ ifirst_region = 1
+ ilast_region = 10 + layer_shift
+
+ else if(iregion_code == IREGION_OUTER_CORE) then
+ ifirst_region = 11 + layer_shift
+ ilast_region = NUMBER_OF_MESH_LAYERS - 1
+
+ else if(iregion_code == IREGION_INNER_CORE) then
+ ifirst_region = NUMBER_OF_MESH_LAYERS
+ ilast_region = NUMBER_OF_MESH_LAYERS
+
+ else
+ call exit_MPI(myrank,'incorrect region code detected')
+ endif
+
+! to consider anisotropic elements first and to build the mesh from the bottom to the top of the region
+ if (ONE_CRUST) then
+ first_layer_aniso=2
+ last_layer_aniso=3
+ nb_layer_above_aniso = 1
+ else
+ first_layer_aniso=3
+ last_layer_aniso=4
+ nb_layer_above_aniso = 2
+ endif
+
+! initialize mesh arrays
+ idoubling(:) = 0
+
+ xstore(:,:,:,:) = 0.d0
+ ystore(:,:,:,:) = 0.d0
+ zstore(:,:,:,:) = 0.d0
+
+ if(ipass == 1) ibool(:,:,:,:) = 0
+
+ ! initialize boundary arrays
+ iboun(:,:) = .false.
+ iMPIcut_xi(:,:) = .false.
+ iMPIcut_eta(:,:) = .false.
+ is_on_a_slice_edge(:) = .false.
+
+ ! boundary mesh
+ ispec2D_moho_top = 0; ispec2D_moho_bot = 0
+ ispec2D_400_top = 0; ispec2D_400_bot = 0
+ ispec2D_670_top = 0; ispec2D_670_bot = 0
+
+ nex_eta_moho = NEX_PER_PROC_ETA
+
+ r_moho = RMOHO/R_EARTH; r_400 = R400 / R_EARTH; r_670 = R670/R_EARTH
+
+ end subroutine initialize_layers
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/initialize_mesher.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/initialize_mesher.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/initialize_mesher.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,149 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+ subroutine initialize_mesher()
+
+ use meshfem3D_par
+ implicit none
+
+ ! standard include of the MPI library
+ include 'mpif.h'
+
+ ! local parameters
+ integer :: ier
+
+! sizeprocs returns number of processes started (should be equal to NPROCTOT).
+! myrank is the rank of each process, between 0 and NPROCTOT-1.
+! as usual in MPI, process 0 is in charge of coordinating everything
+! and also takes care of the main output
+! do not create anything for the inner core here, will be done in solver
+ call MPI_COMM_SIZE(MPI_COMM_WORLD,sizeprocs,ier)
+ call MPI_COMM_RANK(MPI_COMM_WORLD,myrank,ier)
+
+! 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 = MPI_WTIME()
+
+ if(myrank == 0) then
+ write(IMAIN,*)
+ write(IMAIN,*) '****************************'
+ write(IMAIN,*) '*** Specfem3D MPI Mesher ***'
+ write(IMAIN,*) '****************************'
+ write(IMAIN,*)
+ endif
+
+ if (myrank==0) then
+ ! reads the parameter file and computes additional parameters
+ call read_compute_parameters(MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD,NER_CRUST, &
+ NER_80_MOHO,NER_220_80,NER_400_220,NER_600_400,NER_670_600,NER_771_670, &
+ NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
+ NER_TOP_CENTRAL_CUBE_ICB,NEX_XI,NEX_ETA,RMOHO_FICTITIOUS_IN_MESHER, &
+ NPROC_XI,NPROC_ETA,NTSTEP_BETWEEN_OUTPUT_SEISMOS, &
+ NTSTEP_BETWEEN_READ_ADJSRC,NSTEP,NTSTEP_BETWEEN_FRAMES, &
+ NTSTEP_BETWEEN_OUTPUT_INFO,NUMBER_OF_RUNS,NUMBER_OF_THIS_RUN,NCHUNKS,DT, &
+ ANGULAR_WIDTH_XI_IN_DEGREES,ANGULAR_WIDTH_ETA_IN_DEGREES,CENTER_LONGITUDE_IN_DEGREES, &
+ CENTER_LATITUDE_IN_DEGREES,GAMMA_ROTATION_AZIMUTH,ROCEAN,RMIDDLE_CRUST, &
+ RMOHO,R80,R120,R220,R400,R600,R670,R771,RTOPDDOUBLEPRIME,RCMB,RICB, &
+ R_CENTRAL_CUBE,RHO_TOP_OC,RHO_BOTTOM_OC,RHO_OCEANS,HDUR_MOVIE,MOVIE_VOLUME_TYPE, &
+ MOVIE_TOP,MOVIE_BOTTOM,MOVIE_WEST,MOVIE_EAST,MOVIE_NORTH,MOVIE_SOUTH,MOVIE_START,MOVIE_STOP, &
+ TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE, &
+ ANISOTROPIC_INNER_CORE,CRUSTAL,ELLIPTICITY,GRAVITY,ONE_CRUST, &
+ ROTATION,ISOTROPIC_3D_MANTLE,HETEROGEN_3D_MANTLE,TOPOGRAPHY,OCEANS,MOVIE_SURFACE, &
+ MOVIE_VOLUME,MOVIE_COARSE,ATTENUATION_3D,RECEIVERS_CAN_BE_BURIED, &
+ PRINT_SOURCE_TIME_FUNCTION,SAVE_MESH_FILES, &
+ ATTENUATION,REFERENCE_1D_MODEL,THREE_D_MODEL,ABSORBING_CONDITIONS, &
+ INCLUDE_CENTRAL_CUBE,INFLATE_CENTRAL_CUBE, &
+ LOCAL_PATH,LOCAL_TMP_PATH,MODEL, &
+ SIMULATION_TYPE,SAVE_FORWARD, &
+ NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
+ NSPEC,NSPEC2D_XI,NSPEC2D_ETA,NSPEC2DMAX_XMIN_XMAX, &
+ NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
+ NSPEC1D_RADIAL,NGLOB1D_RADIAL,NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX,NGLOB, &
+ ratio_sampling_array, ner, doubling_index,r_bottom,r_top,&
+ this_region_has_a_doubling,rmins,rmaxs,CASE_3D, &
+ OUTPUT_SEISMOS_ASCII_TEXT,OUTPUT_SEISMOS_SAC_ALPHANUM,OUTPUT_SEISMOS_SAC_BINARY, &
+ ROTATE_SEISMOGRAMS_RT,ratio_divide_central_cube, &
+ HONOR_1D_SPHERICAL_MOHO,CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA,&
+ DIFF_NSPEC1D_RADIAL,DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA,&
+ WRITE_SEISMOGRAMS_BY_MASTER,SAVE_ALL_SEISMOS_IN_ONE_FILE, &
+ USE_BINARY_FOR_LARGE_FILE,.false.,NOISE_TOMOGRAPHY)
+
+ if(err_occurred() /= 0) &
+ call exit_MPI(myrank,'an error occurred while reading the parameter file')
+
+ endif
+
+ ! distributes parameters from master to all processes
+ call broadcast_compute_parameters(myrank,MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD,NER_CRUST, &
+ NER_80_MOHO,NER_220_80,NER_400_220,NER_600_400,NER_670_600,NER_771_670, &
+ NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
+ NER_TOP_CENTRAL_CUBE_ICB,NEX_XI,NEX_ETA, &
+ NPROC_XI,NPROC_ETA,NTSTEP_BETWEEN_OUTPUT_SEISMOS, &
+ NTSTEP_BETWEEN_READ_ADJSRC,NSTEP,NSOURCES,NTSTEP_BETWEEN_FRAMES, &
+ NTSTEP_BETWEEN_OUTPUT_INFO,NUMBER_OF_RUNS,NUMBER_OF_THIS_RUN,NCHUNKS,SIMULATION_TYPE, &
+ MOVIE_VOLUME_TYPE,MOVIE_START,MOVIE_STOP, &
+ DT,ANGULAR_WIDTH_XI_IN_DEGREES,ANGULAR_WIDTH_ETA_IN_DEGREES,CENTER_LONGITUDE_IN_DEGREES, &
+ CENTER_LATITUDE_IN_DEGREES,GAMMA_ROTATION_AZIMUTH,ROCEAN,RMIDDLE_CRUST, &
+ RMOHO,R80,R120,R220,R400,R600,R670,R771,RTOPDDOUBLEPRIME,RCMB,RICB, &
+ R_CENTRAL_CUBE,RHO_TOP_OC,RHO_BOTTOM_OC,RHO_OCEANS,HDUR_MOVIE, &
+ MOVIE_TOP,MOVIE_BOTTOM,MOVIE_WEST,MOVIE_EAST,MOVIE_NORTH,MOVIE_SOUTH, &
+ RMOHO_FICTITIOUS_IN_MESHER, &
+ MOVIE_SURFACE,MOVIE_VOLUME,RECEIVERS_CAN_BE_BURIED,PRINT_SOURCE_TIME_FUNCTION, &
+ SAVE_MESH_FILES,ABSORBING_CONDITIONS,INCLUDE_CENTRAL_CUBE,INFLATE_CENTRAL_CUBE,SAVE_FORWARD, &
+ SAVE_ALL_SEISMOS_IN_ONE_FILE,MOVIE_COARSE,OUTPUT_SEISMOS_ASCII_TEXT, &
+ OUTPUT_SEISMOS_SAC_ALPHANUM,OUTPUT_SEISMOS_SAC_BINARY, &
+ ROTATE_SEISMOGRAMS_RT,WRITE_SEISMOGRAMS_BY_MASTER,USE_BINARY_FOR_LARGE_FILE, &
+ LOCAL_PATH,LOCAL_TMP_PATH,MODEL, &
+ NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
+ NSPEC,NSPEC2D_XI,NSPEC2D_ETA, &
+ NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
+ NSPEC1D_RADIAL,NGLOB1D_RADIAL,NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX,NGLOB, &
+ ratio_sampling_array, ner, doubling_index,r_bottom,r_top, &
+ this_region_has_a_doubling,rmins,rmaxs, &
+ ratio_divide_central_cube,CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, &
+ DIFF_NSPEC1D_RADIAL,DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA, &
+ REFERENCE_1D_MODEL,THREE_D_MODEL,ELLIPTICITY,GRAVITY,ROTATION,TOPOGRAPHY,OCEANS, &
+ HONOR_1D_SPHERICAL_MOHO,CRUSTAL,ONE_CRUST,CASE_3D,TRANSVERSE_ISOTROPY, &
+ ISOTROPIC_3D_MANTLE,ANISOTROPIC_3D_MANTLE,HETEROGEN_3D_MANTLE, &
+ ATTENUATION,ATTENUATION_3D,ANISOTROPIC_INNER_CORE,NOISE_TOMOGRAPHY)
+
+ ! check that the code is running with the requested number of processes
+ if(sizeprocs /= NPROCTOT) call exit_MPI(myrank,'wrong number of MPI processes')
+
+ ! compute rotation matrix from Euler angles
+ ANGULAR_WIDTH_XI_RAD = ANGULAR_WIDTH_XI_IN_DEGREES * PI / 180.d0
+ ANGULAR_WIDTH_ETA_RAD = ANGULAR_WIDTH_ETA_IN_DEGREES * PI / 180.d0
+
+ if(NCHUNKS /= 6) call euler_angles(rotation_matrix,CENTER_LONGITUDE_IN_DEGREES,CENTER_LATITUDE_IN_DEGREES,GAMMA_ROTATION_AZIMUTH)
+
+ end subroutine initialize_mesher
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/meshfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/meshfem3D.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/meshfem3D.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -29,15 +29,15 @@
program xmeshfem3D
- use meshfem3D_models_par
+ use meshfem3D_par
implicit none
-! standard include of the MPI library
+ ! standard include of the MPI library
include 'mpif.h'
- !include "constants.h"
- include "precision.h"
+ ! local parameters
+ integer :: ier
!=====================================================================!
! !
@@ -278,128 +278,7 @@
! Its second time derivative is called accel_outer_core.
-! correct number of spectral elements in each block depending on chunk type
- integer nspec_tiso,npointot
-! parameters needed to store the radii of the grid points
-! in the spherically symmetric Earth
- integer, dimension(:), allocatable :: idoubling
- 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
-
-! check area and volume of the final mesh
- double precision area_local_bottom
- double precision area_local_top
- double precision volume_local,volume_total
-
- !integer iprocnum
-
-! for loop on all the slices
- integer iregion_code
- integer iproc_xi,iproc_eta,ichunk
-
-! rotation matrix from Euler angles
- double precision, dimension(NDIM,NDIM) :: rotation_matrix
-
- double precision ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD
-
-! for some statistics for the mesh
- integer numelem_crust_mantle,numelem_outer_core,numelem_inner_core
- integer numelem_total
-
-! timer MPI
- double precision time_start,tCPU
-
-! addressing for all the slices
- integer, dimension(:), allocatable :: ichunk_slice,iproc_xi_slice,iproc_eta_slice
- integer, dimension(:,:,:), allocatable :: addressing
-
-! parameters read from parameter file
- integer MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD,NER_CRUST, &
- NER_80_MOHO,NER_220_80,NER_400_220,NER_600_400,NER_670_600,NER_771_670, &
- NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
- NER_TOP_CENTRAL_CUBE_ICB,NEX_XI,NEX_ETA, &
- NPROC_XI,NPROC_ETA,NTSTEP_BETWEEN_OUTPUT_SEISMOS, &
- NTSTEP_BETWEEN_READ_ADJSRC,NSTEP,NSOURCES,NTSTEP_BETWEEN_FRAMES, &
- NTSTEP_BETWEEN_OUTPUT_INFO,NUMBER_OF_RUNS,NUMBER_OF_THIS_RUN,NCHUNKS,SIMULATION_TYPE, &
- MOVIE_VOLUME_TYPE,MOVIE_START,MOVIE_STOP,NOISE_TOMOGRAPHY
-
- double precision DT,ANGULAR_WIDTH_XI_IN_DEGREES,ANGULAR_WIDTH_ETA_IN_DEGREES,CENTER_LONGITUDE_IN_DEGREES, &
- CENTER_LATITUDE_IN_DEGREES,GAMMA_ROTATION_AZIMUTH,ROCEAN,RMIDDLE_CRUST, &
- RMOHO,R80,R120,R220,R400,R600,R670,R771,RTOPDDOUBLEPRIME,RCMB,RICB, &
- R_CENTRAL_CUBE,RHO_TOP_OC,RHO_BOTTOM_OC,RHO_OCEANS,HDUR_MOVIE, &
- MOVIE_TOP,MOVIE_BOTTOM,MOVIE_WEST,MOVIE_EAST,MOVIE_NORTH,MOVIE_SOUTH, &
- RMOHO_FICTITIOUS_IN_MESHER
-
- logical MOVIE_SURFACE,MOVIE_VOLUME,MOVIE_COARSE, &
- RECEIVERS_CAN_BE_BURIED,PRINT_SOURCE_TIME_FUNCTION, &
- SAVE_MESH_FILES,ABSORBING_CONDITIONS,INCLUDE_CENTRAL_CUBE,INFLATE_CENTRAL_CUBE,SAVE_FORWARD, &
- OUTPUT_SEISMOS_ASCII_TEXT,OUTPUT_SEISMOS_SAC_ALPHANUM,OUTPUT_SEISMOS_SAC_BINARY, &
- ROTATE_SEISMOGRAMS_RT,WRITE_SEISMOGRAMS_BY_MASTER,&
- SAVE_ALL_SEISMOS_IN_ONE_FILE,USE_BINARY_FOR_LARGE_FILE
-
- character(len=150) :: OUTPUT_FILES,LOCAL_PATH,LOCAL_TMP_PATH,MODEL
-
-! parameters deduced from parameters read from file
- integer NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube
-
- integer, external :: err_occurred
-
-! this for all the regions
- integer, dimension(MAX_NUM_REGIONS) :: NSPEC,NSPEC2D_XI,NSPEC2D_ETA, &
- NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX, &
- NSPEC2D_BOTTOM,NSPEC2D_TOP,NSPEC1D_RADIAL,NGLOB1D_RADIAL, &
- NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX, &
- NGLOB
-
-! computed in read_compute_parameters
- integer, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: ner,ratio_sampling_array
- integer, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: doubling_index
- double precision, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: r_bottom,r_top
- logical, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: this_region_has_a_doubling
- double precision, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: rmins,rmaxs
-
-! memory size of all the static arrays
- double precision :: static_memory_size
-
- integer :: ipass
-
- integer :: NSPECMAX_ANISO_IC,NSPECMAX_ISO_MANTLE,NSPECMAX_TISO_MANTLE, &
- NSPECMAX_ANISO_MANTLE,NSPEC_CRUST_MANTLE_ATTENUAT, &
- NSPEC_INNER_CORE_ATTENUATION, &
- NSPEC_CRUST_MANTLE_STR_OR_ATT,NSPEC_INNER_CORE_STR_OR_ATT, &
- NSPEC_CRUST_MANTLE_STR_AND_ATT,NSPEC_INNER_CORE_STR_AND_ATT, &
- NSPEC_CRUST_MANTLE_STRAIN_ONLY,NSPEC_INNER_CORE_STRAIN_ONLY, &
- NSPEC_CRUST_MANTLE_ADJOINT, &
- NSPEC_OUTER_CORE_ADJOINT,NSPEC_INNER_CORE_ADJOINT, &
- NGLOB_CRUST_MANTLE_ADJOINT,NGLOB_OUTER_CORE_ADJOINT, &
- NGLOB_INNER_CORE_ADJOINT,NSPEC_OUTER_CORE_ROT_ADJOINT, &
- NSPEC_CRUST_MANTLE_STACEY,NSPEC_OUTER_CORE_STACEY, &
- NGLOB_CRUST_MANTLE_OCEANS,NSPEC_OUTER_CORE_ROTATION
-
-! this for the different corners of the slice (which are different if the superbrick is cut)
-! 1 : xi_min, eta_min
-! 2 : xi_max, eta_min
-! 3 : xi_max, eta_max
-! 4 : xi_min, eta_max
- integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_CORNERS) :: NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER
-
-! 1 -> min, 2 -> max
- integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_EDGES_ONEDIR) :: NSPEC2D_XI_FACE,NSPEC2D_ETA_FACE
-
- integer, dimension(NB_SQUARE_CORNERS,NB_CUT_CASE) :: DIFF_NSPEC1D_RADIAL
- integer, dimension(NB_SQUARE_EDGES_ONEDIR,NB_CUT_CASE) :: DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA
- logical :: CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA
- integer, dimension(MAX_NUM_REGIONS) :: NGLOB1D_RADIAL_TEMP
-
-! this for non blocking MPI
- logical, dimension(:), allocatable :: is_on_a_slice_edge
-
! ************** PROGRAM STARTS HERE **************
!-------------------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------------------
@@ -436,7 +315,7 @@
!
! - read_compute_parameters.f90:
! some models need to explicitly set smaller time steps which
-! can be done in routine rcp_set_timestep_and_layers()
+! can be done in routine get_timestep_and_layers()
!
! - add your model implementation into a new file named model_***.f90:
! in general, this file should have as first routine the model_***_broadcast() routine
@@ -457,797 +336,23 @@
!-------------------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------------------
-! initialize the MPI communicator and start the NPROCTOT MPI processes.
+ ! initialize the MPI communicator and start the NPROCTOT MPI processes.
call MPI_INIT(ier)
-! sizeprocs returns number of processes started (should be equal to NPROCTOT).
-! myrank is the rank of each process, between 0 and NPROCTOT-1.
-! as usual in MPI, process 0 is in charge of coordinating everything
-! and also takes care of the main output
-! do not create anything for the inner core here, will be done in solver
- call MPI_COMM_SIZE(MPI_COMM_WORLD,sizeprocs,ier)
- call MPI_COMM_RANK(MPI_COMM_WORLD,myrank,ier)
+ ! initializes parameters
+ call initialize_mesher()
-! get the base pathname for output files
- call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
+ ! setup addressing and models
+ call setup_model()
-! 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')
+ ! creates meshes for regions crust/mantle, outer core and inner core
+ call create_meshes()
-! get MPI starting time
- time_start = MPI_WTIME()
+ ! outputs mesh infos and saves new header file
+ call finalize_mesher()
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) '****************************'
- write(IMAIN,*) '*** Specfem3D MPI Mesher ***'
- write(IMAIN,*) '****************************'
- write(IMAIN,*)
- endif
-
- if (myrank==0) then
- ! reads the parameter file and computes additional parameters
- call read_compute_parameters(MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD,NER_CRUST, &
- NER_80_MOHO,NER_220_80,NER_400_220,NER_600_400,NER_670_600,NER_771_670, &
- NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
- NER_TOP_CENTRAL_CUBE_ICB,NEX_XI,NEX_ETA,RMOHO_FICTITIOUS_IN_MESHER, &
- NPROC_XI,NPROC_ETA,NTSTEP_BETWEEN_OUTPUT_SEISMOS, &
- NTSTEP_BETWEEN_READ_ADJSRC,NSTEP,NTSTEP_BETWEEN_FRAMES, &
- NTSTEP_BETWEEN_OUTPUT_INFO,NUMBER_OF_RUNS,NUMBER_OF_THIS_RUN,NCHUNKS,DT, &
- ANGULAR_WIDTH_XI_IN_DEGREES,ANGULAR_WIDTH_ETA_IN_DEGREES,CENTER_LONGITUDE_IN_DEGREES, &
- CENTER_LATITUDE_IN_DEGREES,GAMMA_ROTATION_AZIMUTH,ROCEAN,RMIDDLE_CRUST, &
- RMOHO,R80,R120,R220,R400,R600,R670,R771,RTOPDDOUBLEPRIME,RCMB,RICB, &
- R_CENTRAL_CUBE,RHO_TOP_OC,RHO_BOTTOM_OC,RHO_OCEANS,HDUR_MOVIE,MOVIE_VOLUME_TYPE, &
- MOVIE_TOP,MOVIE_BOTTOM,MOVIE_WEST,MOVIE_EAST,MOVIE_NORTH,MOVIE_SOUTH,MOVIE_START,MOVIE_STOP, &
- TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE, &
- ANISOTROPIC_INNER_CORE,CRUSTAL,ELLIPTICITY,GRAVITY,ONE_CRUST, &
- ROTATION,ISOTROPIC_3D_MANTLE,HETEROGEN_3D_MANTLE,TOPOGRAPHY,OCEANS,MOVIE_SURFACE, &
- MOVIE_VOLUME,MOVIE_COARSE,ATTENUATION_3D,RECEIVERS_CAN_BE_BURIED, &
- PRINT_SOURCE_TIME_FUNCTION,SAVE_MESH_FILES, &
- ATTENUATION,REFERENCE_1D_MODEL,THREE_D_MODEL,ABSORBING_CONDITIONS, &
- INCLUDE_CENTRAL_CUBE,INFLATE_CENTRAL_CUBE, &
- LOCAL_PATH,LOCAL_TMP_PATH,MODEL, &
- SIMULATION_TYPE,SAVE_FORWARD, &
- NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
- NSPEC,NSPEC2D_XI,NSPEC2D_ETA,NSPEC2DMAX_XMIN_XMAX, &
- NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
- NSPEC1D_RADIAL,NGLOB1D_RADIAL,NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX,NGLOB, &
- ratio_sampling_array, ner, doubling_index,r_bottom,r_top,&
- this_region_has_a_doubling,rmins,rmaxs,CASE_3D, &
- OUTPUT_SEISMOS_ASCII_TEXT,OUTPUT_SEISMOS_SAC_ALPHANUM,OUTPUT_SEISMOS_SAC_BINARY, &
- ROTATE_SEISMOGRAMS_RT,ratio_divide_central_cube, &
- HONOR_1D_SPHERICAL_MOHO,CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA,&
- DIFF_NSPEC1D_RADIAL,DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA,&
- WRITE_SEISMOGRAMS_BY_MASTER,SAVE_ALL_SEISMOS_IN_ONE_FILE, &
- USE_BINARY_FOR_LARGE_FILE,.false.,NOISE_TOMOGRAPHY)
-
- if(err_occurred() /= 0) &
- call exit_MPI(myrank,'an error occurred while reading the parameter file')
-
- endif
-
- ! distributes parameters from master to all processes
- call broadcast_compute_parameters(myrank,MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD,NER_CRUST, &
- NER_80_MOHO,NER_220_80,NER_400_220,NER_600_400,NER_670_600,NER_771_670, &
- NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
- NER_TOP_CENTRAL_CUBE_ICB,NEX_XI,NEX_ETA, &
- NPROC_XI,NPROC_ETA,NTSTEP_BETWEEN_OUTPUT_SEISMOS, &
- NTSTEP_BETWEEN_READ_ADJSRC,NSTEP,NSOURCES,NTSTEP_BETWEEN_FRAMES, &
- NTSTEP_BETWEEN_OUTPUT_INFO,NUMBER_OF_RUNS,NUMBER_OF_THIS_RUN,NCHUNKS,SIMULATION_TYPE, &
- MOVIE_VOLUME_TYPE,MOVIE_START,MOVIE_STOP, &
- DT,ANGULAR_WIDTH_XI_IN_DEGREES,ANGULAR_WIDTH_ETA_IN_DEGREES,CENTER_LONGITUDE_IN_DEGREES, &
- CENTER_LATITUDE_IN_DEGREES,GAMMA_ROTATION_AZIMUTH,ROCEAN,RMIDDLE_CRUST, &
- RMOHO,R80,R120,R220,R400,R600,R670,R771,RTOPDDOUBLEPRIME,RCMB,RICB, &
- R_CENTRAL_CUBE,RHO_TOP_OC,RHO_BOTTOM_OC,RHO_OCEANS,HDUR_MOVIE, &
- MOVIE_TOP,MOVIE_BOTTOM,MOVIE_WEST,MOVIE_EAST,MOVIE_NORTH,MOVIE_SOUTH, &
- RMOHO_FICTITIOUS_IN_MESHER, &
- MOVIE_SURFACE,MOVIE_VOLUME,RECEIVERS_CAN_BE_BURIED,PRINT_SOURCE_TIME_FUNCTION, &
- SAVE_MESH_FILES,ABSORBING_CONDITIONS,INCLUDE_CENTRAL_CUBE,INFLATE_CENTRAL_CUBE,SAVE_FORWARD, &
- SAVE_ALL_SEISMOS_IN_ONE_FILE,MOVIE_COARSE,OUTPUT_SEISMOS_ASCII_TEXT, &
- OUTPUT_SEISMOS_SAC_ALPHANUM,OUTPUT_SEISMOS_SAC_BINARY, &
- ROTATE_SEISMOGRAMS_RT,WRITE_SEISMOGRAMS_BY_MASTER,USE_BINARY_FOR_LARGE_FILE, &
- LOCAL_PATH,LOCAL_TMP_PATH,MODEL, &
- NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
- NSPEC,NSPEC2D_XI,NSPEC2D_ETA, &
- NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
- NSPEC1D_RADIAL,NGLOB1D_RADIAL,NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX,NGLOB, &
- ratio_sampling_array, ner, doubling_index,r_bottom,r_top, &
- this_region_has_a_doubling,rmins,rmaxs, &
- ratio_divide_central_cube,CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, &
- DIFF_NSPEC1D_RADIAL,DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA, &
- REFERENCE_1D_MODEL,THREE_D_MODEL,ELLIPTICITY,GRAVITY,ROTATION,TOPOGRAPHY,OCEANS, &
- HONOR_1D_SPHERICAL_MOHO,CRUSTAL,ONE_CRUST,CASE_3D,TRANSVERSE_ISOTROPY, &
- ISOTROPIC_3D_MANTLE,ANISOTROPIC_3D_MANTLE,HETEROGEN_3D_MANTLE, &
- ATTENUATION,ATTENUATION_3D,ANISOTROPIC_INNER_CORE,NOISE_TOMOGRAPHY)
-
- ! check that the code is running with the requested number of processes
- if(sizeprocs /= NPROCTOT) call exit_MPI(myrank,'wrong number of MPI processes')
-
- ! compute rotation matrix from Euler angles
- ANGULAR_WIDTH_XI_RAD = ANGULAR_WIDTH_XI_IN_DEGREES * PI / 180.d0
- ANGULAR_WIDTH_ETA_RAD = ANGULAR_WIDTH_ETA_IN_DEGREES * PI / 180.d0
- if(NCHUNKS /= 6) call euler_angles(rotation_matrix,CENTER_LONGITUDE_IN_DEGREES,CENTER_LATITUDE_IN_DEGREES,GAMMA_ROTATION_AZIMUTH)
-
- ! dynamic allocation of mesh arrays
- allocate(addressing(NCHUNKS,0:NPROC_XI-1,0:NPROC_ETA-1))
- allocate(ichunk_slice(0:NPROCTOT-1))
- allocate(iproc_xi_slice(0:NPROCTOT-1))
- allocate(iproc_eta_slice(0:NPROCTOT-1))
-
- ! creates global slice addressing for solver
- call meshfem3D_create_addressing(myrank,NCHUNKS,NPROC,NPROC_ETA,NPROC_XI,NPROCTOT, &
- addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice, &
- OUTPUT_FILES)
-
-
- ! this for the different counters (which are now different if the superbrick is cut in the outer core)
- call meshfem3D_setup_counters(myrank, &
- NSPEC1D_RADIAL,NSPEC2D_XI,NSPEC2D_ETA,NGLOB1D_RADIAL, &
- DIFF_NSPEC1D_RADIAL,DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA, &
- CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, &
- NPROCTOT,iproc_xi_slice,iproc_eta_slice, &
- NSPEC1D_RADIAL_CORNER,NSPEC2D_XI_FACE, &
- NSPEC2D_ETA_FACE,NGLOB1D_RADIAL_CORNER)
-
- ! user output
- if(myrank == 0) call meshfem3D_output_info(myrank,sizeprocs,NEX_XI,NEX_ETA, &
- NPROC_XI,NPROC_ETA,NPROC,NCHUNKS,NPROCTOT, &
- R_CENTRAL_CUBE)
-
- ! distributes 3D models
- call meshfem3D_models_broadcast(myrank,NSPEC, &
- MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD,&
- R80,R220,R670,RCMB,RICB, &
- LOCAL_PATH)
-
-
- if(myrank == 0 ) then
- write(IMAIN,*)
- write(IMAIN,*) 'model setup successfully read in'
- write(IMAIN,*)
- endif
-
- ! get addressing for this process
- ichunk = ichunk_slice(myrank)
- iproc_xi = iproc_xi_slice(myrank)
- iproc_eta = iproc_eta_slice(myrank)
-
- ! volume of the slice
- volume_total = ZERO
-
- ! make sure everybody is synchronized
- call MPI_BARRIER(MPI_COMM_WORLD,ier)
-
-!----
-!---- loop on all the regions of the mesh
-!----
-
- ! number of regions in full Earth
- do iregion_code = 1,MAX_NUM_REGIONS
-
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) '*******************************************'
- write(IMAIN,*) 'creating mesh in region ',iregion_code
- select case(iregion_code)
- case(IREGION_CRUST_MANTLE)
- write(IMAIN,*) 'this region is the crust and mantle'
- case(IREGION_OUTER_CORE)
- write(IMAIN,*) 'this region is the outer core'
- case(IREGION_INNER_CORE)
- write(IMAIN,*) 'this region is the inner core'
- case default
- call exit_MPI(myrank,'incorrect region code')
- end select
- write(IMAIN,*) '*******************************************'
- write(IMAIN,*)
- endif
-
- ! compute maximum number of points
- npointot = NSPEC(iregion_code) * NGLLX * NGLLY * NGLLZ
-
- ! use dynamic allocation to allocate memory for arrays
- allocate(idoubling(NSPEC(iregion_code)))
- allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)))
- allocate(xstore(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)))
- allocate(ystore(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)))
- allocate(zstore(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)))
-
-! this for non blocking MPI
- allocate(is_on_a_slice_edge(NSPEC(iregion_code)))
-
- ! create all the regions of the mesh
- ! perform two passes in this part to be able to save memory
- do ipass = 1,2
-
- call create_regions_mesh(iregion_code,ibool,idoubling,is_on_a_slice_edge, &
- xstore,ystore,zstore,rmins,rmaxs, &
- iproc_xi,iproc_eta,ichunk,NSPEC(iregion_code),nspec_tiso, &
- volume_local,area_local_bottom,area_local_top, &
- nglob(iregion_code),npointot, &
- NSTEP,DT, &
- NEX_XI,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
- NSPEC2DMAX_XMIN_XMAX(iregion_code),NSPEC2DMAX_YMIN_YMAX(iregion_code), &
- NSPEC2D_BOTTOM(iregion_code),NSPEC2D_TOP(iregion_code), &
- NPROC_XI,NPROC_ETA,NSPEC2D_XI_FACE, &
- NSPEC2D_ETA_FACE,NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER, &
- myrank,LOCAL_PATH,rotation_matrix,ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD, &
- SAVE_MESH_FILES,NCHUNKS,INCLUDE_CENTRAL_CUBE,ABSORBING_CONDITIONS, &
- R_CENTRAL_CUBE,RICB,RHO_OCEANS,RCMB,R670,RMOHO,RMOHO_FICTITIOUS_IN_MESHER,&
- RTOPDDOUBLEPRIME,R600,R220,R771,R400,R120,R80,RMIDDLE_CRUST,ROCEAN, &
- ner,ratio_sampling_array,doubling_index,r_bottom,r_top,&
- this_region_has_a_doubling,ipass,ratio_divide_central_cube, &
- CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, &
- mod(iproc_xi_slice(myrank),2),mod(iproc_eta_slice(myrank),2))
-
- enddo
-
- ! checks number of anisotropic elements found in the mantle
- if(iregion_code /= IREGION_CRUST_MANTLE .and. nspec_tiso /= 0 ) &
- call exit_MPI(myrank,'found anisotropic elements outside of the mantle')
-
- if( TRANSVERSE_ISOTROPY ) then
- if(iregion_code == IREGION_CRUST_MANTLE .and. nspec_tiso == 0) &
- call exit_MPI(myrank,'found no anisotropic elements in the mantle')
- endif
-
- ! computes total area and volume
- call meshfem3D_compute_area(myrank,NCHUNKS,iregion_code, &
- area_local_bottom,area_local_top,&
- volume_local,volume_total, &
- RCMB,RICB,R_CENTRAL_CUBE)
-
- ! create chunk buffers if more than one chunk
- if(NCHUNKS > 1) then
- call create_chunk_buffers(iregion_code,NSPEC(iregion_code),ibool,idoubling, &
- xstore,ystore,zstore, &
- nglob(iregion_code), &
- NSPEC2DMAX_XMIN_XMAX(iregion_code),NSPEC2DMAX_YMIN_YMAX(iregion_code), &
- NPROC_XI,NPROC_ETA,NPROC,NPROCTOT, &
- NGLOB1D_RADIAL_CORNER,maxval(NGLOB1D_RADIAL_CORNER(iregion_code,:)), &
- NGLOB2DMAX_XMIN_XMAX(iregion_code),NGLOB2DMAX_YMIN_YMAX(iregion_code), &
- myrank,LOCAL_PATH,addressing, &
- ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS)
- else
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) 'only one chunk, no need to create chunk buffers'
- write(IMAIN,*)
- endif
- endif
-
- ! deallocate arrays used for that region
- deallocate(idoubling)
- deallocate(ibool)
- deallocate(xstore)
- deallocate(ystore)
- deallocate(zstore)
-
-! this for non blocking MPI
- deallocate(is_on_a_slice_edge)
-
- ! make sure everybody is synchronized
- call MPI_BARRIER(MPI_COMM_WORLD,ier)
-
-! end of loop on all the regions
- enddo
-
- if(myrank == 0) then
- ! check volume of chunk
- write(IMAIN,*)
- write(IMAIN,*) 'calculated volume: ',volume_total
- if(.not. TOPOGRAPHY) then
- ! take the central cube into account
- ! it is counted 6 times because of the fictitious elements
- if(INCLUDE_CENTRAL_CUBE) then
- write(IMAIN,*) ' exact volume: ', &
- dble(NCHUNKS)*((4.0d0/3.0d0)*PI*(R_UNIT_SPHERE**3)+5.*(2.*(R_CENTRAL_CUBE/R_EARTH)/sqrt(3.))**3)/6.d0
- else
- write(IMAIN,*) ' exact volume: ', &
- dble(NCHUNKS)*((4.0d0/3.0d0)*PI*(R_UNIT_SPHERE**3)-(2.*(R_CENTRAL_CUBE/R_EARTH)/sqrt(3.))**3)/6.d0
- endif
- endif
- endif
-
-
-!--- print number of points and elements in the mesh for each region
-
- if(myrank == 0) then
-
- numelem_crust_mantle = NSPEC(IREGION_CRUST_MANTLE)
- numelem_outer_core = NSPEC(IREGION_OUTER_CORE)
- numelem_inner_core = NSPEC(IREGION_INNER_CORE)
-
- numelem_total = numelem_crust_mantle + numelem_outer_core + numelem_inner_core
-
- write(IMAIN,*)
- write(IMAIN,*) 'Repartition of elements in regions:'
- write(IMAIN,*) '----------------------------------'
- write(IMAIN,*)
- write(IMAIN,*) 'total number of elements in each slice: ',numelem_total
- write(IMAIN,*)
- write(IMAIN,*) ' - crust and mantle: ',sngl(100.d0*dble(numelem_crust_mantle)/dble(numelem_total)),' %'
- write(IMAIN,*) ' - outer core: ',sngl(100.d0*dble(numelem_outer_core)/dble(numelem_total)),' %'
- write(IMAIN,*) ' - inner core: ',sngl(100.d0*dble(numelem_inner_core)/dble(numelem_total)),' %'
- write(IMAIN,*)
- write(IMAIN,*) 'for some mesh statistics, see comments in file OUTPUT_FILES/values_from_mesher.h'
- write(IMAIN,*)
-
- ! load balancing
- write(IMAIN,*) 'Load balancing = 100 % by definition'
- write(IMAIN,*)
-
- write(IMAIN,*)
- write(IMAIN,*) 'total number of time steps in the solver will be: ',NSTEP
- write(IMAIN,*)
-
- write(IMAIN,*)
- write(IMAIN,*) 'time-stepping of the solver will be: ',DT
- 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,*)
-
- ! evaluate the amount of static memory needed by the solver
- call memory_eval(OCEANS,ABSORBING_CONDITIONS,ATTENUATION,ANISOTROPIC_3D_MANTLE,&
- TRANSVERSE_ISOTROPY,ANISOTROPIC_INNER_CORE,ROTATION,&
- ONE_CRUST,doubling_index,this_region_has_a_doubling,&
- ner,NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_sampling_array,&
- NSPEC,nglob,SIMULATION_TYPE,MOVIE_VOLUME,SAVE_FORWARD, &
- NSPECMAX_ANISO_IC,NSPECMAX_ISO_MANTLE,NSPECMAX_TISO_MANTLE, &
- NSPECMAX_ANISO_MANTLE,NSPEC_CRUST_MANTLE_ATTENUAT, &
- NSPEC_INNER_CORE_ATTENUATION, &
- NSPEC_CRUST_MANTLE_STR_OR_ATT,NSPEC_INNER_CORE_STR_OR_ATT, &
- NSPEC_CRUST_MANTLE_STR_AND_ATT,NSPEC_INNER_CORE_STR_AND_ATT, &
- NSPEC_CRUST_MANTLE_STRAIN_ONLY,NSPEC_INNER_CORE_STRAIN_ONLY, &
- NSPEC_CRUST_MANTLE_ADJOINT, &
- NSPEC_OUTER_CORE_ADJOINT,NSPEC_INNER_CORE_ADJOINT, &
- NGLOB_CRUST_MANTLE_ADJOINT,NGLOB_OUTER_CORE_ADJOINT, &
- NGLOB_INNER_CORE_ADJOINT,NSPEC_OUTER_CORE_ROT_ADJOINT, &
- NSPEC_CRUST_MANTLE_STACEY,NSPEC_OUTER_CORE_STACEY, &
- NGLOB_CRUST_MANTLE_OCEANS,NSPEC_OUTER_CORE_ROTATION,static_memory_size)
-
- NGLOB1D_RADIAL_TEMP(:) = &
- (/maxval(NGLOB1D_RADIAL_CORNER(1,:)),maxval(NGLOB1D_RADIAL_CORNER(2,:)),maxval(NGLOB1D_RADIAL_CORNER(3,:))/)
-
- ! create include file for the solver
- call save_header_file(NSPEC,nglob,NEX_XI,NEX_ETA,NPROC,NPROCTOT, &
- TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE,ANISOTROPIC_INNER_CORE, &
- ELLIPTICITY,GRAVITY,ROTATION,OCEANS,ATTENUATION,ATTENUATION_3D, &
- ANGULAR_WIDTH_XI_IN_DEGREES,ANGULAR_WIDTH_ETA_IN_DEGREES,NCHUNKS, &
- INCLUDE_CENTRAL_CUBE,CENTER_LONGITUDE_IN_DEGREES,&
- CENTER_LATITUDE_IN_DEGREES,GAMMA_ROTATION_AZIMUTH,NSOURCES,NSTEP, &
- static_memory_size,NGLOB1D_RADIAL_TEMP, &
- NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX,NSPEC2D_TOP,NSPEC2D_BOTTOM, &
- NSPEC2DMAX_YMIN_YMAX,NSPEC2DMAX_XMIN_XMAX, &
- NPROC_XI,NPROC_ETA, &
- NSPECMAX_ANISO_IC,NSPECMAX_ISO_MANTLE,NSPECMAX_TISO_MANTLE, &
- NSPECMAX_ANISO_MANTLE,NSPEC_CRUST_MANTLE_ATTENUAT, &
- NSPEC_INNER_CORE_ATTENUATION, &
- NSPEC_CRUST_MANTLE_STR_OR_ATT,NSPEC_INNER_CORE_STR_OR_ATT, &
- NSPEC_CRUST_MANTLE_STR_AND_ATT,NSPEC_INNER_CORE_STR_AND_ATT, &
- NSPEC_CRUST_MANTLE_STRAIN_ONLY,NSPEC_INNER_CORE_STRAIN_ONLY, &
- NSPEC_CRUST_MANTLE_ADJOINT, &
- NSPEC_OUTER_CORE_ADJOINT,NSPEC_INNER_CORE_ADJOINT, &
- NGLOB_CRUST_MANTLE_ADJOINT,NGLOB_OUTER_CORE_ADJOINT, &
- NGLOB_INNER_CORE_ADJOINT,NSPEC_OUTER_CORE_ROT_ADJOINT, &
- NSPEC_CRUST_MANTLE_STACEY,NSPEC_OUTER_CORE_STACEY, &
- NGLOB_CRUST_MANTLE_OCEANS,NSPEC_OUTER_CORE_ROTATION, &
- SIMULATION_TYPE,SAVE_FORWARD,MOVIE_VOLUME,NOISE_TOMOGRAPHY)
-
- endif ! end of section executed by main process only
-
- ! deallocate arrays used for mesh generation
- deallocate(addressing)
- deallocate(ichunk_slice)
- deallocate(iproc_xi_slice)
- deallocate(iproc_eta_slice)
-
- ! elapsed time since beginning of mesh generation
- if(myrank == 0) then
- tCPU = MPI_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,*)
- ! close main output file
- close(IMAIN)
- endif
-
- ! synchronize all the processes to make sure everybody has finished
- call MPI_BARRIER(MPI_COMM_WORLD,ier)
-
! stop all the MPI processes, and exit
call MPI_FINALIZE(ier)
end program xmeshfem3D
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine meshfem3D_create_addressing(myrank,NCHUNKS,NPROC,NPROC_ETA,NPROC_XI,NPROCTOT, &
- addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice, &
- OUTPUT_FILES)
-
- implicit none
-
- include "constants.h"
-
- integer :: myrank,NCHUNKS,NPROC,NPROC_ETA,NPROC_XI,NPROCTOT
-
- integer, dimension(NCHUNKS,0:NPROC_XI-1,0:NPROC_ETA-1) :: addressing
- integer, dimension(0:NPROCTOT-1) :: ichunk_slice,iproc_xi_slice,iproc_eta_slice
-
- character(len=150) OUTPUT_FILES
-
- ! local parameters
- integer ichunk,iproc_eta,iproc_xi,iprocnum,ier
-
- ! initializes
- addressing(:,:,:) = 0
- ichunk_slice(:) = 0
- iproc_xi_slice(:) = 0
- iproc_eta_slice(:) = 0
-
- ! loop on all the chunks to create global slice addressing for solver
- if(myrank == 0) then
- open(unit=IOUT,file=trim(OUTPUT_FILES)//'/addressing.txt',status='unknown',iostat=ier)
- if( ier /= 0 ) call exit_mpi(myrank,'error opening addressing.txt')
- write(IMAIN,*) 'creating global slice addressing'
- write(IMAIN,*)
- endif
-
- do ichunk = 1,NCHUNKS
- do iproc_eta=0,NPROC_ETA-1
- do iproc_xi=0,NPROC_XI-1
- iprocnum = (ichunk-1)*NPROC + iproc_eta * NPROC_XI + iproc_xi
- addressing(ichunk,iproc_xi,iproc_eta) = iprocnum
- ichunk_slice(iprocnum) = ichunk
- iproc_xi_slice(iprocnum) = iproc_xi
- iproc_eta_slice(iprocnum) = iproc_eta
- if(myrank == 0) write(IOUT,*) iprocnum,ichunk,iproc_xi,iproc_eta
- enddo
- enddo
- enddo
-
- if(myrank == 0) close(IOUT)
-
- end subroutine meshfem3D_create_addressing
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-
- subroutine meshfem3D_setup_counters(myrank, &
- NSPEC1D_RADIAL,NSPEC2D_XI,NSPEC2D_ETA,NGLOB1D_RADIAL, &
- DIFF_NSPEC1D_RADIAL,DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA, &
- CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, &
- NPROCTOT,iproc_xi_slice,iproc_eta_slice, &
- NSPEC1D_RADIAL_CORNER,NSPEC2D_XI_FACE, &
- NSPEC2D_ETA_FACE,NGLOB1D_RADIAL_CORNER)
-
-! returns: NSPEC1D_RADIAL_CORNER,NSPEC2D_XI_FACE,
-! NSPEC2D_ETA_FACE,NGLOB1D_RADIAL_CORNER
-
- implicit none
-
- include "constants.h"
-
- integer myrank
-
-! this for all the regions
- integer, dimension(MAX_NUM_REGIONS) :: NSPEC2D_XI,NSPEC2D_ETA, &
- NSPEC1D_RADIAL,NGLOB1D_RADIAL
-
- integer, dimension(NB_SQUARE_CORNERS,NB_CUT_CASE) :: DIFF_NSPEC1D_RADIAL
- integer, dimension(NB_SQUARE_EDGES_ONEDIR,NB_CUT_CASE) :: DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA
-
- ! addressing for all the slices
- integer :: NPROCTOT
- integer, dimension(0:NPROCTOT-1) :: iproc_xi_slice,iproc_eta_slice
-
- logical :: CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA
-
-! this for the different corners of the slice (which are different if the superbrick is cut)
-! 1 : xi_min, eta_min
-! 2 : xi_max, eta_min
-! 3 : xi_max, eta_max
-! 4 : xi_min, eta_max
- integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_CORNERS) :: &
- NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER
-! 1 -> min, 2 -> max
- integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_EDGES_ONEDIR) :: NSPEC2D_XI_FACE,NSPEC2D_ETA_FACE
-
-
- ! local parameters
- integer :: iregion
-
- do iregion=1,MAX_NUM_REGIONS
- NSPEC1D_RADIAL_CORNER(iregion,:) = NSPEC1D_RADIAL(iregion)
- NSPEC2D_XI_FACE(iregion,:) = NSPEC2D_XI(iregion)
- NSPEC2D_ETA_FACE(iregion,:) = NSPEC2D_ETA(iregion)
- NGLOB1D_RADIAL_CORNER(iregion,:) = NGLOB1D_RADIAL(iregion)
- enddo
-
- if (CUT_SUPERBRICK_XI) then
- if (CUT_SUPERBRICK_ETA) then
- if (mod(iproc_xi_slice(myrank),2) == 0) then
- if (mod(iproc_eta_slice(myrank),2) == 0) then
- NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,1)
- NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,1)
- NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,1)
- NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
- + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,2)
- NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,2)
- NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,2)
- NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
- + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- else
- if (mod(iproc_eta_slice(myrank),2) == 0) then
- NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,3)
- NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,3)
- NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,3)
- NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
- + (DIFF_NSPEC1D_RADIAL(:,3)*(NGLLZ-1))
- else
- NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,4)
- NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,4)
- NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,4)
- NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
- + (DIFF_NSPEC1D_RADIAL(:,4)*(NGLLZ-1))
- endif
- endif
- else
- if (mod(iproc_xi_slice(myrank),2) == 0) then
- NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,1)
- NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,1)
- NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,1)
- NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
- + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,2)
- NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,2)
- NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,2)
- NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
- + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- endif
- else
- if (CUT_SUPERBRICK_ETA) then
- if (mod(iproc_eta_slice(myrank),2) == 0) then
- NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,1)
- NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,1)
- NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,1)
- NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
- + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,2)
- NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,2)
- NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,2)
- NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
- + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- endif
- endif
-
- end subroutine meshfem3D_setup_counters
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine meshfem3D_output_info(myrank,sizeprocs,NEX_XI,NEX_ETA, &
- NPROC_XI,NPROC_ETA,NPROC,NCHUNKS,NPROCTOT,&
- R_CENTRAL_CUBE)
-
- use meshfem3D_models_par
-
- implicit none
-
- integer :: myrank,sizeprocs,NEX_XI,NEX_ETA, &
- NPROC_XI,NPROC_ETA,NPROC,NCHUNKS,NPROCTOT
- double precision :: R_CENTRAL_CUBE
-
- 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 are ',NEX_XI,' elements along xi in each chunk'
- write(IMAIN,*) 'There are ',NEX_ETA,' elements along eta in each chunk'
- write(IMAIN,*)
- write(IMAIN,*) 'There are ',NPROC_XI,' slices along xi in each chunk'
- write(IMAIN,*) 'There are ',NPROC_ETA,' slices along eta in each chunk'
- write(IMAIN,*) 'There is a total of ',NPROC,' slices in each chunk'
- write(IMAIN,*) 'There are ',NCHUNKS,' chunks in the global mesh'
- write(IMAIN,*) 'There is a total of ',NPROCTOT,' slices in the global mesh'
- 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,*)
- write(IMAIN,*)
- write(IMAIN,*)
- if(ELLIPTICITY) then
- write(IMAIN,*) 'incorporating ellipticity'
- else
- write(IMAIN,*) 'no ellipticity'
- endif
- write(IMAIN,*)
- if(TOPOGRAPHY) then
- write(IMAIN,*) 'incorporating surface topography'
- else
- write(IMAIN,*) 'no surface topography'
- endif
- write(IMAIN,*)
- if(ISOTROPIC_3D_MANTLE) then
- write(IMAIN,*) 'incorporating 3-D lateral variations'
- else
- write(IMAIN,*) 'no 3-D lateral variations'
- endif
- write(IMAIN,*)
- if(HETEROGEN_3D_MANTLE) then
- write(IMAIN,*) 'incorporating heterogeneities in the mantle'
- else
- write(IMAIN,*) 'no heterogeneities in the mantle'
- endif
- write(IMAIN,*)
- if(CRUSTAL) then
- write(IMAIN,*) 'incorporating crustal variations'
- else
- write(IMAIN,*) 'no crustal variations'
- endif
- write(IMAIN,*)
- if(ONE_CRUST) then
- write(IMAIN,*) 'using one layer only in PREM crust'
- else
- write(IMAIN,*) 'using unmodified 1D crustal model with two layers'
- endif
- write(IMAIN,*)
- if(GRAVITY) then
- write(IMAIN,*) 'incorporating self-gravitation (Cowling approximation)'
- else
- write(IMAIN,*) 'no self-gravitation'
- endif
- write(IMAIN,*)
- if(ROTATION) then
- write(IMAIN,*) 'incorporating rotation'
- else
- write(IMAIN,*) 'no rotation'
- endif
- write(IMAIN,*)
- if(TRANSVERSE_ISOTROPY) then
- write(IMAIN,*) 'incorporating anisotropy'
- else
- write(IMAIN,*) 'no anisotropy'
- endif
- write(IMAIN,*)
- if(ATTENUATION) then
- write(IMAIN,*) 'incorporating attenuation using ',N_SLS,' standard linear solids'
- if(ATTENUATION_3D) write(IMAIN,*)'using 3D attenuation'
- else
- write(IMAIN,*) 'no attenuation'
- endif
- write(IMAIN,*)
- if(OCEANS) then
- write(IMAIN,*) 'incorporating the oceans using equivalent load'
- else
- write(IMAIN,*) 'no oceans'
- endif
- write(IMAIN,*)
- if(ANISOTROPIC_INNER_CORE) then
- write(IMAIN,*) 'incorporating anisotropic inner core'
- else
- write(IMAIN,*) 'no inner-core anisotropy'
- endif
- write(IMAIN,*)
- if(ANISOTROPIC_3D_MANTLE) then
- write(IMAIN,*) 'incorporating anisotropic mantle'
- else
- write(IMAIN,*) 'no general mantle anisotropy'
- endif
- write(IMAIN,*)
- write(IMAIN,*) 'Reference radius of the Earth used is ',R_EARTH_KM,' km'
- write(IMAIN,*)
- write(IMAIN,*) 'Central cube is at a radius of ',R_CENTRAL_CUBE/1000.d0,' km'
-
- end subroutine meshfem3D_output_info
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine meshfem3D_compute_area(myrank,NCHUNKS,iregion_code, &
- area_local_bottom,area_local_top,&
- volume_local,volume_total, &
- RCMB,RICB,R_CENTRAL_CUBE)
-
- use meshfem3D_models_par
-
- implicit none
-
- include 'mpif.h'
-
- integer :: myrank,NCHUNKS,iregion_code
-
- double precision :: area_local_bottom,area_local_top,volume_local
- double precision :: volume_total
- double precision :: RCMB,RICB,R_CENTRAL_CUBE
-
- ! local parameters
- double precision :: volume_total_region,area_total_bottom,area_total_top
- integer :: ier
-
- ! use MPI reduction to compute total area and volume
- volume_total_region = ZERO
- area_total_bottom = ZERO
- area_total_top = ZERO
- call MPI_REDUCE(area_local_bottom,area_total_bottom,1,MPI_DOUBLE_PRECISION,MPI_SUM,0, &
- MPI_COMM_WORLD,ier)
- call MPI_REDUCE(area_local_top,area_total_top,1,MPI_DOUBLE_PRECISION,MPI_SUM,0, &
- MPI_COMM_WORLD,ier)
- call MPI_REDUCE(volume_local,volume_total_region,1,MPI_DOUBLE_PRECISION,MPI_SUM,0, &
- MPI_COMM_WORLD,ier)
-
- if(myrank == 0) then
- ! sum volume over all the regions
- volume_total = volume_total + volume_total_region
-
- ! check volume of chunk, and bottom and top area
- write(IMAIN,*)
- write(IMAIN,*) ' calculated top area: ',area_total_top
-
- ! compare to exact theoretical value
- if(NCHUNKS == 6 .and. .not. TOPOGRAPHY) then
- select case(iregion_code)
- case(IREGION_CRUST_MANTLE)
- write(IMAIN,*) ' exact area: ',dble(NCHUNKS)*(4.0d0/6.0d0)*PI*R_UNIT_SPHERE**2
- case(IREGION_OUTER_CORE)
- write(IMAIN,*) ' exact area: ',dble(NCHUNKS)*(4.0d0/6.0d0)*PI*(RCMB/R_EARTH)**2
- case(IREGION_INNER_CORE)
- write(IMAIN,*) ' exact area: ',dble(NCHUNKS)*(4.0d0/6.0d0)*PI*(RICB/R_EARTH)**2
- case default
- call exit_MPI(myrank,'incorrect region code')
- end select
- endif
-
- write(IMAIN,*)
- write(IMAIN,*) 'calculated bottom area: ',area_total_bottom
-
- ! compare to exact theoretical value
- if(NCHUNKS == 6 .and. .not. TOPOGRAPHY) then
- select case(iregion_code)
- case(IREGION_CRUST_MANTLE)
- write(IMAIN,*) ' exact area: ',dble(NCHUNKS)*(4.0d0/6.0d0)*PI*(RCMB/R_EARTH)**2
- case(IREGION_OUTER_CORE)
- write(IMAIN,*) ' exact area: ',dble(NCHUNKS)*(4.0d0/6.0d0)*PI*(RICB/R_EARTH)**2
- case(IREGION_INNER_CORE)
- write(IMAIN,*) ' similar area (central cube): ',dble(NCHUNKS)*(2.*(R_CENTRAL_CUBE / R_EARTH)/sqrt(3.))**2
- case default
- call exit_MPI(myrank,'incorrect region code')
- end select
- endif
-
- endif
-
-
- end subroutine meshfem3D_compute_area
-
-
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/meshfem3D_par.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/meshfem3D_par.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/meshfem3D_par.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,160 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+!
+! United States and French Government Sponsorship Acknowledged.
+
+module meshfem3D_par
+
+! main parameter module for specfem simulations
+
+ use meshfem3D_models_par
+
+ implicit none
+
+ ! correct number of spectral elements in each block depending on chunk type
+ integer nspec_tiso,npointot
+
+ ! parameters needed to store the radii of the grid points
+ ! in the spherically symmetric Earth
+ integer, dimension(:), allocatable :: idoubling
+ 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
+
+ ! check area and volume of the final mesh
+ double precision area_local_bottom
+ double precision area_local_top
+ double precision volume_local,volume_total
+
+ !integer iprocnum
+
+ ! for loop on all the slices
+ integer iregion_code
+ integer iproc_xi,iproc_eta,ichunk
+
+ ! rotation matrix from Euler angles
+ double precision, dimension(NDIM,NDIM) :: rotation_matrix
+
+ double precision ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD
+
+ ! for some statistics for the mesh
+ integer numelem_crust_mantle,numelem_outer_core,numelem_inner_core
+ integer numelem_total
+
+ ! timer MPI
+ double precision time_start,tCPU
+
+ ! addressing for all the slices
+ integer, dimension(:), allocatable :: ichunk_slice,iproc_xi_slice,iproc_eta_slice
+ integer, dimension(:,:,:), allocatable :: addressing
+
+ ! parameters read from parameter file
+ integer MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD,NER_CRUST, &
+ NER_80_MOHO,NER_220_80,NER_400_220,NER_600_400,NER_670_600,NER_771_670, &
+ NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
+ NER_TOP_CENTRAL_CUBE_ICB,NEX_XI,NEX_ETA, &
+ NPROC_XI,NPROC_ETA,NTSTEP_BETWEEN_OUTPUT_SEISMOS, &
+ NTSTEP_BETWEEN_READ_ADJSRC,NSTEP,NSOURCES,NTSTEP_BETWEEN_FRAMES, &
+ NTSTEP_BETWEEN_OUTPUT_INFO,NUMBER_OF_RUNS,NUMBER_OF_THIS_RUN,NCHUNKS,SIMULATION_TYPE, &
+ MOVIE_VOLUME_TYPE,MOVIE_START,MOVIE_STOP,NOISE_TOMOGRAPHY
+
+ double precision DT,ANGULAR_WIDTH_XI_IN_DEGREES,ANGULAR_WIDTH_ETA_IN_DEGREES,CENTER_LONGITUDE_IN_DEGREES, &
+ CENTER_LATITUDE_IN_DEGREES,GAMMA_ROTATION_AZIMUTH,ROCEAN,RMIDDLE_CRUST, &
+ RMOHO,R80,R120,R220,R400,R600,R670,R771,RTOPDDOUBLEPRIME,RCMB,RICB, &
+ R_CENTRAL_CUBE,RHO_TOP_OC,RHO_BOTTOM_OC,RHO_OCEANS,HDUR_MOVIE, &
+ MOVIE_TOP,MOVIE_BOTTOM,MOVIE_WEST,MOVIE_EAST,MOVIE_NORTH,MOVIE_SOUTH, &
+ RMOHO_FICTITIOUS_IN_MESHER
+
+ logical MOVIE_SURFACE,MOVIE_VOLUME,MOVIE_COARSE, &
+ RECEIVERS_CAN_BE_BURIED,PRINT_SOURCE_TIME_FUNCTION, &
+ SAVE_MESH_FILES,ABSORBING_CONDITIONS,INCLUDE_CENTRAL_CUBE,INFLATE_CENTRAL_CUBE,SAVE_FORWARD, &
+ OUTPUT_SEISMOS_ASCII_TEXT,OUTPUT_SEISMOS_SAC_ALPHANUM,OUTPUT_SEISMOS_SAC_BINARY, &
+ ROTATE_SEISMOGRAMS_RT,WRITE_SEISMOGRAMS_BY_MASTER,&
+ SAVE_ALL_SEISMOS_IN_ONE_FILE,USE_BINARY_FOR_LARGE_FILE
+
+ character(len=150) :: OUTPUT_FILES,LOCAL_PATH,LOCAL_TMP_PATH,MODEL
+
+ ! parameters deduced from parameters read from file
+ integer NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube
+
+ integer, external :: err_occurred
+
+ ! this for all the regions
+ integer, dimension(MAX_NUM_REGIONS) :: NSPEC,NSPEC2D_XI,NSPEC2D_ETA, &
+ NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX, &
+ NSPEC2D_BOTTOM,NSPEC2D_TOP,NSPEC1D_RADIAL,NGLOB1D_RADIAL, &
+ NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX, &
+ NGLOB
+
+ ! computed in read_compute_parameters
+ integer, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: ner,ratio_sampling_array
+ integer, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: doubling_index
+ double precision, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: r_bottom,r_top
+ logical, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: this_region_has_a_doubling
+ double precision, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: rmins,rmaxs
+
+ ! memory size of all the static arrays
+ double precision :: static_memory_size
+
+ integer :: ipass
+
+ integer :: NSPECMAX_ANISO_IC,NSPECMAX_ISO_MANTLE,NSPECMAX_TISO_MANTLE, &
+ NSPECMAX_ANISO_MANTLE,NSPEC_CRUST_MANTLE_ATTENUAT, &
+ NSPEC_INNER_CORE_ATTENUATION, &
+ NSPEC_CRUST_MANTLE_STR_OR_ATT,NSPEC_INNER_CORE_STR_OR_ATT, &
+ NSPEC_CRUST_MANTLE_STR_AND_ATT,NSPEC_INNER_CORE_STR_AND_ATT, &
+ NSPEC_CRUST_MANTLE_STRAIN_ONLY,NSPEC_INNER_CORE_STRAIN_ONLY, &
+ NSPEC_CRUST_MANTLE_ADJOINT, &
+ NSPEC_OUTER_CORE_ADJOINT,NSPEC_INNER_CORE_ADJOINT, &
+ NGLOB_CRUST_MANTLE_ADJOINT,NGLOB_OUTER_CORE_ADJOINT, &
+ NGLOB_INNER_CORE_ADJOINT,NSPEC_OUTER_CORE_ROT_ADJOINT, &
+ NSPEC_CRUST_MANTLE_STACEY,NSPEC_OUTER_CORE_STACEY, &
+ NGLOB_CRUST_MANTLE_OCEANS,NSPEC_OUTER_CORE_ROTATION
+
+ ! this for the different corners of the slice (which are different if the superbrick is cut)
+ ! 1 : xi_min, eta_min
+ ! 2 : xi_max, eta_min
+ ! 3 : xi_max, eta_max
+ ! 4 : xi_min, eta_max
+ integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_CORNERS) :: NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER
+
+ ! 1 -> min, 2 -> max
+ integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_EDGES_ONEDIR) :: NSPEC2D_XI_FACE,NSPEC2D_ETA_FACE
+
+ integer, dimension(NB_SQUARE_CORNERS,NB_CUT_CASE) :: DIFF_NSPEC1D_RADIAL
+ integer, dimension(NB_SQUARE_EDGES_ONEDIR,NB_CUT_CASE) :: DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA
+ logical :: CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA
+ integer, dimension(MAX_NUM_REGIONS) :: NGLOB1D_RADIAL_TEMP
+
+ ! this for non blocking MPI
+ logical, dimension(:), allocatable :: is_on_a_slice_edge
+
+end module meshfem3D_par
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/save_arrays_solver.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/save_arrays_solver.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/save_arrays_solver.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -25,7 +25,7 @@
!
!=====================================================================
- subroutine save_arrays_solver(rho_vp,rho_vs,nspec_stacey, &
+ subroutine save_arrays_solver(myrank,rho_vp,rho_vs,nspec_stacey, &
prname,iregion_code,xixstore,xiystore,xizstore, &
etaxstore,etaystore,etazstore,gammaxstore,gammaystore,gammazstore, &
xstore,ystore,zstore,rhostore,dvpstore, &
@@ -50,50 +50,31 @@
include "constants.h"
-! model_attenuation_variables
-! type model_attenuation_variables
-! sequence
-! double precision min_period, max_period
-! double precision :: QT_c_source ! Source Frequency
-! double precision, dimension(:), pointer :: Qtau_s ! tau_sigma
-! double precision, dimension(:), pointer :: QrDisc ! Discontinutitues Defined
-! double precision, dimension(:), pointer :: Qr ! Radius
-! double precision, dimension(:), pointer :: Qmu ! Shear Attenuation
-! double precision, dimension(:,:), pointer :: Qtau_e ! tau_epsilon
-! double precision, dimension(:), pointer :: Qomsb, Qomsb2 ! one_minus_sum_beta
-! double precision, dimension(:,:), pointer :: Qfc, Qfc2 ! factor_common
-! double precision, dimension(:), pointer :: Qsf, Qsf2 ! scale_factor
-! integer, dimension(:), pointer :: Qrmin ! Max and Mins of idoubling
-! integer, dimension(:), pointer :: Qrmax ! Max and Mins of idoubling
-! integer, dimension(:), pointer :: interval_Q ! Steps
-! integer :: Qn ! Number of points
-! integer dummy_pad ! padding 4 bytes to align the structure
-! end type model_attenuation_variables
+ integer :: myrank
- logical ATTENUATION
-
character(len=150) prname
integer iregion_code
integer nspec,nglob,nspec_stacey
integer npointot_oceans
-! Stacey
+ ! Stacey
real(kind=CUSTOM_REAL) rho_vp(NGLLX,NGLLY,NGLLZ,nspec_stacey)
real(kind=CUSTOM_REAL) rho_vs(NGLLX,NGLLY,NGLLZ,nspec_stacey)
- logical TRANSVERSE_ISOTROPY,HETEROGEN_3D_MANTLE,ANISOTROPIC_3D_MANTLE,ANISOTROPIC_INNER_CORE,OCEANS
+ logical :: TRANSVERSE_ISOTROPY,HETEROGEN_3D_MANTLE,ANISOTROPIC_3D_MANTLE,ANISOTROPIC_INNER_CORE,OCEANS
+ logical :: ATTENUATION
-! arrays with jacobian matrix
+ ! arrays with jacobian matrix
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,nspec) :: &
xixstore,xiystore,xizstore,etaxstore,etaystore,etazstore,gammaxstore,gammaystore,gammazstore
-! arrays with mesh parameters
+ ! arrays with mesh parameters
double precision xstore(NGLLX,NGLLY,NGLLZ,nspec)
double precision ystore(NGLLX,NGLLY,NGLLZ,nspec)
double precision zstore(NGLLX,NGLLY,NGLLZ,nspec)
-! for anisotropy
+ ! for anisotropy
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,nspec) :: &
rhostore,dvpstore,kappavstore,kappahstore,muvstore,muhstore,eta_anisostore
@@ -105,26 +86,26 @@
integer ibool(NGLLX,NGLLY,NGLLZ,nspec)
-! doubling mesh flag
+ ! doubling mesh flag
integer, dimension(nspec) :: idoubling
-! this for non blocking MPI
+ ! this for non blocking MPI
logical, dimension(nspec) :: is_on_a_slice_edge
-! mass matrix
+ ! mass matrix
real(kind=CUSTOM_REAL) rmass(nglob)
-! additional ocean load mass matrix
+ ! additional ocean load mass matrix
real(kind=CUSTOM_REAL) rmass_ocean_load(npointot_oceans)
-! boundary parameters locator
+ ! boundary parameters locator
integer NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP
integer ibelm_xmin(NSPEC2DMAX_XMIN_XMAX),ibelm_xmax(NSPEC2DMAX_XMIN_XMAX)
integer ibelm_ymin(NSPEC2DMAX_YMIN_YMAX),ibelm_ymax(NSPEC2DMAX_YMIN_YMAX)
integer ibelm_bottom(NSPEC2D_BOTTOM),ibelm_top(NSPEC2D_TOP)
-! normals
+ ! normals
real(kind=CUSTOM_REAL) normal_xmin(NDIM,NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX)
real(kind=CUSTOM_REAL) normal_xmax(NDIM,NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX)
real(kind=CUSTOM_REAL) normal_ymin(NDIM,NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX)
@@ -132,7 +113,7 @@
real(kind=CUSTOM_REAL) normal_bottom(NDIM,NGLLX,NGLLY,NSPEC2D_BOTTOM)
real(kind=CUSTOM_REAL) normal_top(NDIM,NGLLX,NGLLY,NSPEC2D_TOP)
-! jacobian on 2D edges
+ ! jacobian on 2D edges
real(kind=CUSTOM_REAL) jacobian2D_xmin(NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX)
real(kind=CUSTOM_REAL) jacobian2D_xmax(NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX)
real(kind=CUSTOM_REAL) jacobian2D_ymin(NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX)
@@ -140,10 +121,10 @@
real(kind=CUSTOM_REAL) jacobian2D_bottom(NGLLX,NGLLY,NSPEC2D_BOTTOM)
real(kind=CUSTOM_REAL) jacobian2D_top(NGLLX,NGLLY,NSPEC2D_TOP)
-! number of elements on the boundaries
+ ! number of elements on the boundaries
integer nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax
-! attenuation
+ ! attenuation
integer vx, vy, vz, vnspec
double precision T_c_source
double precision, dimension(N_SLS) :: tau_s
@@ -155,32 +136,24 @@
logical, dimension(nspec) :: ispec_is_tiso
! local parameters
- integer i,j,k,ispec,iglob,nspec1, nglob1
+ integer i,j,k,ispec,iglob,nspec1,nglob1,ier
real(kind=CUSTOM_REAL) scaleval1,scaleval2
-! save nspec and nglob, to be used in combine_paraview_data
- open(unit=27,file=prname(1:len_trim(prname))//'array_dims.txt',status='unknown',action='write')
+ ! save nspec and nglob, to be used in combine_paraview_data
+ open(unit=27,file=prname(1:len_trim(prname))//'array_dims.txt', &
+ status='unknown',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening array_dims file')
nspec1 = nspec
nglob1 = nglob
- ! might be wrong, check...
- !if (NCHUNKS == 6 .and. ichunk /= CHUNK_AB .and. iregion_code == IREGION_INNER_CORE) then
- ! ! only chunk_AB contains inner core?
- ! ratio_divide_central_cube = 16
- ! ! corrects nspec/nglob
- ! nspec1 = nspec1 - (NEX_PER_PROC_XI/ratio_divide_central_cube) &
- ! * (NEX_PER_PROC_ETA/ratio_divide_central_cube) * (NEX_XI/ratio_divide_central_cube)
- ! nglob1 = nglob1 - ((NEX_PER_PROC_XI/ratio_divide_central_cube)*(NGLLX-1)+1) &
- ! * ((NEX_PER_PROC_ETA/ratio_divide_central_cube)*(NGLLY-1)+1) &
- ! * (NEX_XI/ratio_divide_central_cube)*(NGLLZ-1)
- !endif
-
write(27,*) nspec1
write(27,*) nglob1
close(27)
- open(unit=27,file=prname(1:len_trim(prname))//'solver_data_1.bin',status='unknown',form='unformatted',action='write')
+ open(unit=27,file=prname(1:len_trim(prname))//'solver_data_1.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening solver_data_1.bin file')
write(27) xixstore
write(27) xiystore
@@ -196,17 +169,20 @@
write(27) kappavstore
if(HETEROGEN_3D_MANTLE) then
- open(unit=29,file=prname(1:len_trim(prname))//'dvp.bin',status='unknown',form='unformatted',action='write')
+ open(unit=29,file=prname(1:len_trim(prname))//'dvp.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening dvp.bin file')
+
write(29) dvpstore
close(29)
endif
-! other terms needed in the solid regions only
+ ! other terms needed in the solid regions only
if(iregion_code /= IREGION_OUTER_CORE) then
if(.not. (ANISOTROPIC_3D_MANTLE .and. iregion_code == IREGION_CRUST_MANTLE)) write(27) muvstore
-! save anisotropy in the mantle only
+ ! save anisotropy in the mantle only
if(TRANSVERSE_ISOTROPY) then
if(iregion_code == IREGION_CRUST_MANTLE .and. .not. ANISOTROPIC_3D_MANTLE) then
write(27) kappahstore
@@ -215,7 +191,7 @@
endif
endif
-! save anisotropy in the inner core only
+ ! save anisotropy in the inner core only
if(ANISOTROPIC_INNER_CORE .and. iregion_code == IREGION_INNER_CORE) then
write(27) c11store
write(27) c33store
@@ -224,8 +200,6 @@
write(27) c44store
endif
-
-
if(ANISOTROPIC_3D_MANTLE .and. iregion_code == IREGION_CRUST_MANTLE) then
write(27) c11store
write(27) c12store
@@ -252,7 +226,7 @@
endif
-! Stacey
+ ! Stacey
if(ABSORBING_CONDITIONS) then
if(iregion_code == IREGION_CRUST_MANTLE) then
@@ -264,27 +238,30 @@
endif
-! mass matrix
+ ! mass matrix
write(27) rmass
-! additional ocean load mass matrix if oceans and if we are in the crust
+ ! additional ocean load mass matrix if oceans and if we are in the crust
if(OCEANS .and. iregion_code == IREGION_CRUST_MANTLE) write(27) rmass_ocean_load
close(27)
- open(unit=27,file=prname(1:len_trim(prname))//'solver_data_2.bin',status='unknown',form='unformatted',action='write')
+ open(unit=27,file=prname(1:len_trim(prname))//'solver_data_2.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening solver_data_2.bin file')
+
! mesh arrays used in the solver to locate source and receivers
! and for anisotropy and gravity, save in single precision
! use rmass for temporary storage to perform conversion, since already saved
-!--- x coordinate
+ !--- x coordinate
rmass(:) = 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)
-! distinguish between single and double precision for reals
+ ! distinguish between single and double precision for reals
if(CUSTOM_REAL == SIZE_REAL) then
rmass(iglob) = sngl(xstore(i,j,k,ispec))
else
@@ -296,14 +273,14 @@
enddo
write(27) rmass
-!--- y coordinate
+ !--- y coordinate
rmass(:) = 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)
-! distinguish between single and double precision for reals
+ ! distinguish between single and double precision for reals
if(CUSTOM_REAL == SIZE_REAL) then
rmass(iglob) = sngl(ystore(i,j,k,ispec))
else
@@ -315,14 +292,14 @@
enddo
write(27) rmass
-!--- z coordinate
+ !--- z coordinate
rmass(:) = 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)
-! distinguish between single and double precision for reals
+ ! distinguish between single and double precision for reals
if(CUSTOM_REAL == SIZE_REAL) then
rmass(iglob) = sngl(zstore(i,j,k,ispec))
else
@@ -344,8 +321,10 @@
close(27)
-! absorbing boundary parameters
- open(unit=27,file=prname(1:len_trim(prname))//'boundary.bin',status='unknown',form='unformatted',action='write')
+ ! absorbing boundary parameters
+ open(unit=27,file=prname(1:len_trim(prname))//'boundary.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening boundary.bin file')
write(27) nspec2D_xmin
write(27) nspec2D_xmax
@@ -377,10 +356,12 @@
close(27)
-!> Hejun
-! No matter 1D or 3D Attenuation, we save value for gll points
+ ! No matter 1D or 3D Attenuation, we save value for gll points
if(ATTENUATION) then
- open(unit=27, file=prname(1:len_trim(prname))//'attenuation.bin', status='unknown', form='unformatted',action='write')
+ open(unit=27, file=prname(1:len_trim(prname))//'attenuation.bin', &
+ status='unknown', form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening attenuation.bin file')
+
write(27) tau_s
write(27) tau_e_store
write(27) Qmu_store
@@ -395,48 +376,74 @@
! isotropic model
! vp
- open(unit=27,file=prname(1:len_trim(prname))//'vp.bin',status='unknown',form='unformatted',action='write')
+ open(unit=27,file=prname(1:len_trim(prname))//'vp.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening vp.bin file')
+
write(27) sqrt( (kappavstore+4.*muvstore/3.)/rhostore )*scaleval1
close(27)
! vs
- open(unit=27,file=prname(1:len_trim(prname))//'vs.bin',status='unknown',form='unformatted',action='write')
+ open(unit=27,file=prname(1:len_trim(prname))//'vs.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening vs.bin file')
+
write(27) sqrt( muvstore/rhostore )*scaleval1
close(27)
! rho
- open(unit=27,file=prname(1:len_trim(prname))//'rho.bin',status='unknown',form='unformatted',action='write')
+ open(unit=27,file=prname(1:len_trim(prname))//'rho.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening rho.bin file')
+
write(27) rhostore*scaleval2
close(27)
! transverse isotropic model
if( TRANSVERSE_ISOTROPY ) then
! vpv
- open(unit=27,file=prname(1:len_trim(prname))//'vpv.bin',status='unknown',form='unformatted',action='write')
+ open(unit=27,file=prname(1:len_trim(prname))//'vpv.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening vpv.bin file')
+
write(27) sqrt( (kappavstore+4.*muvstore/3.)/rhostore )*scaleval1
close(27)
! vph
- open(unit=27,file=prname(1:len_trim(prname))//'vph.bin',status='unknown',form='unformatted',action='write')
+ open(unit=27,file=prname(1:len_trim(prname))//'vph.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening vph.bin file')
+
write(27) sqrt( (kappahstore+4.*muhstore/3.)/rhostore )*scaleval1
close(27)
! vsv
- open(unit=27,file=prname(1:len_trim(prname))//'vsv.bin',status='unknown',form='unformatted',action='write')
+ open(unit=27,file=prname(1:len_trim(prname))//'vsv.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening vsv.bin file')
+
write(27) sqrt( muvstore/rhostore )*scaleval1
close(27)
! vsh
- open(unit=27,file=prname(1:len_trim(prname))//'vsh.bin',status='unknown',form='unformatted',action='write')
+ open(unit=27,file=prname(1:len_trim(prname))//'vsh.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening vsh.bin file')
+
write(27) sqrt( muhstore/rhostore )*scaleval1
close(27)
! rho
- open(unit=27,file=prname(1:len_trim(prname))//'rho.bin',status='unknown',form='unformatted',action='write')
+ open(unit=27,file=prname(1:len_trim(prname))//'rho.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening rho.bin file')
+
write(27) rhostore*scaleval2
close(27)
! eta
- open(unit=27,file=prname(1:len_trim(prname))//'eta.bin',status='unknown',form='unformatted',action='write')
+ open(unit=27,file=prname(1:len_trim(prname))//'eta.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening eta.bin file')
+
write(27) eta_anisostore
close(27)
endif
+ endif ! SAVE_MESH_FILES
- endif
-
end subroutine save_arrays_solver
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/setup_counters.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/setup_counters.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/setup_counters.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,145 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+
+ subroutine setup_counters(myrank, &
+ NSPEC1D_RADIAL,NSPEC2D_XI,NSPEC2D_ETA,NGLOB1D_RADIAL, &
+ DIFF_NSPEC1D_RADIAL,DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA, &
+ CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, &
+ NPROCTOT,iproc_xi_slice,iproc_eta_slice, &
+ NSPEC1D_RADIAL_CORNER,NSPEC2D_XI_FACE, &
+ NSPEC2D_ETA_FACE,NGLOB1D_RADIAL_CORNER)
+
+! returns: NSPEC1D_RADIAL_CORNER,NSPEC2D_XI_FACE,
+! NSPEC2D_ETA_FACE,NGLOB1D_RADIAL_CORNER
+
+ implicit none
+
+ include "constants.h"
+
+ integer myrank
+
+! this for all the regions
+ integer, dimension(MAX_NUM_REGIONS) :: NSPEC2D_XI,NSPEC2D_ETA, &
+ NSPEC1D_RADIAL,NGLOB1D_RADIAL
+
+ integer, dimension(NB_SQUARE_CORNERS,NB_CUT_CASE) :: DIFF_NSPEC1D_RADIAL
+ integer, dimension(NB_SQUARE_EDGES_ONEDIR,NB_CUT_CASE) :: DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA
+
+ ! addressing for all the slices
+ integer :: NPROCTOT
+ integer, dimension(0:NPROCTOT-1) :: iproc_xi_slice,iproc_eta_slice
+
+ logical :: CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA
+
+! this for the different corners of the slice (which are different if the superbrick is cut)
+! 1 : xi_min, eta_min
+! 2 : xi_max, eta_min
+! 3 : xi_max, eta_max
+! 4 : xi_min, eta_max
+ integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_CORNERS) :: &
+ NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER
+! 1 -> min, 2 -> max
+ integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_EDGES_ONEDIR) :: NSPEC2D_XI_FACE,NSPEC2D_ETA_FACE
+
+
+ ! local parameters
+ integer :: iregion
+
+ do iregion=1,MAX_NUM_REGIONS
+ NSPEC1D_RADIAL_CORNER(iregion,:) = NSPEC1D_RADIAL(iregion)
+ NSPEC2D_XI_FACE(iregion,:) = NSPEC2D_XI(iregion)
+ NSPEC2D_ETA_FACE(iregion,:) = NSPEC2D_ETA(iregion)
+ NGLOB1D_RADIAL_CORNER(iregion,:) = NGLOB1D_RADIAL(iregion)
+ enddo
+
+ if (CUT_SUPERBRICK_XI) then
+ if (CUT_SUPERBRICK_ETA) then
+ if (mod(iproc_xi_slice(myrank),2) == 0) then
+ if (mod(iproc_eta_slice(myrank),2) == 0) then
+ NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,1)
+ NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,1)
+ NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,1)
+ NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
+ + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,2)
+ NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,2)
+ NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,2)
+ NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
+ + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ else
+ if (mod(iproc_eta_slice(myrank),2) == 0) then
+ NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,3)
+ NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,3)
+ NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,3)
+ NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
+ + (DIFF_NSPEC1D_RADIAL(:,3)*(NGLLZ-1))
+ else
+ NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,4)
+ NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,4)
+ NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,4)
+ NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
+ + (DIFF_NSPEC1D_RADIAL(:,4)*(NGLLZ-1))
+ endif
+ endif
+ else
+ if (mod(iproc_xi_slice(myrank),2) == 0) then
+ NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,1)
+ NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,1)
+ NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,1)
+ NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
+ + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,2)
+ NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,2)
+ NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,2)
+ NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
+ + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ endif
+ else
+ if (CUT_SUPERBRICK_ETA) then
+ if (mod(iproc_eta_slice(myrank),2) == 0) then
+ NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,1)
+ NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,1)
+ NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,1)
+ NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
+ + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NSPEC1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) + DIFF_NSPEC1D_RADIAL(:,2)
+ NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_XI_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_XI(:,2)
+ NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) = NSPEC2D_ETA_FACE(IREGION_OUTER_CORE,:) + DIFF_NSPEC2D_ETA(:,2)
+ NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) = NGLOB1D_RADIAL_CORNER(IREGION_OUTER_CORE,:) &
+ + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ endif
+ endif
+
+ end subroutine setup_counters
+
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/setup_model.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/setup_model.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/meshfem3D/setup_model.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,195 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+ subroutine setup_model()
+
+ use meshfem3D_par
+ implicit none
+
+ ! dynamic allocation of mesh arrays
+ allocate(addressing(NCHUNKS,0:NPROC_XI-1,0:NPROC_ETA-1))
+ allocate(ichunk_slice(0:NPROCTOT-1))
+ allocate(iproc_xi_slice(0:NPROCTOT-1))
+ allocate(iproc_eta_slice(0:NPROCTOT-1))
+
+ ! creates global slice addressing for solver
+ call create_addressing(myrank,NCHUNKS,NPROC,NPROC_ETA,NPROC_XI,NPROCTOT, &
+ addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice, &
+ OUTPUT_FILES)
+
+
+ ! this for the different counters (which are now different if the superbrick is cut in the outer core)
+ call setup_counters(myrank, &
+ NSPEC1D_RADIAL,NSPEC2D_XI,NSPEC2D_ETA,NGLOB1D_RADIAL, &
+ DIFF_NSPEC1D_RADIAL,DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA, &
+ CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, &
+ NPROCTOT,iproc_xi_slice,iproc_eta_slice, &
+ NSPEC1D_RADIAL_CORNER,NSPEC2D_XI_FACE, &
+ NSPEC2D_ETA_FACE,NGLOB1D_RADIAL_CORNER)
+
+ ! user output
+ if(myrank == 0) call sm_output_info(myrank,sizeprocs,NEX_XI,NEX_ETA, &
+ NPROC_XI,NPROC_ETA,NPROC,NCHUNKS,NPROCTOT, &
+ R_CENTRAL_CUBE)
+
+ ! distributes 3D models
+ call meshfem3D_models_broadcast(myrank,NSPEC, &
+ MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD,&
+ R80,R220,R670,RCMB,RICB, &
+ LOCAL_PATH)
+
+
+ if(myrank == 0 ) then
+ write(IMAIN,*)
+ write(IMAIN,*) 'model setup successfully read in'
+ write(IMAIN,*)
+ endif
+
+ end subroutine setup_model
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine sm_output_info(myrank,sizeprocs,NEX_XI,NEX_ETA, &
+ NPROC_XI,NPROC_ETA,NPROC,NCHUNKS,NPROCTOT,&
+ R_CENTRAL_CUBE)
+
+ use meshfem3D_models_par
+
+ implicit none
+
+ integer :: myrank,sizeprocs,NEX_XI,NEX_ETA, &
+ NPROC_XI,NPROC_ETA,NPROC,NCHUNKS,NPROCTOT
+ double precision :: R_CENTRAL_CUBE
+
+ 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 are ',NEX_XI,' elements along xi in each chunk'
+ write(IMAIN,*) 'There are ',NEX_ETA,' elements along eta in each chunk'
+ write(IMAIN,*)
+ write(IMAIN,*) 'There are ',NPROC_XI,' slices along xi in each chunk'
+ write(IMAIN,*) 'There are ',NPROC_ETA,' slices along eta in each chunk'
+ write(IMAIN,*) 'There is a total of ',NPROC,' slices in each chunk'
+ write(IMAIN,*) 'There are ',NCHUNKS,' chunks in the global mesh'
+ write(IMAIN,*) 'There is a total of ',NPROCTOT,' slices in the global mesh'
+ 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,*)
+ write(IMAIN,*)
+ write(IMAIN,*)
+ if(ELLIPTICITY) then
+ write(IMAIN,*) 'incorporating ellipticity'
+ else
+ write(IMAIN,*) 'no ellipticity'
+ endif
+ write(IMAIN,*)
+ if(TOPOGRAPHY) then
+ write(IMAIN,*) 'incorporating surface topography'
+ else
+ write(IMAIN,*) 'no surface topography'
+ endif
+ write(IMAIN,*)
+ if(ISOTROPIC_3D_MANTLE) then
+ write(IMAIN,*) 'incorporating 3-D lateral variations'
+ else
+ write(IMAIN,*) 'no 3-D lateral variations'
+ endif
+ write(IMAIN,*)
+ if(HETEROGEN_3D_MANTLE) then
+ write(IMAIN,*) 'incorporating heterogeneities in the mantle'
+ else
+ write(IMAIN,*) 'no heterogeneities in the mantle'
+ endif
+ write(IMAIN,*)
+ if(CRUSTAL) then
+ write(IMAIN,*) 'incorporating crustal variations'
+ else
+ write(IMAIN,*) 'no crustal variations'
+ endif
+ write(IMAIN,*)
+ if(ONE_CRUST) then
+ write(IMAIN,*) 'using one layer only in PREM crust'
+ else
+ write(IMAIN,*) 'using unmodified 1D crustal model with two layers'
+ endif
+ write(IMAIN,*)
+ if(GRAVITY) then
+ write(IMAIN,*) 'incorporating self-gravitation (Cowling approximation)'
+ else
+ write(IMAIN,*) 'no self-gravitation'
+ endif
+ write(IMAIN,*)
+ if(ROTATION) then
+ write(IMAIN,*) 'incorporating rotation'
+ else
+ write(IMAIN,*) 'no rotation'
+ endif
+ write(IMAIN,*)
+ if(TRANSVERSE_ISOTROPY) then
+ write(IMAIN,*) 'incorporating anisotropy'
+ else
+ write(IMAIN,*) 'no anisotropy'
+ endif
+ write(IMAIN,*)
+ if(ATTENUATION) then
+ write(IMAIN,*) 'incorporating attenuation using ',N_SLS,' standard linear solids'
+ if(ATTENUATION_3D) write(IMAIN,*)'using 3D attenuation'
+ else
+ write(IMAIN,*) 'no attenuation'
+ endif
+ write(IMAIN,*)
+ if(OCEANS) then
+ write(IMAIN,*) 'incorporating the oceans using equivalent load'
+ else
+ write(IMAIN,*) 'no oceans'
+ endif
+ write(IMAIN,*)
+ if(ANISOTROPIC_INNER_CORE) then
+ write(IMAIN,*) 'incorporating anisotropic inner core'
+ else
+ write(IMAIN,*) 'no inner-core anisotropy'
+ endif
+ write(IMAIN,*)
+ if(ANISOTROPIC_3D_MANTLE) then
+ write(IMAIN,*) 'incorporating anisotropic mantle'
+ else
+ write(IMAIN,*) 'no general mantle anisotropy'
+ endif
+ write(IMAIN,*)
+ write(IMAIN,*) 'Reference radius of the Earth used is ',R_EARTH_KM,' km'
+ write(IMAIN,*)
+ write(IMAIN,*) 'Central cube is at a radius of ',R_CENTRAL_CUBE/1000.d0,' km'
+
+ end subroutine sm_output_info
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/count_elements.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/count_elements.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/count_elements.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,375 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+ subroutine count_elements(NEX_XI,NEX_ETA,NEX_PER_PROC_XI,NPROC,&
+ NEX_PER_PROC_ETA,ratio_divide_central_cube,&
+ NSPEC,NSPEC2D_XI,NSPEC2D_ETA, &
+ NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
+ NSPEC1D_RADIAL, &
+ NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX, &
+ ner,ratio_sampling_array,this_region_has_a_doubling, &
+ ifirst_region,ilast_region,iter_region,iter_layer, &
+ doubling,tmp_sum,tmp_sum_xi,tmp_sum_eta, &
+ NUMBER_OF_MESH_LAYERS,layer_offset,nspec2D_xi_sb,nspec2D_eta_sb, &
+ nb_lay_sb, nspec_sb, nglob_surf, &
+ CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, INCLUDE_CENTRAL_CUBE, &
+ last_doubling_layer, &
+ DIFF_NSPEC1D_RADIAL,DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA,&
+ tmp_sum_nglob2D_xi, tmp_sum_nglob2D_eta,divider,nglob_edges_h,&
+ nglob_edge_v,to_remove)
+
+
+ implicit none
+
+ include "constants.h"
+
+
+! parameters to be computed based upon parameters above read from file
+ integer NPROC,NEX_XI,NEX_ETA,NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube
+
+ integer, dimension(MAX_NUM_REGIONS) :: NSPEC,NSPEC2D_XI,NSPEC2D_ETA, &
+ NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
+ NSPEC1D_RADIAL,NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX
+
+
+ logical, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: this_region_has_a_doubling
+
+ integer, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: ner,ratio_sampling_array
+
+
+ integer :: ifirst_region, ilast_region, iter_region, iter_layer, doubling, tmp_sum, tmp_sum_xi, tmp_sum_eta
+ integer :: NUMBER_OF_MESH_LAYERS,layer_offset,nspec2D_xi_sb,nspec2D_eta_sb, &
+ nb_lay_sb, nspec_sb, nglob_surf
+
+
+! for the cut doublingbrick improvement
+ logical :: CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA
+ logical :: INCLUDE_CENTRAL_CUBE
+ integer :: last_doubling_layer
+ integer, dimension(NB_SQUARE_CORNERS,NB_CUT_CASE) :: DIFF_NSPEC1D_RADIAL
+ integer, dimension(NB_SQUARE_EDGES_ONEDIR,NB_CUT_CASE) :: DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA
+
+ integer :: tmp_sum_nglob2D_xi, tmp_sum_nglob2D_eta,divider,nglob_edges_h,nglob_edge_v,to_remove
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!
+!!!!!! calculation of number of elements (NSPEC) below
+!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ ratio_divide_central_cube = maxval(ratio_sampling_array(1:NUMBER_OF_MESH_LAYERS))
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!
+!!!!!! 1D case
+!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+ ! theoretical number of spectral elements in radial direction
+ do iter_region = IREGION_CRUST_MANTLE,IREGION_INNER_CORE
+ if(iter_region == IREGION_CRUST_MANTLE) then
+ ifirst_region = 1
+ ilast_region = 10 + layer_offset
+ else if(iter_region == IREGION_OUTER_CORE) then
+ ifirst_region = 11 + layer_offset
+ ilast_region = NUMBER_OF_MESH_LAYERS - 1
+ else if(iter_region == IREGION_INNER_CORE) then
+ ifirst_region = NUMBER_OF_MESH_LAYERS
+ ilast_region = NUMBER_OF_MESH_LAYERS
+ else
+ stop 'incorrect region code detected'
+ endif
+ NSPEC1D_RADIAL(iter_region) = sum(ner(ifirst_region:ilast_region))
+ enddo
+
+ ! difference of radial number of element for outer core if the superbrick is cut
+ DIFF_NSPEC1D_RADIAL(:,:) = 0
+ if (CUT_SUPERBRICK_XI) then
+ if (CUT_SUPERBRICK_ETA) then
+ DIFF_NSPEC1D_RADIAL(2,1) = 1
+ DIFF_NSPEC1D_RADIAL(3,1) = 2
+ DIFF_NSPEC1D_RADIAL(4,1) = 1
+
+ DIFF_NSPEC1D_RADIAL(1,2) = 1
+ DIFF_NSPEC1D_RADIAL(2,2) = 2
+ DIFF_NSPEC1D_RADIAL(3,2) = 1
+
+ DIFF_NSPEC1D_RADIAL(1,3) = 1
+ DIFF_NSPEC1D_RADIAL(3,3) = 1
+ DIFF_NSPEC1D_RADIAL(4,3) = 2
+
+ DIFF_NSPEC1D_RADIAL(1,4) = 2
+ DIFF_NSPEC1D_RADIAL(2,4) = 1
+ DIFF_NSPEC1D_RADIAL(4,4) = 1
+ else
+ DIFF_NSPEC1D_RADIAL(2,1) = 1
+ DIFF_NSPEC1D_RADIAL(3,1) = 1
+
+ DIFF_NSPEC1D_RADIAL(1,2) = 1
+ DIFF_NSPEC1D_RADIAL(4,2) = 1
+ endif
+ else
+ if (CUT_SUPERBRICK_ETA) then
+ DIFF_NSPEC1D_RADIAL(3,1) = 1
+ DIFF_NSPEC1D_RADIAL(4,1) = 1
+
+ DIFF_NSPEC1D_RADIAL(1,2) = 1
+ DIFF_NSPEC1D_RADIAL(2,2) = 1
+ endif
+ endif
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!
+!!!!!! 2D case
+!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ ! exact number of surface elements for faces along XI and ETA
+
+ do iter_region = IREGION_CRUST_MANTLE,IREGION_INNER_CORE
+ if(iter_region == IREGION_CRUST_MANTLE) then
+ ifirst_region = 1
+ ilast_region = 10 + layer_offset
+ else if(iter_region == IREGION_OUTER_CORE) then
+ ifirst_region = 11 + layer_offset
+ ilast_region = NUMBER_OF_MESH_LAYERS - 1
+ else if(iter_region == IREGION_INNER_CORE) then
+ ifirst_region = NUMBER_OF_MESH_LAYERS
+ ilast_region = NUMBER_OF_MESH_LAYERS
+ else
+ stop 'incorrect region code detected'
+ endif
+ tmp_sum_xi = 0
+ tmp_sum_eta = 0
+ tmp_sum_nglob2D_xi = 0
+ tmp_sum_nglob2D_eta = 0
+ do iter_layer = ifirst_region, ilast_region
+ if (this_region_has_a_doubling(iter_layer)) then
+ if (iter_region == IREGION_OUTER_CORE .and. iter_layer == last_doubling_layer) then
+ ! simple brick
+ divider = 1
+ nglob_surf = 6*NGLLX**2 - 7*NGLLX + 2
+ nglob_edges_h = 2*(NGLLX-1)+1 + NGLLX
+ ! minimum value to be safe
+ nglob_edge_v = NGLLX-2
+ nb_lay_sb = 2
+ nspec2D_xi_sb = NSPEC2D_XI_SUPERBRICK
+ nspec2D_eta_sb = NSPEC2D_ETA_SUPERBRICK
+ else
+ ! double brick
+ divider = 2
+ if (ner(iter_layer) == 1) then
+ nglob_surf = 6*NGLLX**2 - 8*NGLLX + 3
+ nglob_edges_h = 4*(NGLLX-1)+1 + 2*(NGLLX-1)+1
+ nglob_edge_v = NGLLX-2
+ nb_lay_sb = 1
+ nspec2D_xi_sb = NSPEC2D_XI_SUPERBRICK_1L
+ nspec2D_eta_sb = NSPEC2D_ETA_SUPERBRICK_1L
+ else
+ nglob_surf = 8*NGLLX**2 - 11*NGLLX + 4
+ nglob_edges_h = 4*(NGLLX-1)+1 + 2*(NGLLX-1)+1
+ nglob_edge_v = 2*(NGLLX-1)+1 -2
+ nb_lay_sb = 2
+ nspec2D_xi_sb = NSPEC2D_XI_SUPERBRICK
+ nspec2D_eta_sb = NSPEC2D_ETA_SUPERBRICK
+ divider = 2
+ endif
+ endif
+ doubling = 1
+ to_remove = 1
+ else
+ if (iter_layer /= ifirst_region) then
+ to_remove = 0
+ else
+ to_remove = 1
+ endif
+ ! dummy values to avoid a warning
+ nglob_surf = 0
+ nglob_edges_h = 0
+ nglob_edge_v = 0
+ divider = 1
+ doubling = 0
+ nb_lay_sb = 0
+ nspec2D_xi_sb = 0
+ nspec2D_eta_sb = 0
+ endif
+
+ tmp_sum_xi = tmp_sum_xi + ((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer)) * &
+ (ner(iter_layer) - doubling*nb_lay_sb)) + &
+ doubling * ((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer)) * (nspec2D_xi_sb/2))
+
+ tmp_sum_eta = tmp_sum_eta + ((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer)) * &
+ (ner(iter_layer) - doubling*nb_lay_sb)) + &
+ doubling * ((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer)) * (nspec2D_eta_sb/2))
+
+ tmp_sum_nglob2D_xi = tmp_sum_nglob2D_xi + (((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer)) * &
+ (ner(iter_layer) - doubling*nb_lay_sb))*NGLLX*NGLLX) - &
+ ((((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer))-1)*(ner(iter_layer) - doubling*nb_lay_sb)) + &
+ ((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer))*(ner(iter_layer) - to_remove - doubling*nb_lay_sb))*NGLLX) + &
+ (((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer))-1)*(ner(iter_layer) - to_remove - doubling*nb_lay_sb)) + &
+ doubling * (((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer))/divider) * (nglob_surf-nglob_edges_h) - &
+ ((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer))/divider -1) * nglob_edge_v)
+
+ tmp_sum_nglob2D_eta = tmp_sum_nglob2D_eta + (((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer)) * &
+ (ner(iter_layer) - doubling*nb_lay_sb))*NGLLX*NGLLX) - &
+ ((((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer))-1)*(ner(iter_layer) - doubling*nb_lay_sb)) + &
+ ((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer))* &
+ (ner(iter_layer) - to_remove - doubling*nb_lay_sb))*NGLLX) + &
+ (((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer))-1)*(ner(iter_layer) - to_remove - doubling*nb_lay_sb)) + &
+ doubling * (((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer))/divider) * (nglob_surf-nglob_edges_h) - &
+ ((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer))/divider -1) * nglob_edge_v)
+
+ enddo ! iter_layer
+
+ NSPEC2D_XI(iter_region) = tmp_sum_xi
+ NSPEC2D_ETA(iter_region) = tmp_sum_eta
+
+ NGLOB2DMAX_YMIN_YMAX(iter_region) = tmp_sum_nglob2D_xi
+ NGLOB2DMAX_XMIN_XMAX(iter_region) = tmp_sum_nglob2D_eta
+
+ if (iter_region == IREGION_INNER_CORE .and. INCLUDE_CENTRAL_CUBE) then
+ NSPEC2D_XI(iter_region) = NSPEC2D_XI(iter_region) + &
+ ((NEX_PER_PROC_XI / ratio_divide_central_cube)*(NEX_XI / ratio_divide_central_cube))
+ NSPEC2D_ETA(iter_region) = NSPEC2D_ETA(iter_region) + &
+ ((NEX_PER_PROC_ETA / ratio_divide_central_cube)*(NEX_XI / ratio_divide_central_cube))
+
+ NGLOB2DMAX_YMIN_YMAX(iter_region) = NGLOB2DMAX_YMIN_YMAX(iter_region) + &
+ (((NEX_PER_PROC_XI / ratio_divide_central_cube)*(NGLLX-1)+1)*((NEX_XI / ratio_divide_central_cube)*(NGLLX-1)+1))
+
+ NGLOB2DMAX_XMIN_XMAX(iter_region) = NGLOB2DMAX_XMIN_XMAX(iter_region) + &
+ (((NEX_PER_PROC_ETA / ratio_divide_central_cube)*(NGLLX-1)+1)*((NEX_XI / ratio_divide_central_cube)*(NGLLX-1)+1))
+ endif
+ enddo ! iter_region
+
+ ! difference of number of surface elements along xi or eta for outer core if the superbrick is cut
+ DIFF_NSPEC2D_XI(:,:) = 0
+ DIFF_NSPEC2D_ETA(:,:) = 0
+ if (CUT_SUPERBRICK_XI) then
+ if (CUT_SUPERBRICK_ETA) then
+ DIFF_NSPEC2D_XI(2,1) = 2
+ DIFF_NSPEC2D_XI(1,2) = 2
+ DIFF_NSPEC2D_XI(2,3) = 2
+ DIFF_NSPEC2D_XI(1,4) = 2
+
+ DIFF_NSPEC2D_ETA(2,1) = 1
+ DIFF_NSPEC2D_ETA(2,2) = 1
+ DIFF_NSPEC2D_ETA(1,3) = 1
+ DIFF_NSPEC2D_ETA(1,4) = 1
+ else
+ DIFF_NSPEC2D_ETA(2,1) = 1
+ DIFF_NSPEC2D_ETA(1,2) = 1
+ endif
+ else
+ if (CUT_SUPERBRICK_ETA) then
+ DIFF_NSPEC2D_XI(2,1) = 2
+ DIFF_NSPEC2D_XI(1,2) = 2
+ endif
+ endif
+ DIFF_NSPEC2D_XI(:,:) = DIFF_NSPEC2D_XI(:,:) * (NEX_PER_PROC_XI / ratio_divide_central_cube)
+ DIFF_NSPEC2D_ETA(:,:) = DIFF_NSPEC2D_ETA(:,:) * (NEX_PER_PROC_ETA / ratio_divide_central_cube)
+
+! exact number of surface elements on the bottom and top boundaries
+
+ ! in the crust and mantle
+ NSPEC2D_TOP(IREGION_CRUST_MANTLE) = (NEX_XI/ratio_sampling_array(1))*(NEX_ETA/ratio_sampling_array(1))/NPROC
+ NSPEC2D_BOTTOM(IREGION_CRUST_MANTLE) = (NEX_XI/ratio_sampling_array(10+layer_offset))*&
+ (NEX_ETA/ratio_sampling_array(10+layer_offset))/NPROC
+
+ ! in the outer core with mesh doubling
+ if (ADD_4TH_DOUBLING) then
+ NSPEC2D_TOP(IREGION_OUTER_CORE) = (NEX_XI/(ratio_divide_central_cube/4))*(NEX_ETA/(ratio_divide_central_cube/4))/NPROC
+ NSPEC2D_BOTTOM(IREGION_OUTER_CORE) = (NEX_XI/ratio_divide_central_cube)*(NEX_ETA/ratio_divide_central_cube)/NPROC
+ else
+ NSPEC2D_TOP(IREGION_OUTER_CORE) = (NEX_XI/(ratio_divide_central_cube/2))*(NEX_ETA/(ratio_divide_central_cube/2))/NPROC
+ NSPEC2D_BOTTOM(IREGION_OUTER_CORE) = (NEX_XI/ratio_divide_central_cube)*(NEX_ETA/ratio_divide_central_cube)/NPROC
+ endif
+
+ ! in the top of the inner core
+ NSPEC2D_TOP(IREGION_INNER_CORE) = (NEX_XI/ratio_divide_central_cube)*(NEX_ETA/ratio_divide_central_cube)/NPROC
+ NSPEC2D_BOTTOM(IREGION_INNER_CORE) = NSPEC2D_TOP(IREGION_INNER_CORE)
+
+ ! maximum number of surface elements on vertical boundaries of the slices
+ NSPEC2DMAX_XMIN_XMAX(:) = NSPEC2D_ETA(:)
+ NSPEC2DMAX_XMIN_XMAX(IREGION_OUTER_CORE) = NSPEC2DMAX_XMIN_XMAX(IREGION_OUTER_CORE) + maxval(DIFF_NSPEC2D_ETA(:,:))
+ NSPEC2DMAX_YMIN_YMAX(:) = NSPEC2D_XI(:)
+ NSPEC2DMAX_YMIN_YMAX(IREGION_OUTER_CORE) = NSPEC2DMAX_YMIN_YMAX(IREGION_OUTER_CORE) + maxval(DIFF_NSPEC2D_XI(:,:))
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!
+!!!!!! 3D case
+!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ ! exact number of spectral elements in each region
+
+ do iter_region = IREGION_CRUST_MANTLE,IREGION_INNER_CORE
+ if(iter_region == IREGION_CRUST_MANTLE) then
+ ifirst_region = 1
+ ilast_region = 10 + layer_offset
+ else if(iter_region == IREGION_OUTER_CORE) then
+ ifirst_region = 11 + layer_offset
+ ilast_region = NUMBER_OF_MESH_LAYERS - 1
+ else if(iter_region == IREGION_INNER_CORE) then
+ ifirst_region = NUMBER_OF_MESH_LAYERS
+ ilast_region = NUMBER_OF_MESH_LAYERS
+ else
+ stop 'incorrect region code detected'
+ endif
+ tmp_sum = 0;
+ do iter_layer = ifirst_region, ilast_region
+ if (this_region_has_a_doubling(iter_layer)) then
+ if (ner(iter_layer) == 1) then
+ nb_lay_sb = 1
+ nspec_sb = NSPEC_SUPERBRICK_1L
+ else
+ nb_lay_sb = 2
+ nspec_sb = NSPEC_DOUBLING_SUPERBRICK
+ endif
+ doubling = 1
+ else
+ doubling = 0
+ nb_lay_sb = 0
+ nspec_sb = 0
+ endif
+ tmp_sum = tmp_sum + (((NEX_XI / ratio_sampling_array(iter_layer)) * (NEX_ETA / ratio_sampling_array(iter_layer)) * &
+ (ner(iter_layer) - doubling*nb_lay_sb)) + &
+ doubling * ((NEX_XI / ratio_sampling_array(iter_layer)) * (NEX_ETA / ratio_sampling_array(iter_layer)) * &
+ (nspec_sb/4))) / NPROC
+ enddo
+ NSPEC(iter_region) = tmp_sum
+ enddo
+
+ if(INCLUDE_CENTRAL_CUBE) NSPEC(IREGION_INNER_CORE) = NSPEC(IREGION_INNER_CORE) + &
+ (NEX_PER_PROC_XI / ratio_divide_central_cube) * &
+ (NEX_PER_PROC_ETA / ratio_divide_central_cube) * &
+ (NEX_XI / ratio_divide_central_cube)
+
+ if(minval(NSPEC) <= 0) stop 'negative NSPEC, there is a problem somewhere, try to recompile :) '
+
+ end subroutine count_elements
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/count_points.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/count_points.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/count_points.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,242 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+
+ subroutine count_points(NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube,&
+ NSPEC1D_RADIAL,NGLOB1D_RADIAL, &
+ NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX,NGLOB,&
+ nblocks_xi,nblocks_eta,ner,ratio_sampling_array,&
+ this_region_has_a_doubling,&
+ ifirst_region, ilast_region, iter_region, iter_layer, &
+ doubling, padding, tmp_sum, &
+ INCLUDE_CENTRAL_CUBE,NER_TOP_CENTRAL_CUBE_ICB,NEX_XI, &
+ NUMBER_OF_MESH_LAYERS,layer_offset, &
+ nb_lay_sb, nglob_vol, nglob_surf, nglob_edge, &
+ CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, &
+ last_doubling_layer, cut_doubling, nglob_int_surf_xi, nglob_int_surf_eta,nglob_ext_surf,&
+ normal_doubling, nglob_center_edge, nglob_corner_edge, nglob_border_edge)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!
+!!!!!! calculation of number of points (NGLOB) below
+!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+ implicit none
+
+ include "constants.h"
+
+! parameters read from parameter file
+
+! parameters to be computed based upon parameters above read from file
+ integer NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube
+
+ integer, dimension(MAX_NUM_REGIONS) :: &
+ NSPEC1D_RADIAL,NGLOB1D_RADIAL, &
+ NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX, &
+ NGLOB
+
+ integer NER_TOP_CENTRAL_CUBE_ICB,NEX_XI
+ integer nblocks_xi,nblocks_eta
+
+ integer, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: ner,ratio_sampling_array
+ logical, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: this_region_has_a_doubling
+
+ integer :: ifirst_region, ilast_region, iter_region, iter_layer, doubling, padding, tmp_sum
+ integer :: NUMBER_OF_MESH_LAYERS,layer_offset, &
+ nb_lay_sb, nglob_vol, nglob_surf, nglob_edge
+
+! for the cut doublingbrick improvement
+ logical :: CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA,INCLUDE_CENTRAL_CUBE
+ integer :: last_doubling_layer, cut_doubling, nglob_int_surf_xi, nglob_int_surf_eta,nglob_ext_surf,&
+ normal_doubling, nglob_center_edge, nglob_corner_edge, nglob_border_edge
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!
+!!!!!! 1D case
+!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! theoretical number of Gauss-Lobatto points in radial direction
+ NGLOB1D_RADIAL(:) = NSPEC1D_RADIAL(:)*(NGLLZ-1)+1
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!
+!!!!!! 2D case
+!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! 2-D addressing and buffers for summation between slices
+! we add one to number of points because of the flag after the last point
+ NGLOB2DMAX_XMIN_XMAX(:) = NGLOB2DMAX_XMIN_XMAX(:) + 1
+ NGLOB2DMAX_YMIN_YMAX(:) = NGLOB2DMAX_YMIN_YMAX(:) + 1
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!
+!!!!!! 3D case
+!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! exact number of global points in each region
+
+! initialize array
+ NGLOB(:) = 0
+
+! in the inner core (no doubling region + eventually central cube)
+ if(INCLUDE_CENTRAL_CUBE) then
+ NGLOB(IREGION_INNER_CORE) = ((NEX_PER_PROC_XI/ratio_divide_central_cube) &
+ *(NGLLX-1)+1)*((NEX_PER_PROC_ETA/ratio_divide_central_cube) &
+ *(NGLLY-1)+1)*((NER_TOP_CENTRAL_CUBE_ICB + NEX_XI / ratio_divide_central_cube)*(NGLLZ-1)+1)
+ else
+ NGLOB(IREGION_INNER_CORE) = ((NEX_PER_PROC_XI/ratio_divide_central_cube) &
+ *(NGLLX-1)+1)*((NEX_PER_PROC_ETA/ratio_divide_central_cube) &
+ *(NGLLY-1)+1)*((NER_TOP_CENTRAL_CUBE_ICB)*(NGLLZ-1)+1)
+ endif
+
+! in the crust-mantle and outercore
+ do iter_region = IREGION_CRUST_MANTLE,IREGION_OUTER_CORE
+ if(iter_region == IREGION_CRUST_MANTLE) then
+ ifirst_region = 1
+ ilast_region = 10 + layer_offset
+ else if(iter_region == IREGION_OUTER_CORE) then
+ ifirst_region = 11 + layer_offset
+ ilast_region = NUMBER_OF_MESH_LAYERS - 1
+ else
+ stop 'incorrect region code detected'
+ endif
+ tmp_sum = 0;
+ do iter_layer = ifirst_region, ilast_region
+ nglob_int_surf_eta=0
+ nglob_int_surf_xi=0
+ nglob_ext_surf = 0
+ nglob_center_edge = 0
+ nglob_corner_edge = 0
+ nglob_border_edge = 0
+ if (this_region_has_a_doubling(iter_layer)) then
+ if (iter_region == IREGION_OUTER_CORE .and. iter_layer == last_doubling_layer .and. &
+ (CUT_SUPERBRICK_XI .or. CUT_SUPERBRICK_ETA)) then
+ doubling = 1
+ normal_doubling = 0
+ cut_doubling = 1
+ nb_lay_sb = 2
+ nglob_edge = 0
+ nglob_surf = 0
+ nglob_vol = 8*NGLLX**3 - 12*NGLLX**2 + 6*NGLLX - 1
+ nglob_int_surf_eta = 6*NGLLX**2 - 7*NGLLX + 2
+ nglob_int_surf_xi = 5*NGLLX**2 - 5*NGLLX + 1
+ nglob_ext_surf = 4*NGLLX**2-4*NGLLX+1
+ nglob_center_edge = 4*(NGLLX-1)+1
+ nglob_corner_edge = 2*(NGLLX-1)+1
+ nglob_border_edge = 3*(NGLLX-1)+1
+ else
+ if (ner(iter_layer) == 1) then
+ nb_lay_sb = 1
+ nglob_vol = 28*NGLLX**3 - 62*NGLLX**2 + 47*NGLLX - 12
+ nglob_surf = 6*NGLLX**2-8*NGLLX+3
+ nglob_edge = NGLLX
+ else
+ nb_lay_sb = 2
+ nglob_vol = 32*NGLLX**3 - 70*NGLLX**2 + 52*NGLLX - 13
+ nglob_surf = 8*NGLLX**2-11*NGLLX+4
+ nglob_edge = 2*NGLLX-1
+ endif
+ doubling = 1
+ normal_doubling = 1
+ cut_doubling = 0
+ endif
+ padding = -1
+ else
+ doubling = 0
+ normal_doubling = 0
+ cut_doubling = 0
+ padding = 0
+ nb_lay_sb = 0
+ nglob_vol = 0
+ nglob_surf = 0
+ nglob_edge = 0
+ endif
+ if (iter_layer == ilast_region) padding = padding +1
+ nblocks_xi = NEX_PER_PROC_XI / ratio_sampling_array(iter_layer)
+ nblocks_eta = NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer)
+
+ tmp_sum = tmp_sum + &
+ ((nblocks_xi)*(NGLLX-1)+1) * ((nblocks_eta)*(NGLLX-1)+1) * ((ner(iter_layer) - doubling*nb_lay_sb)*(NGLLX-1)+padding)+&
+ normal_doubling * ((((nblocks_xi*nblocks_eta)/4)*nglob_vol) - &
+ (((nblocks_eta/2-1)*nblocks_xi/2+(nblocks_xi/2-1)*nblocks_eta/2)*nglob_surf) + &
+ ((nblocks_eta/2-1)*(nblocks_xi/2-1)*nglob_edge)) + &
+ cut_doubling*(nglob_vol*(nblocks_xi*nblocks_eta) - &
+ ( nblocks_eta*(int(nblocks_xi/2)*nglob_int_surf_xi + int((nblocks_xi-1)/2)*nglob_ext_surf) + &
+ nblocks_xi*(int(nblocks_eta/2)*nglob_int_surf_eta + int((nblocks_eta-1)/2)*nglob_ext_surf)&
+ ) + &
+ ( int(nblocks_xi/2)*int(nblocks_eta/2)*nglob_center_edge + &
+ int((nblocks_xi-1)/2)*int((nblocks_eta-1)/2)*nglob_corner_edge + &
+ ((int(nblocks_eta/2)*int((nblocks_xi-1)/2))+(int((nblocks_eta-1)/2)*int(nblocks_xi/2)))*nglob_border_edge&
+ ))
+ enddo
+ NGLOB(iter_region) = tmp_sum
+ enddo
+
+!!! example :
+!!! nblocks_xi/2=5
+!!! ____________________________________
+!!! I I I I I I
+!!! I I I I I I
+!!! I I I I I I
+!!! nblocks_eta/2=3 I______+______+______+______+______I
+!!! I I I I I I
+!!! I I I I I I
+!!! I I I I I I
+!!! I______+______+______+______+______I
+!!! I I I I I I
+!!! I I I I I I
+!!! I I I I I I
+!!! I______I______I______I______I______I
+!!!
+!!! NGLOB for this doubling layer = 3*5*Volume - ((3-1)*5+(5-1)*3)*Surface + (3-1)*(5-1)*Edge
+!!!
+!!! 32*NGLLX**3 - 70*NGLLX**2 + 52*NGLLX - 13 -> nb GLL points in a superbrick (Volume)
+!!! 8*NGLLX**2-11*NGLLX+4 -> nb GLL points on a superbrick side (Surface)
+!!! 2*NGLLX-1 -> nb GLL points on a corner edge of a superbrick (Edge)
+
+!!! for the one layer superbrick :
+!!! NGLOB = 28.NGLL^3 - 62.NGLL^2 + 47.NGLL - 12 (Volume)
+!!! NGLOB = 6.NGLL^2 - 8.NGLL + 3 (Surface)
+!!! NGLOB = NGLL (Edge)
+!!!
+!!! those results were obtained by using the script UTILS/doubling_brick/count_nglob_analytical.pl
+!!! with an opendx file of the superbrick's geometry
+
+!!! for the basic doubling bricks (two layers)
+!!! NGLOB = 8.NGLL^3 - 12.NGLL^2 + 6.NGLL - 1 (VOLUME)
+!!! NGLOB = 5.NGLL^2 - 5.NGLL + 1 (SURFACE 1)
+!!! NGLOB = 6.NGLL^2 - 7.NGLL + 2 (SURFACE 2)
+
+ end subroutine count_points
+
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/define_all_layers.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/define_all_layers.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/define_all_layers.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,946 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+
+ subroutine define_all_layers(NER_CRUST,NER_80_MOHO,NER_220_80,&
+ NER_400_220,NER_600_400,NER_670_600,NER_771_670, &
+ NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
+ NER_TOP_CENTRAL_CUBE_ICB,&
+ RMIDDLE_CRUST,R220,R400,R600,R670,R771,RTOPDDOUBLEPRIME,RCMB,RICB, &
+ R_CENTRAL_CUBE,RMOHO_FICTITIOUS_IN_MESHER,R80_FICTITIOUS_IN_MESHER,&
+ ONE_CRUST,ner,ratio_sampling_array,&
+ NUMBER_OF_MESH_LAYERS,layer_offset,last_doubling_layer, &
+ r_bottom,r_top,this_region_has_a_doubling,&
+ ielem,elem_doubling_mantle,elem_doubling_middle_outer_core,&
+ elem_doubling_bottom_outer_core,&
+ DEPTH_SECOND_DOUBLING_REAL,DEPTH_THIRD_DOUBLING_REAL, &
+ DEPTH_FOURTH_DOUBLING_REAL,distance,distance_min,zval,&
+ doubling_index,rmins,rmaxs)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!
+!!!!!! definition of general mesh parameters below
+!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ implicit none
+
+ include "constants.h"
+
+! parameters read from parameter file
+ integer NER_CRUST,NER_80_MOHO,NER_220_80,NER_400_220,NER_600_400,NER_670_600,NER_771_670, &
+ NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
+ NER_TOP_CENTRAL_CUBE_ICB
+ integer NUMBER_OF_MESH_LAYERS,layer_offset,last_doubling_layer
+
+ double precision RMIDDLE_CRUST,R220,R400,R600,R670,R771,RTOPDDOUBLEPRIME,RCMB,RICB, &
+ R_CENTRAL_CUBE,RMOHO_FICTITIOUS_IN_MESHER,R80_FICTITIOUS_IN_MESHER
+
+ logical ONE_CRUST
+
+ integer, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: ner,ratio_sampling_array
+ double precision, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: r_bottom,r_top
+ logical, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: this_region_has_a_doubling
+
+ integer :: ielem,elem_doubling_mantle,elem_doubling_middle_outer_core,elem_doubling_bottom_outer_core
+ double precision :: DEPTH_SECOND_DOUBLING_REAL,DEPTH_THIRD_DOUBLING_REAL, &
+ DEPTH_FOURTH_DOUBLING_REAL,distance,distance_min,zval
+
+
+ integer, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: doubling_index
+ double precision, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: rmins,rmaxs
+
+
+
+! find element below top of which we should implement the second doubling in the mantle
+! locate element closest to optimal value
+ distance_min = HUGEVAL
+ do ielem = 2,NER_TOPDDOUBLEPRIME_771
+ zval = RTOPDDOUBLEPRIME + ielem * (R771 - RTOPDDOUBLEPRIME) / dble(NER_TOPDDOUBLEPRIME_771)
+ distance = abs(zval - (R_EARTH - DEPTH_SECOND_DOUBLING_OPTIMAL))
+ if(distance < distance_min) then
+ elem_doubling_mantle = ielem
+ distance_min = distance
+ DEPTH_SECOND_DOUBLING_REAL = R_EARTH - zval
+ endif
+ enddo
+
+! find element below top of which we should implement the third doubling in the middle of the outer core
+! locate element closest to optimal value
+ distance_min = HUGEVAL
+! start at element number 4 because we need at least two elements below for the fourth doubling
+! implemented at the bottom of the outer core
+ do ielem = 4,NER_OUTER_CORE
+ zval = RICB + ielem * (RCMB - RICB) / dble(NER_OUTER_CORE)
+ distance = abs(zval - (R_EARTH - DEPTH_THIRD_DOUBLING_OPTIMAL))
+ if(distance < distance_min) then
+ elem_doubling_middle_outer_core = ielem
+ distance_min = distance
+ DEPTH_THIRD_DOUBLING_REAL = R_EARTH - zval
+ endif
+ enddo
+
+ if (ADD_4TH_DOUBLING) then
+! find element below top of which we should implement the fourth doubling in the middle of the outer core
+! locate element closest to optimal value
+ distance_min = HUGEVAL
+! end two elements before the top because we need at least two elements above for the third doubling
+! implemented in the middle of the outer core
+ do ielem = 2,NER_OUTER_CORE-2
+ zval = RICB + ielem * (RCMB - RICB) / dble(NER_OUTER_CORE)
+ distance = abs(zval - (R_EARTH - DEPTH_FOURTH_DOUBLING_OPTIMAL))
+ if(distance < distance_min) then
+ elem_doubling_bottom_outer_core = ielem
+ distance_min = distance
+ DEPTH_FOURTH_DOUBLING_REAL = R_EARTH - zval
+ endif
+ enddo
+! make sure that the two doublings in the outer core are found in the right order
+ if(elem_doubling_bottom_outer_core >= elem_doubling_middle_outer_core) &
+ stop 'error in location of the two doublings in the outer core'
+ endif
+
+ ratio_sampling_array(15) = 0
+
+! define all the layers of the mesh
+ if (.not. ADD_4TH_DOUBLING) then
+
+ ! default case:
+ ! no fourth doubling at the bottom of the outer core
+
+ if (SUPPRESS_CRUSTAL_MESH) then
+
+ ! suppress the crustal layers
+ ! will be replaced by an extension of the mantle: R_EARTH is not modified,
+ ! but no more crustal doubling
+
+ NUMBER_OF_MESH_LAYERS = 14
+ layer_offset = 1
+
+ ! now only one region
+ ner( 1) = NER_CRUST + NER_80_MOHO
+ ner( 2) = 0
+ ner( 3) = 0
+
+ ner( 4) = NER_220_80
+ ner( 5) = NER_400_220
+ ner( 6) = NER_600_400
+ ner( 7) = NER_670_600
+ ner( 8) = NER_771_670
+ ner( 9) = NER_TOPDDOUBLEPRIME_771 - elem_doubling_mantle
+ ner(10) = elem_doubling_mantle
+ ner(11) = NER_CMB_TOPDDOUBLEPRIME
+ ner(12) = NER_OUTER_CORE - elem_doubling_middle_outer_core
+ ner(13) = elem_doubling_middle_outer_core
+ ner(14) = NER_TOP_CENTRAL_CUBE_ICB
+
+ ! value of the doubling ratio in each radial region of the mesh
+ ratio_sampling_array(1:9) = 1
+ ratio_sampling_array(10:12) = 2
+ ratio_sampling_array(13:14) = 4
+
+ ! value of the doubling index flag in each radial region of the mesh
+ doubling_index(1:3) = IFLAG_CRUST !!!!! IFLAG_80_MOHO
+ doubling_index(4) = IFLAG_220_80
+ doubling_index(5:7) = IFLAG_670_220
+ doubling_index(8:11) = IFLAG_MANTLE_NORMAL
+ doubling_index(12:13) = IFLAG_OUTER_CORE_NORMAL
+ doubling_index(14) = IFLAG_INNER_CORE_NORMAL
+
+ ! define the three regions in which we implement a mesh doubling at the top of that region
+ this_region_has_a_doubling(:) = .false.
+ this_region_has_a_doubling(10) = .true.
+ this_region_has_a_doubling(13) = .true.
+ last_doubling_layer = 13
+
+ ! define the top and bottom radii of all the regions of the mesh in the radial direction
+ ! the first region is the crust at the surface of the Earth
+ ! the last region is in the inner core near the center of the Earth
+
+ r_top(1) = R_EARTH
+ r_bottom(1) = R80_FICTITIOUS_IN_MESHER
+
+ r_top(2) = RMIDDLE_CRUST !!!! now fictitious
+ r_bottom(2) = RMOHO_FICTITIOUS_IN_MESHER !!!! now fictitious
+
+ r_top(3) = RMOHO_FICTITIOUS_IN_MESHER !!!! now fictitious
+ r_bottom(3) = R80_FICTITIOUS_IN_MESHER !!!! now fictitious
+
+ r_top(4) = R80_FICTITIOUS_IN_MESHER
+ r_bottom(4) = R220
+
+ r_top(5) = R220
+ r_bottom(5) = R400
+
+ r_top(6) = R400
+ r_bottom(6) = R600
+
+ r_top(7) = R600
+ r_bottom(7) = R670
+
+ r_top(8) = R670
+ r_bottom(8) = R771
+
+ r_top(9) = R771
+ r_bottom(9) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
+
+ r_top(10) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
+ r_bottom(10) = RTOPDDOUBLEPRIME
+
+ r_top(11) = RTOPDDOUBLEPRIME
+ r_bottom(11) = RCMB
+
+ r_top(12) = RCMB
+ r_bottom(12) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
+
+ r_top(13) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
+ r_bottom(13) = RICB
+
+ r_top(14) = RICB
+ r_bottom(14) = R_CENTRAL_CUBE
+
+ ! new definition of rmins & rmaxs
+ rmaxs(1) = ONE
+ rmins(1) = R80_FICTITIOUS_IN_MESHER / R_EARTH
+
+ rmaxs(2) = RMIDDLE_CRUST / R_EARTH !!!! now fictitious
+ rmins(2) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH !!!! now fictitious
+
+ rmaxs(3) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH !!!! now fictitious
+ rmins(3) = R80_FICTITIOUS_IN_MESHER / R_EARTH !!!! now fictitious
+
+ rmaxs(4) = R80_FICTITIOUS_IN_MESHER / R_EARTH
+ rmins(4) = R220 / R_EARTH
+
+ rmaxs(5) = R220 / R_EARTH
+ rmins(5) = R400 / R_EARTH
+
+ rmaxs(6) = R400 / R_EARTH
+ rmins(6) = R600 / R_EARTH
+
+ rmaxs(7) = R600 / R_EARTH
+ rmins(7) = R670 / R_EARTH
+
+ rmaxs(8) = R670 / R_EARTH
+ rmins(8) = R771 / R_EARTH
+
+ rmaxs(9:10) = R771 / R_EARTH
+ rmins(9:10) = RTOPDDOUBLEPRIME / R_EARTH
+
+ rmaxs(11) = RTOPDDOUBLEPRIME / R_EARTH
+ rmins(11) = RCMB / R_EARTH
+
+ rmaxs(12:13) = RCMB / R_EARTH
+ rmins(12:13) = RICB / R_EARTH
+
+ rmaxs(14) = RICB / R_EARTH
+ rmins(14) = R_CENTRAL_CUBE / R_EARTH
+
+ elseif (ONE_CRUST) then
+
+ ! 1D models:
+ ! in order to increase stability and therefore to allow cheaper
+ ! simulations (larger time step), 1D models can be run with just one average crustal
+ ! layer instead of two.
+
+ NUMBER_OF_MESH_LAYERS = 13
+ layer_offset = 0
+
+ ner( 1) = NER_CRUST
+ ner( 2) = NER_80_MOHO
+ ner( 3) = NER_220_80
+ ner( 4) = NER_400_220
+ ner( 5) = NER_600_400
+ ner( 6) = NER_670_600
+ ner( 7) = NER_771_670
+ ner( 8) = NER_TOPDDOUBLEPRIME_771 - elem_doubling_mantle
+ ner( 9) = elem_doubling_mantle
+ ner(10) = NER_CMB_TOPDDOUBLEPRIME
+ ner(11) = NER_OUTER_CORE - elem_doubling_middle_outer_core
+ ner(12) = elem_doubling_middle_outer_core
+ ner(13) = NER_TOP_CENTRAL_CUBE_ICB
+
+ ! value of the doubling ratio in each radial region of the mesh
+ ratio_sampling_array(1) = 1
+ ratio_sampling_array(2:8) = 2
+ ratio_sampling_array(9:11) = 4
+ ratio_sampling_array(12:13) = 8
+
+ ! value of the doubling index flag in each radial region of the mesh
+ doubling_index(1) = IFLAG_CRUST
+ doubling_index(2) = IFLAG_80_MOHO
+ doubling_index(3) = IFLAG_220_80
+ doubling_index(4:6) = IFLAG_670_220
+ doubling_index(7:10) = IFLAG_MANTLE_NORMAL
+ doubling_index(11:12) = IFLAG_OUTER_CORE_NORMAL
+ doubling_index(13) = IFLAG_INNER_CORE_NORMAL
+
+ ! define the three regions in which we implement a mesh doubling at the top of that region
+ this_region_has_a_doubling(:) = .false.
+ this_region_has_a_doubling(2) = .true.
+ this_region_has_a_doubling(9) = .true.
+ this_region_has_a_doubling(12) = .true.
+ last_doubling_layer = 12
+
+ ! define the top and bottom radii of all the regions of the mesh in the radial direction
+ ! the first region is the crust at the surface of the Earth
+ ! the last region is in the inner core near the center of the Earth
+
+ !!!!!!!!!!! DK DK UGLY: beware, is there a bug when 3D crust crosses anisotropy in the mantle?
+ !!!!!!!!!!! DK DK UGLY: i.e. if there is no thick crust there, some elements above the Moho
+ !!!!!!!!!!! DK DK UGLY: should be anisotropic but anisotropy is currently only
+ !!!!!!!!!!! DK DK UGLY: stored between d220 and MOHO to save memory? Clarify this one day.
+ !!!!!!!!!!! DK DK UGLY: The Moho stretching and squishing that Jeroen added to V4.0
+ !!!!!!!!!!! DK DK UGLY: should partly deal with this problem.
+
+ r_top(1) = R_EARTH
+ r_bottom(1) = RMOHO_FICTITIOUS_IN_MESHER
+
+ r_top(2) = RMOHO_FICTITIOUS_IN_MESHER
+ r_bottom(2) = R80_FICTITIOUS_IN_MESHER
+
+ r_top(3) = R80_FICTITIOUS_IN_MESHER
+ r_bottom(3) = R220
+
+ r_top(4) = R220
+ r_bottom(4) = R400
+
+ r_top(5) = R400
+ r_bottom(5) = R600
+
+ r_top(6) = R600
+ r_bottom(6) = R670
+
+ r_top(7) = R670
+ r_bottom(7) = R771
+
+ r_top(8) = R771
+ r_bottom(8) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
+
+ r_top(9) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
+ r_bottom(9) = RTOPDDOUBLEPRIME
+
+ r_top(10) = RTOPDDOUBLEPRIME
+ r_bottom(10) = RCMB
+
+ r_top(11) = RCMB
+ r_bottom(11) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
+
+ r_top(12) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
+ r_bottom(12) = RICB
+
+ r_top(13) = RICB
+ r_bottom(13) = R_CENTRAL_CUBE
+
+ ! new definition of rmins & rmaxs
+ rmaxs(1) = ONE
+ rmins(1) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
+
+ rmaxs(2) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
+ rmins(2) = R80_FICTITIOUS_IN_MESHER / R_EARTH
+
+ rmaxs(3) = R80_FICTITIOUS_IN_MESHER / R_EARTH
+ rmins(3) = R220 / R_EARTH
+
+ rmaxs(4) = R220 / R_EARTH
+ rmins(4) = R400 / R_EARTH
+
+ rmaxs(5) = R400 / R_EARTH
+ rmins(5) = R600 / R_EARTH
+
+ rmaxs(6) = R600 / R_EARTH
+ rmins(6) = R670 / R_EARTH
+
+ rmaxs(7) = R670 / R_EARTH
+ rmins(7) = R771 / R_EARTH
+
+ rmaxs(8:9) = R771 / R_EARTH
+ rmins(8:9) = RTOPDDOUBLEPRIME / R_EARTH
+
+ rmaxs(10) = RTOPDDOUBLEPRIME / R_EARTH
+ rmins(10) = RCMB / R_EARTH
+
+ rmaxs(11:12) = RCMB / R_EARTH
+ rmins(11:12) = RICB / R_EARTH
+
+ rmaxs(13) = RICB / R_EARTH
+ rmins(13) = R_CENTRAL_CUBE / R_EARTH
+
+ else
+
+ ! default case for 3D models:
+ ! contains the crustal layers
+ ! doubling at the base of the crust
+
+ NUMBER_OF_MESH_LAYERS = 14
+ layer_offset = 1
+ if ((RMIDDLE_CRUST-RMOHO_FICTITIOUS_IN_MESHER)<(R_EARTH-RMIDDLE_CRUST)) then
+ ner( 1) = ceiling (NER_CRUST / 2.d0)
+ ner( 2) = floor (NER_CRUST / 2.d0)
+ else
+ ner( 1) = floor (NER_CRUST / 2.d0) ! regional mesh: ner(1) = 1 since NER_CRUST=3
+ ner( 2) = ceiling (NER_CRUST / 2.d0) ! ner(2) = 2
+ endif
+ ner( 3) = NER_80_MOHO
+ ner( 4) = NER_220_80
+ ner( 5) = NER_400_220
+ ner( 6) = NER_600_400
+ ner( 7) = NER_670_600
+ ner( 8) = NER_771_670
+ ner( 9) = NER_TOPDDOUBLEPRIME_771 - elem_doubling_mantle
+ ner(10) = elem_doubling_mantle
+ ner(11) = NER_CMB_TOPDDOUBLEPRIME
+ ner(12) = NER_OUTER_CORE - elem_doubling_middle_outer_core
+ ner(13) = elem_doubling_middle_outer_core
+ ner(14) = NER_TOP_CENTRAL_CUBE_ICB
+
+ ! value of the doubling ratio in each radial region of the mesh
+ ratio_sampling_array(1:2) = 1
+ ratio_sampling_array(3:9) = 2
+ ratio_sampling_array(10:12) = 4
+ ratio_sampling_array(13:14) = 8
+
+ ! value of the doubling index flag in each radial region of the mesh
+ doubling_index(1:2) = IFLAG_CRUST
+ doubling_index(3) = IFLAG_80_MOHO
+ doubling_index(4) = IFLAG_220_80
+ doubling_index(5:7) = IFLAG_670_220
+ doubling_index(8:11) = IFLAG_MANTLE_NORMAL
+ doubling_index(12:13) = IFLAG_OUTER_CORE_NORMAL
+ doubling_index(14) = IFLAG_INNER_CORE_NORMAL
+
+ ! define the three regions in which we implement a mesh doubling at the top of that region
+ this_region_has_a_doubling(:) = .false.
+ this_region_has_a_doubling(3) = .true.
+ this_region_has_a_doubling(10) = .true.
+ this_region_has_a_doubling(13) = .true.
+ this_region_has_a_doubling(14) = .false.
+ last_doubling_layer = 13
+
+ ! define the top and bottom radii of all the regions of the mesh in the radial direction
+ ! the first region is the crust at the surface of the Earth
+ ! the last region is in the inner core near the center of the Earth
+
+ r_top(1) = R_EARTH
+ r_bottom(1) = RMIDDLE_CRUST
+
+ r_top(2) = RMIDDLE_CRUST
+ r_bottom(2) = RMOHO_FICTITIOUS_IN_MESHER
+
+ r_top(3) = RMOHO_FICTITIOUS_IN_MESHER
+ r_bottom(3) = R80_FICTITIOUS_IN_MESHER
+
+ r_top(4) = R80_FICTITIOUS_IN_MESHER
+ r_bottom(4) = R220
+
+ r_top(5) = R220
+ r_bottom(5) = R400
+
+ r_top(6) = R400
+ r_bottom(6) = R600
+
+ r_top(7) = R600
+ r_bottom(7) = R670
+
+ r_top(8) = R670
+ r_bottom(8) = R771
+
+ r_top(9) = R771
+ r_bottom(9) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
+
+ r_top(10) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
+ r_bottom(10) = RTOPDDOUBLEPRIME
+
+ r_top(11) = RTOPDDOUBLEPRIME
+ r_bottom(11) = RCMB
+
+ r_top(12) = RCMB
+ r_bottom(12) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
+
+ r_top(13) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
+ r_bottom(13) = RICB
+
+ r_top(14) = RICB
+ r_bottom(14) = R_CENTRAL_CUBE
+
+ ! new definition of rmins & rmaxs
+ rmaxs(1) = ONE
+ rmins(1) = RMIDDLE_CRUST / R_EARTH
+
+ rmaxs(2) = RMIDDLE_CRUST / R_EARTH
+ rmins(2) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
+
+ rmaxs(3) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
+ rmins(3) = R80_FICTITIOUS_IN_MESHER / R_EARTH
+
+ rmaxs(4) = R80_FICTITIOUS_IN_MESHER / R_EARTH
+ rmins(4) = R220 / R_EARTH
+
+ rmaxs(5) = R220 / R_EARTH
+ rmins(5) = R400 / R_EARTH
+
+ rmaxs(6) = R400 / R_EARTH
+ rmins(6) = R600 / R_EARTH
+
+ rmaxs(7) = R600 / R_EARTH
+ rmins(7) = R670 / R_EARTH
+
+ rmaxs(8) = R670 / R_EARTH
+ rmins(8) = R771 / R_EARTH
+
+ rmaxs(9:10) = R771 / R_EARTH
+ rmins(9:10) = RTOPDDOUBLEPRIME / R_EARTH
+
+ rmaxs(11) = RTOPDDOUBLEPRIME / R_EARTH
+ rmins(11) = RCMB / R_EARTH
+
+ rmaxs(12:13) = RCMB / R_EARTH
+ rmins(12:13) = RICB / R_EARTH
+
+ rmaxs(14) = RICB / R_EARTH
+ rmins(14) = R_CENTRAL_CUBE / R_EARTH
+
+ endif
+ else
+
+ ! 4th doubling case:
+ ! includes fourth doubling at the bottom of the outer core
+
+ if (SUPPRESS_CRUSTAL_MESH) then
+
+ ! suppress the crustal layers
+ ! will be replaced by an extension of the mantle: R_EARTH is not modified,
+ ! but no more crustal doubling
+
+ NUMBER_OF_MESH_LAYERS = 15
+ layer_offset = 1
+
+ ! now only one region
+ ner( 1) = NER_CRUST + NER_80_MOHO
+ ner( 2) = 0
+ ner( 3) = 0
+
+ ner( 4) = NER_220_80
+ ner( 5) = NER_400_220
+ ner( 6) = NER_600_400
+ ner( 7) = NER_670_600
+ ner( 8) = NER_771_670
+ ner( 9) = NER_TOPDDOUBLEPRIME_771 - elem_doubling_mantle
+ ner(10) = elem_doubling_mantle
+ ner(11) = NER_CMB_TOPDDOUBLEPRIME
+ ner(12) = NER_OUTER_CORE - elem_doubling_middle_outer_core
+ ner(13) = elem_doubling_middle_outer_core - elem_doubling_bottom_outer_core
+ ner(14) = elem_doubling_bottom_outer_core
+ ner(15) = NER_TOP_CENTRAL_CUBE_ICB
+
+ ! value of the doubling ratio in each radial region of the mesh
+ ratio_sampling_array(1:9) = 1
+ ratio_sampling_array(10:12) = 2
+ ratio_sampling_array(13) = 4
+ ratio_sampling_array(14:15) = 8
+
+ ! value of the doubling index flag in each radial region of the mesh
+ doubling_index(1:3) = IFLAG_CRUST !!!!! IFLAG_80_MOHO
+ doubling_index(4) = IFLAG_220_80
+ doubling_index(5:7) = IFLAG_670_220
+ doubling_index(8:11) = IFLAG_MANTLE_NORMAL
+ doubling_index(12:14) = IFLAG_OUTER_CORE_NORMAL
+ doubling_index(15) = IFLAG_INNER_CORE_NORMAL
+
+ ! define the three regions in which we implement a mesh doubling at the top of that region
+ this_region_has_a_doubling(:) = .false.
+ this_region_has_a_doubling(10) = .true.
+ this_region_has_a_doubling(13) = .true.
+ this_region_has_a_doubling(14) = .true.
+ last_doubling_layer = 14
+
+ ! define the top and bottom radii of all the regions of the mesh in the radial direction
+ ! the first region is the crust at the surface of the Earth
+ ! the last region is in the inner core near the center of the Earth
+
+ r_top(1) = R_EARTH
+ r_bottom(1) = R80_FICTITIOUS_IN_MESHER
+
+ r_top(2) = RMIDDLE_CRUST !!!! now fictitious
+ r_bottom(2) = RMOHO_FICTITIOUS_IN_MESHER !!!! now fictitious
+
+ r_top(3) = RMOHO_FICTITIOUS_IN_MESHER !!!! now fictitious
+ r_bottom(3) = R80_FICTITIOUS_IN_MESHER !!!! now fictitious
+
+ r_top(4) = R80_FICTITIOUS_IN_MESHER
+ r_bottom(4) = R220
+
+ r_top(5) = R220
+ r_bottom(5) = R400
+
+ r_top(6) = R400
+ r_bottom(6) = R600
+
+ r_top(7) = R600
+ r_bottom(7) = R670
+
+ r_top(8) = R670
+ r_bottom(8) = R771
+
+ r_top(9) = R771
+ r_bottom(9) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
+
+ r_top(10) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
+ r_bottom(10) = RTOPDDOUBLEPRIME
+
+ r_top(11) = RTOPDDOUBLEPRIME
+ r_bottom(11) = RCMB
+
+ r_top(12) = RCMB
+ r_bottom(12) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
+
+ r_top(13) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
+ r_bottom(13) = R_EARTH - DEPTH_FOURTH_DOUBLING_REAL
+
+ r_top(14) = R_EARTH - DEPTH_FOURTH_DOUBLING_REAL
+ r_bottom(14) = RICB
+
+ r_top(15) = RICB
+ r_bottom(15) = R_CENTRAL_CUBE
+
+ ! new definition of rmins & rmaxs
+ rmaxs(1) = ONE
+ rmins(1) = R80_FICTITIOUS_IN_MESHER / R_EARTH
+
+ rmaxs(2) = RMIDDLE_CRUST / R_EARTH !!!! now fictitious
+ rmins(2) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH !!!! now fictitious
+
+ rmaxs(3) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH !!!! now fictitious
+ rmins(3) = R80_FICTITIOUS_IN_MESHER / R_EARTH !!!! now fictitious
+
+ rmaxs(4) = R80_FICTITIOUS_IN_MESHER / R_EARTH
+ rmins(4) = R220 / R_EARTH
+
+ rmaxs(5) = R220 / R_EARTH
+ rmins(5) = R400 / R_EARTH
+
+ rmaxs(6) = R400 / R_EARTH
+ rmins(6) = R600 / R_EARTH
+
+ rmaxs(7) = R600 / R_EARTH
+ rmins(7) = R670 / R_EARTH
+
+ rmaxs(8) = R670 / R_EARTH
+ rmins(8) = R771 / R_EARTH
+
+ rmaxs(9:10) = R771 / R_EARTH
+ rmins(9:10) = RTOPDDOUBLEPRIME / R_EARTH
+
+ rmaxs(11) = RTOPDDOUBLEPRIME / R_EARTH
+ rmins(11) = RCMB / R_EARTH
+
+ rmaxs(12:14) = RCMB / R_EARTH
+ rmins(12:14) = RICB / R_EARTH
+
+ rmaxs(15) = RICB / R_EARTH
+ rmins(15) = R_CENTRAL_CUBE / R_EARTH
+
+ elseif (ONE_CRUST) then
+
+ ! 1D models:
+ ! in order to increase stability and therefore to allow cheaper
+ ! simulations (larger time step), 1D models can be run with just one average crustal
+ ! layer instead of two.
+
+ NUMBER_OF_MESH_LAYERS = 14
+ layer_offset = 0
+
+ ner( 1) = NER_CRUST
+ ner( 2) = NER_80_MOHO
+ ner( 3) = NER_220_80
+ ner( 4) = NER_400_220
+ ner( 5) = NER_600_400
+ ner( 6) = NER_670_600
+ ner( 7) = NER_771_670
+ ner( 8) = NER_TOPDDOUBLEPRIME_771 - elem_doubling_mantle
+ ner( 9) = elem_doubling_mantle
+ ner(10) = NER_CMB_TOPDDOUBLEPRIME
+ ner(11) = NER_OUTER_CORE - elem_doubling_middle_outer_core
+ ner(12) = elem_doubling_middle_outer_core - elem_doubling_bottom_outer_core
+ ner(13) = elem_doubling_bottom_outer_core
+ ner(14) = NER_TOP_CENTRAL_CUBE_ICB
+
+ ! value of the doubling ratio in each radial region of the mesh
+ ratio_sampling_array(1) = 1
+ ratio_sampling_array(2:8) = 2
+ ratio_sampling_array(9:11) = 4
+ ratio_sampling_array(12) = 8
+ ratio_sampling_array(13:14) = 16
+
+ ! value of the doubling index flag in each radial region of the mesh
+ doubling_index(1) = IFLAG_CRUST
+ doubling_index(2) = IFLAG_80_MOHO
+ doubling_index(3) = IFLAG_220_80
+ doubling_index(4:6) = IFLAG_670_220
+ doubling_index(7:10) = IFLAG_MANTLE_NORMAL
+ doubling_index(11:13) = IFLAG_OUTER_CORE_NORMAL
+ doubling_index(14) = IFLAG_INNER_CORE_NORMAL
+
+ ! define the three regions in which we implement a mesh doubling at the top of that region
+ this_region_has_a_doubling(:) = .false.
+ this_region_has_a_doubling(2) = .true.
+ this_region_has_a_doubling(9) = .true.
+ this_region_has_a_doubling(12) = .true.
+ this_region_has_a_doubling(13) = .true.
+ last_doubling_layer = 13
+
+ ! define the top and bottom radii of all the regions of the mesh in the radial direction
+ ! the first region is the crust at the surface of the Earth
+ ! the last region is in the inner core near the center of the Earth
+
+ !!!!!!!!!!! DK DK UGLY: beware, is there a bug when 3D crust crosses anisotropy in the mantle?
+ !!!!!!!!!!! DK DK UGLY: i.e. if there is no thick crust there, some elements above the Moho
+ !!!!!!!!!!! DK DK UGLY: should be anisotropic but anisotropy is currently only
+ !!!!!!!!!!! DK DK UGLY: stored between d220 and MOHO to save memory? Clarify this one day.
+ !!!!!!!!!!! DK DK UGLY: The Moho stretching and squishing that Jeroen added to V4.0
+ !!!!!!!!!!! DK DK UGLY: should partly deal with this problem.
+
+ r_top(1) = R_EARTH
+ r_bottom(1) = RMOHO_FICTITIOUS_IN_MESHER
+
+ r_top(2) = RMOHO_FICTITIOUS_IN_MESHER
+ r_bottom(2) = R80_FICTITIOUS_IN_MESHER
+
+ r_top(3) = R80_FICTITIOUS_IN_MESHER
+ r_bottom(3) = R220
+
+ r_top(4) = R220
+ r_bottom(4) = R400
+
+ r_top(5) = R400
+ r_bottom(5) = R600
+
+ r_top(6) = R600
+ r_bottom(6) = R670
+
+ r_top(7) = R670
+ r_bottom(7) = R771
+
+ r_top(8) = R771
+ r_bottom(8) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
+
+ r_top(9) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
+ r_bottom(9) = RTOPDDOUBLEPRIME
+
+ r_top(10) = RTOPDDOUBLEPRIME
+ r_bottom(10) = RCMB
+
+ r_top(11) = RCMB
+ r_bottom(11) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
+
+ r_top(12) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
+ r_bottom(12) = R_EARTH - DEPTH_FOURTH_DOUBLING_REAL
+
+ r_top(13) = R_EARTH - DEPTH_FOURTH_DOUBLING_REAL
+ r_bottom(13) = RICB
+
+ r_top(14) = RICB
+ r_bottom(14) = R_CENTRAL_CUBE
+
+ ! new definition of rmins & rmaxs
+ rmaxs(1) = ONE
+ rmins(1) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
+
+ rmaxs(2) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
+ rmins(2) = R80_FICTITIOUS_IN_MESHER / R_EARTH
+
+ rmaxs(3) = R80_FICTITIOUS_IN_MESHER / R_EARTH
+ rmins(3) = R220 / R_EARTH
+
+ rmaxs(4) = R220 / R_EARTH
+ rmins(4) = R400 / R_EARTH
+
+ rmaxs(5) = R400 / R_EARTH
+ rmins(5) = R600 / R_EARTH
+
+ rmaxs(6) = R600 / R_EARTH
+ rmins(6) = R670 / R_EARTH
+
+ rmaxs(7) = R670 / R_EARTH
+ rmins(7) = R771 / R_EARTH
+
+ rmaxs(8:9) = R771 / R_EARTH
+ rmins(8:9) = RTOPDDOUBLEPRIME / R_EARTH
+
+ rmaxs(10) = RTOPDDOUBLEPRIME / R_EARTH
+ rmins(10) = RCMB / R_EARTH
+
+ rmaxs(11:13) = RCMB / R_EARTH
+ rmins(11:13) = RICB / R_EARTH
+
+ rmaxs(14) = RICB / R_EARTH
+ rmins(14) = R_CENTRAL_CUBE / R_EARTH
+
+ else
+
+ ! for 3D models:
+ ! contains the crustal layers
+ ! doubling at the base of the crust
+
+ NUMBER_OF_MESH_LAYERS = 15
+ layer_offset = 1
+ if ((RMIDDLE_CRUST-RMOHO_FICTITIOUS_IN_MESHER)<(R_EARTH-RMIDDLE_CRUST)) then
+ ner( 1) = ceiling (NER_CRUST / 2.d0)
+ ner( 2) = floor (NER_CRUST / 2.d0)
+ else
+ ner( 1) = floor (NER_CRUST / 2.d0)
+ ner( 2) = ceiling (NER_CRUST / 2.d0)
+ endif
+ ner( 3) = NER_80_MOHO
+ ner( 4) = NER_220_80
+ ner( 5) = NER_400_220
+ ner( 6) = NER_600_400
+ ner( 7) = NER_670_600
+ ner( 8) = NER_771_670
+ ner( 9) = NER_TOPDDOUBLEPRIME_771 - elem_doubling_mantle
+ ner(10) = elem_doubling_mantle
+ ner(11) = NER_CMB_TOPDDOUBLEPRIME
+ ner(12) = NER_OUTER_CORE - elem_doubling_middle_outer_core
+ ner(13) = elem_doubling_middle_outer_core - elem_doubling_bottom_outer_core
+ ner(14) = elem_doubling_bottom_outer_core
+ ner(15) = NER_TOP_CENTRAL_CUBE_ICB
+
+ ! value of the doubling ratio in each radial region of the mesh
+ ratio_sampling_array(1:2) = 1
+ ratio_sampling_array(3:9) = 2
+ ratio_sampling_array(10:12) = 4
+ ratio_sampling_array(13) = 8
+ ratio_sampling_array(14:15) = 16
+
+ ! value of the doubling index flag in each radial region of the mesh
+ doubling_index(1:2) = IFLAG_CRUST
+ doubling_index(3) = IFLAG_80_MOHO
+ doubling_index(4) = IFLAG_220_80
+ doubling_index(5:7) = IFLAG_670_220
+ doubling_index(8:11) = IFLAG_MANTLE_NORMAL
+ doubling_index(12:14) = IFLAG_OUTER_CORE_NORMAL
+ doubling_index(15) = IFLAG_INNER_CORE_NORMAL
+
+ ! define the three regions in which we implement a mesh doubling at the top of that region
+ this_region_has_a_doubling(:) = .false.
+ this_region_has_a_doubling(3) = .true.
+ this_region_has_a_doubling(10) = .true.
+ this_region_has_a_doubling(13) = .true.
+ this_region_has_a_doubling(14) = .true.
+ last_doubling_layer = 14
+
+ ! define the top and bottom radii of all the regions of the mesh in the radial direction
+ ! the first region is the crust at the surface of the Earth
+ ! the last region is in the inner core near the center of the Earth
+
+ r_top(1) = R_EARTH
+ r_bottom(1) = RMIDDLE_CRUST
+
+ r_top(2) = RMIDDLE_CRUST
+ r_bottom(2) = RMOHO_FICTITIOUS_IN_MESHER
+
+ r_top(3) = RMOHO_FICTITIOUS_IN_MESHER
+ r_bottom(3) = R80_FICTITIOUS_IN_MESHER
+
+ r_top(4) = R80_FICTITIOUS_IN_MESHER
+ r_bottom(4) = R220
+
+ r_top(5) = R220
+ r_bottom(5) = R400
+
+ r_top(6) = R400
+ r_bottom(6) = R600
+
+ r_top(7) = R600
+ r_bottom(7) = R670
+
+ r_top(8) = R670
+ r_bottom(8) = R771
+
+ r_top(9) = R771
+ r_bottom(9) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
+
+ r_top(10) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
+ r_bottom(10) = RTOPDDOUBLEPRIME
+
+ r_top(11) = RTOPDDOUBLEPRIME
+ r_bottom(11) = RCMB
+
+ r_top(12) = RCMB
+ r_bottom(12) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
+
+ r_top(13) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
+ r_bottom(13) = R_EARTH - DEPTH_FOURTH_DOUBLING_REAL
+
+ r_top(14) = R_EARTH - DEPTH_FOURTH_DOUBLING_REAL
+ r_bottom(14) = RICB
+
+ r_top(15) = RICB
+ r_bottom(15) = R_CENTRAL_CUBE
+
+ ! new definition of rmins & rmaxs
+ rmaxs(1) = ONE
+ rmins(1) = RMIDDLE_CRUST / R_EARTH
+
+ rmaxs(2) = RMIDDLE_CRUST / R_EARTH
+ rmins(2) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
+
+ rmaxs(3) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
+ rmins(3) = R80_FICTITIOUS_IN_MESHER / R_EARTH
+
+ rmaxs(4) = R80_FICTITIOUS_IN_MESHER / R_EARTH
+ rmins(4) = R220 / R_EARTH
+
+ rmaxs(5) = R220 / R_EARTH
+ rmins(5) = R400 / R_EARTH
+
+ rmaxs(6) = R400 / R_EARTH
+ rmins(6) = R600 / R_EARTH
+
+ rmaxs(7) = R600 / R_EARTH
+ rmins(7) = R670 / R_EARTH
+
+ rmaxs(8) = R670 / R_EARTH
+ rmins(8) = R771 / R_EARTH
+
+ rmaxs(9:10) = R771 / R_EARTH
+ rmins(9:10) = RTOPDDOUBLEPRIME / R_EARTH
+
+ rmaxs(11) = RTOPDDOUBLEPRIME / R_EARTH
+ rmins(11) = RCMB / R_EARTH
+
+ rmaxs(12:14) = RCMB / R_EARTH
+ rmins(12:14) = RICB / R_EARTH
+
+ rmaxs(15) = RICB / R_EARTH
+ rmins(15) = R_CENTRAL_CUBE / R_EARTH
+ endif
+ endif
+
+
+ end subroutine define_all_layers
+
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/get_timestep_and_layers.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/get_timestep_and_layers.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/get_timestep_and_layers.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -0,0 +1,455 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+
+ subroutine get_timestep_and_layers(DT,MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD, &
+ NER_CRUST,NER_80_MOHO,NER_220_80,NER_400_220,&
+ NER_600_400,NER_670_600,NER_771_670, &
+ NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
+ NER_TOP_CENTRAL_CUBE_ICB,R_CENTRAL_CUBE, &
+ NEX_MAX,NCHUNKS,REFERENCE_1D_MODEL,THREE_D_MODEL, &
+ ANGULAR_WIDTH_XI_IN_DEGREES,ANGULAR_WIDTH_ETA_IN_DEGREES,&
+ ONE_CRUST,HONOR_1D_SPHERICAL_MOHO,CASE_3D,CRUSTAL, &
+ ANISOTROPIC_INNER_CORE)
+
+
+ implicit none
+
+ include "constants.h"
+
+ ! parameters read from parameter file
+ integer MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD
+
+ integer NER_CRUST,NER_80_MOHO,NER_220_80,NER_400_220,NER_600_400,NER_670_600,NER_771_670, &
+ NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
+ NER_TOP_CENTRAL_CUBE_ICB
+
+ integer NEX_MAX,NCHUNKS,REFERENCE_1D_MODEL,THREE_D_MODEL
+
+ double precision DT
+ double precision R_CENTRAL_CUBE
+ double precision ANGULAR_WIDTH_XI_IN_DEGREES,ANGULAR_WIDTH_ETA_IN_DEGREES
+
+ logical ONE_CRUST,HONOR_1D_SPHERICAL_MOHO,CASE_3D,CRUSTAL,ANISOTROPIC_INNER_CORE
+
+ ! local variables
+ integer multiplication_factor
+
+ !----
+ !---- case prem_onecrust by default
+ !----
+ if (SUPPRESS_CRUSTAL_MESH) then
+ multiplication_factor=2
+ else
+ multiplication_factor=1
+ endif
+
+ ! element width = 0.5625000 degrees = 62.54715 km
+ if(NEX_MAX*multiplication_factor <= 160) then
+ ! time step
+ DT = 0.252d0
+
+ ! attenuation period range
+ MIN_ATTENUATION_PERIOD = 30
+ MAX_ATTENUATION_PERIOD = 1500
+
+ ! number of element layers in each mesh region
+ NER_CRUST = 1
+ NER_80_MOHO = 1
+ NER_220_80 = 2
+ NER_400_220 = 2
+ NER_600_400 = 2
+ NER_670_600 = 1
+ NER_771_670 = 1
+ NER_TOPDDOUBLEPRIME_771 = 15
+ NER_CMB_TOPDDOUBLEPRIME = 1
+ NER_OUTER_CORE = 16
+ NER_TOP_CENTRAL_CUBE_ICB = 2
+
+ ! radius of central cube
+ R_CENTRAL_CUBE = 950000.d0
+
+ ! element width = 0.3515625 degrees = 39.09196 km
+ else if(NEX_MAX*multiplication_factor <= 256) then
+ DT = 0.225d0
+
+ MIN_ATTENUATION_PERIOD = 20
+ MAX_ATTENUATION_PERIOD = 1000
+
+ NER_CRUST = 1
+ NER_80_MOHO = 1
+ NER_220_80 = 2
+ NER_400_220 = 3
+ NER_600_400 = 3
+ NER_670_600 = 1
+ NER_771_670 = 1
+ NER_TOPDDOUBLEPRIME_771 = 22
+ NER_CMB_TOPDDOUBLEPRIME = 2
+ NER_OUTER_CORE = 24
+ NER_TOP_CENTRAL_CUBE_ICB = 3
+ R_CENTRAL_CUBE = 965000.d0
+
+ ! element width = 0.2812500 degrees = 31.27357 km
+ else if(NEX_MAX*multiplication_factor <= 320) then
+ DT = 0.16d0
+
+ MIN_ATTENUATION_PERIOD = 15
+ MAX_ATTENUATION_PERIOD = 750
+
+ NER_CRUST = 1
+ NER_80_MOHO = 1
+ NER_220_80 = 3
+ NER_400_220 = 4
+ NER_600_400 = 4
+ NER_670_600 = 1
+ NER_771_670 = 2
+ NER_TOPDDOUBLEPRIME_771 = 29
+ NER_CMB_TOPDDOUBLEPRIME = 2
+ NER_OUTER_CORE = 32
+ NER_TOP_CENTRAL_CUBE_ICB = 4
+ R_CENTRAL_CUBE = 940000.d0
+
+ ! element width = 0.1875000 degrees = 20.84905 km
+ else if(NEX_MAX*multiplication_factor <= 480) then
+ DT = 0.11d0
+
+ MIN_ATTENUATION_PERIOD = 10
+ MAX_ATTENUATION_PERIOD = 500
+
+ NER_CRUST = 1
+ NER_80_MOHO = 2
+ NER_220_80 = 4
+ NER_400_220 = 5
+ NER_600_400 = 6
+ NER_670_600 = 2
+ NER_771_670 = 2
+ NER_TOPDDOUBLEPRIME_771 = 44
+ NER_CMB_TOPDDOUBLEPRIME = 3
+ NER_OUTER_CORE = 48
+ NER_TOP_CENTRAL_CUBE_ICB = 5
+ R_CENTRAL_CUBE = 988000.d0
+
+ ! element width = 0.1757812 degrees = 19.54598 km
+ else if(NEX_MAX*multiplication_factor <= 512) then
+ DT = 0.1125d0
+
+ MIN_ATTENUATION_PERIOD = 9
+ MAX_ATTENUATION_PERIOD = 500
+
+ NER_CRUST = 1
+ NER_80_MOHO = 2
+ NER_220_80 = 4
+ NER_400_220 = 6
+ NER_600_400 = 6
+ NER_670_600 = 2
+ NER_771_670 = 3
+ NER_TOPDDOUBLEPRIME_771 = 47
+ NER_CMB_TOPDDOUBLEPRIME = 3
+ NER_OUTER_CORE = 51
+ NER_TOP_CENTRAL_CUBE_ICB = 5
+ R_CENTRAL_CUBE = 1010000.d0
+
+ ! element width = 0.1406250 degrees = 15.63679 km
+ else if(NEX_MAX*multiplication_factor <= 640) then
+ DT = 0.09d0
+
+ MIN_ATTENUATION_PERIOD = 8
+ MAX_ATTENUATION_PERIOD = 400
+
+ NER_CRUST = 2
+ NER_80_MOHO = 3
+ NER_220_80 = 5
+ NER_400_220 = 7
+ NER_600_400 = 8
+ NER_670_600 = 3
+ NER_771_670 = 3
+ NER_TOPDDOUBLEPRIME_771 = 59
+ NER_CMB_TOPDDOUBLEPRIME = 4
+ NER_OUTER_CORE = 64
+ NER_TOP_CENTRAL_CUBE_ICB = 6
+ R_CENTRAL_CUBE = 1020000.d0
+
+ ! element width = 0.1041667 degrees = 11.58280 km
+ else if(NEX_MAX*multiplication_factor <= 864) then
+ DT = 0.0667d0
+
+ MIN_ATTENUATION_PERIOD = 6
+ MAX_ATTENUATION_PERIOD = 300
+
+ NER_CRUST = 2
+ NER_80_MOHO = 4
+ NER_220_80 = 6
+ NER_400_220 = 10
+ NER_600_400 = 10
+ NER_670_600 = 3
+ NER_771_670 = 4
+ NER_TOPDDOUBLEPRIME_771 = 79
+ NER_CMB_TOPDDOUBLEPRIME = 5
+ NER_OUTER_CORE = 86
+ NER_TOP_CENTRAL_CUBE_ICB = 9
+ R_CENTRAL_CUBE = 990000.d0
+
+ ! element width = 7.8125000E-02 degrees = 8.687103 km
+ else if(NEX_MAX*multiplication_factor <= 1152) then
+ DT = 0.05d0
+
+ MIN_ATTENUATION_PERIOD = 4
+ MAX_ATTENUATION_PERIOD = 200
+
+ NER_CRUST = 3
+ NER_80_MOHO = 6
+ NER_220_80 = 8
+ NER_400_220 = 13
+ NER_600_400 = 13
+ NER_670_600 = 4
+ NER_771_670 = 6
+ NER_TOPDDOUBLEPRIME_771 = 106
+ NER_CMB_TOPDDOUBLEPRIME = 7
+ NER_OUTER_CORE = 116
+ NER_TOP_CENTRAL_CUBE_ICB = 12
+ R_CENTRAL_CUBE = 985000.d0
+
+ ! element width = 7.2115384E-02 degrees = 8.018865 km
+ else if(NEX_MAX*multiplication_factor <= 1248) then
+ DT = 0.0462d0
+
+ MIN_ATTENUATION_PERIOD = 4
+ MAX_ATTENUATION_PERIOD = 200
+
+ NER_CRUST = 3
+ NER_80_MOHO = 6
+ NER_220_80 = 9
+ NER_400_220 = 14
+ NER_600_400 = 14
+ NER_670_600 = 5
+ NER_771_670 = 6
+ NER_TOPDDOUBLEPRIME_771 = 114
+ NER_CMB_TOPDDOUBLEPRIME = 8
+ NER_OUTER_CORE = 124
+ NER_TOP_CENTRAL_CUBE_ICB = 13
+ R_CENTRAL_CUBE = 985000.d0
+
+ else
+
+ ! scale with respect to 1248 if above that limit
+ DT = 0.0462d0 * 1248.d0 / (2.d0*NEX_MAX)
+
+ MIN_ATTENUATION_PERIOD = 4
+ MAX_ATTENUATION_PERIOD = 200
+
+ NER_CRUST = nint(3 * 2.d0*NEX_MAX / 1248.d0)
+ NER_80_MOHO = nint(6 * 2.d0*NEX_MAX / 1248.d0)
+ NER_220_80 = nint(9 * 2.d0*NEX_MAX / 1248.d0)
+ NER_400_220 = nint(14 * 2.d0*NEX_MAX / 1248.d0)
+ NER_600_400 = nint(14 * 2.d0*NEX_MAX / 1248.d0)
+ NER_670_600 = nint(5 * 2.d0*NEX_MAX / 1248.d0)
+ NER_771_670 = nint(6 * 2.d0*NEX_MAX / 1248.d0)
+ NER_TOPDDOUBLEPRIME_771 = nint(114 * 2.d0*NEX_MAX / 1248.d0)
+ NER_CMB_TOPDDOUBLEPRIME = nint(8 * 2.d0*NEX_MAX / 1248.d0)
+ NER_OUTER_CORE = nint(124 * 2.d0*NEX_MAX / 1248.d0)
+ NER_TOP_CENTRAL_CUBE_ICB = nint(13 * 2.d0*NEX_MAX / 1248.d0)
+ R_CENTRAL_CUBE = 985000.d0
+
+ !! removed this limit else
+ !! removed this limit stop 'problem with this value of NEX_MAX'
+ endif
+
+ !> Hejun
+ ! avoids elongated elements below the 670-discontinuity,
+ ! since for model REFERENCE_MODEL_1DREF,
+ ! the 670-discontinuity is moved up to 650 km depth.
+ if (REFERENCE_1D_MODEL == REFERENCE_MODEL_1DREF) then
+ NER_771_670 = NER_771_670 + 1
+ end if
+
+ !----
+ !---- change some values in the case of regular PREM with two crustal layers or of 3D models
+ !----
+
+ ! case of regular PREM with two crustal layers: change the time step for small meshes
+ ! because of a different size of elements in the radial direction in the crust
+ if (HONOR_1D_SPHERICAL_MOHO) then
+ ! 1D models honor 1D spherical moho
+ if (.not. ONE_CRUST) then
+ ! case 1D + two crustal layers
+ if (NER_CRUST < 2 ) NER_CRUST = 2
+ ! makes time step smaller
+ if(NEX_MAX*multiplication_factor <= 160) then
+ DT = 0.20d0
+ else if(NEX_MAX*multiplication_factor <= 256) then
+ DT = 0.20d0
+ endif
+ endif
+ else
+ ! 3D models: must have two element layers for crust
+ if (NER_CRUST < 2 ) NER_CRUST = 2
+ ! makes time step smaller
+ if(NEX_MAX*multiplication_factor <= 80) then
+ DT = 0.125d0
+ else if(NEX_MAX*multiplication_factor <= 160) then
+ DT = 0.15d0
+ else if(NEX_MAX*multiplication_factor <= 256) then
+ DT = 0.17d0
+ else if(NEX_MAX*multiplication_factor <= 320) then
+ DT = 0.155d0
+ endif
+ endif
+
+ if( .not. ATTENUATION_RANGE_PREDEFINED ) then
+ call auto_attenuation_periods(ANGULAR_WIDTH_XI_IN_DEGREES, NEX_MAX, &
+ MIN_ATTENUATION_PERIOD, MAX_ATTENUATION_PERIOD)
+ endif
+
+ if(ANGULAR_WIDTH_XI_IN_DEGREES < 90.0d0 .or. &
+ ANGULAR_WIDTH_ETA_IN_DEGREES < 90.0d0 .or. &
+ NEX_MAX > 1248) then
+
+ call auto_ner(ANGULAR_WIDTH_XI_IN_DEGREES, NEX_MAX, &
+ NER_CRUST, NER_80_MOHO, NER_220_80, NER_400_220, NER_600_400, &
+ NER_670_600, NER_771_670, NER_TOPDDOUBLEPRIME_771, &
+ NER_CMB_TOPDDOUBLEPRIME, NER_OUTER_CORE, NER_TOP_CENTRAL_CUBE_ICB, &
+ R_CENTRAL_CUBE, CASE_3D, CRUSTAL, &
+ HONOR_1D_SPHERICAL_MOHO, REFERENCE_1D_MODEL)
+
+ call auto_attenuation_periods(ANGULAR_WIDTH_XI_IN_DEGREES, NEX_MAX, &
+ MIN_ATTENUATION_PERIOD, MAX_ATTENUATION_PERIOD)
+
+ call auto_time_stepping(ANGULAR_WIDTH_XI_IN_DEGREES, NEX_MAX, DT)
+
+ !! DK DK suppressed because this routine should not write anything to the screen
+ ! write(*,*)'##############################################################'
+ ! write(*,*)
+ ! write(*,*)' Auto Radial Meshing Code '
+ ! write(*,*)' Consult read_compute_parameters.f90 and auto_ner.f90 '
+ ! write(*,*)' This should only be invoked for chunks less than 90 degrees'
+ ! write(*,*)' and for chunks greater than 1248 elements wide'
+ ! write(*,*)
+ ! write(*,*)'CHUNK WIDTH: ', ANGULAR_WIDTH_XI_IN_DEGREES
+ ! write(*,*)'NEX: ', NEX_MAX
+ ! write(*,*)'NER_CRUST: ', NER_CRUST
+ ! write(*,*)'NER_80_MOHO: ', NER_80_MOHO
+ ! write(*,*)'NER_220_80: ', NER_220_80
+ ! write(*,*)'NER_400_220: ', NER_400_220
+ ! write(*,*)'NER_600_400: ', NER_600_400
+ ! write(*,*)'NER_670_600: ', NER_670_600
+ ! write(*,*)'NER_771_670: ', NER_771_670
+ ! write(*,*)'NER_TOPDDOUBLEPRIME_771: ', NER_TOPDDOUBLEPRIME_771
+ ! write(*,*)'NER_CMB_TOPDDOUBLEPRIME: ', NER_CMB_TOPDDOUBLEPRIME
+ ! write(*,*)'NER_OUTER_CORE: ', NER_OUTER_CORE
+ ! write(*,*)'NER_TOP_CENTRAL_CUBE_ICB: ', NER_TOP_CENTRAL_CUBE_ICB
+ ! write(*,*)'R_CENTRAL_CUBE: ', R_CENTRAL_CUBE
+ ! write(*,*)'multiplication factor: ', multiplication_factor
+ ! write(*,*)
+ ! write(*,*)'DT: ',DT
+ ! write(*,*)'MIN_ATTENUATION_PERIOD ',MIN_ATTENUATION_PERIOD
+ ! write(*,*)'MAX_ATTENUATION_PERIOD ',MAX_ATTENUATION_PERIOD
+ ! write(*,*)
+ ! write(*,*)'##############################################################'
+
+ if (HONOR_1D_SPHERICAL_MOHO) then
+ if (.not. ONE_CRUST) then
+ ! case 1D + two crustal layers
+ if (NER_CRUST < 2 ) NER_CRUST = 2
+ endif
+ else
+ ! case 3D
+ if (NER_CRUST < 2 ) NER_CRUST = 2
+ endif
+
+ endif
+
+!---
+!
+! ADD YOUR MODEL HERE
+!
+!---
+
+
+ ! time step reductions are based on empirical values (..somehow)
+
+ ! following models need special attention, at least for global simulations:
+ if( NCHUNKS == 6 ) then
+
+ ! makes time step smaller for this ref model, otherwise becomes unstable in fluid
+ if (REFERENCE_1D_MODEL == REFERENCE_MODEL_IASP91) &
+ DT = DT*(1.d0 - 0.3d0)
+
+ ! using inner core anisotropy, simulations might become unstable in solid
+ if( ANISOTROPIC_INNER_CORE ) then
+ ! DT = DT*(1.d0 - 0.1d0) not working yet...
+ stop 'anisotropic inner core - unstable feature, uncomment this line in get_timestep_and_layers.f90'
+ endif
+
+!daniel: debug
+ ! makes time step smaller for this ref model
+ if( NEX_MAX*multiplication_factor <= 98 ) then
+ if( THREE_D_MODEL == THREE_D_MODEL_S362ANI ) DT = DT*(1.d0 - 0.95d0)
+ endif
+
+ endif
+
+ ! following models need special attention, regardless of number of chunks:
+ ! it makes the time step smaller for this ref model, otherwise becomes unstable in fluid
+ if (REFERENCE_1D_MODEL == REFERENCE_MODEL_1066A) &
+ DT = DT*(1.d0 - 0.8d0) ! *0.20d0
+
+
+ if( ITYPE_CRUSTAL_MODEL == ICRUST_CRUSTMAPS ) &
+ DT = DT*(1.d0 - 0.3d0)
+
+ ! decreases time step as otherwise the solution might become unstable for rougher/unsmoothed models
+ ! if( THREE_D_MODEL == THREE_D_MODEL_PPM ) &
+ ! DT = DT * (1.d0 - 0.2d0)
+
+ ! takes a 5% safety margin on the maximum stable time step
+ ! which was obtained by trial and error
+ DT = DT * (1.d0 - 0.05d0)
+
+ ! adapts number of element layers in crust and time step for regional simulations
+ if( REGIONAL_MOHO_MESH ) then
+ ! hard coded number of crustal element layers and time step
+
+ ! checks
+ if( NCHUNKS > 1 ) stop 'regional moho mesh: NCHUNKS error in rcp_set_timestep_and_layers'
+ if( HONOR_1D_SPHERICAL_MOHO ) return
+
+ ! original values
+ !print*,'NER:',NER_CRUST
+ !print*,'DT:',DT
+
+ ! enforce 3 element layers
+ NER_CRUST = 3
+
+ ! increased stability, empirical
+ DT = DT*(1.d0 + 0.5d0)
+
+ if( REGIONAL_MOHO_MESH_EUROPE ) DT = 0.17 ! europe
+ if( REGIONAL_MOHO_MESH_ASIA ) DT = 0.15 ! asia & middle east
+
+ endif
+
+ end subroutine get_timestep_and_layers
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/memory_eval.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/memory_eval.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/memory_eval.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -241,10 +241,6 @@
! ibool_outer_core
static_memory_size = static_memory_size + dble(NGLLX)*dble(NGLLY)*dble(NGLLZ)*NSPEC(IREGION_OUTER_CORE)*dble(SIZE_INTEGER)
-! idoubling_crust_mantle (not needed anymore..)
-! static_memory_size = static_memory_size + NSPEC(IREGION_CRUST_MANTLE)*dble(SIZE_INTEGER)
-! idoubling_outer_core
-! static_memory_size = static_memory_size + NSPEC(IREGION_OUTER_CORE)*dble(SIZE_INTEGER)
! idoubling_inner_core
static_memory_size = static_memory_size + NSPEC(IREGION_INNER_CORE)*dble(SIZE_INTEGER)
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/read_compute_parameters.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/read_compute_parameters.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/shared/read_compute_parameters.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -212,15 +212,16 @@
R80_FICTITIOUS_IN_MESHER,RHO_TOP_OC,RHO_BOTTOM_OC,RHO_OCEANS)
+ NEX_MAX = max(NEX_XI,NEX_ETA)
+
! sets time step size and number of layers
! right distribution is determined based upon maximum value of NEX
- NEX_MAX = max(NEX_XI,NEX_ETA)
- call rcp_set_timestep_and_layers(DT,MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD, &
+ call get_timestep_and_layers(DT,MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD, &
NER_CRUST,NER_80_MOHO,NER_220_80,NER_400_220,&
NER_600_400,NER_670_600,NER_771_670, &
NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
NER_TOP_CENTRAL_CUBE_ICB,R_CENTRAL_CUBE, &
- NEX_MAX,NCHUNKS,REFERENCE_1D_MODEL, &
+ NEX_MAX,NCHUNKS,REFERENCE_1D_MODEL,THREE_D_MODEL, &
ANGULAR_WIDTH_XI_IN_DEGREES,ANGULAR_WIDTH_ETA_IN_DEGREES,&
ONE_CRUST,HONOR_1D_SPHERICAL_MOHO,CASE_3D,CRUSTAL, &
ANISOTROPIC_INNER_CORE)
@@ -299,7 +300,7 @@
! definition of general mesh parameters
- call rcp_define_all_layers(NER_CRUST,NER_80_MOHO,NER_220_80,&
+ call define_all_layers(NER_CRUST,NER_80_MOHO,NER_220_80,&
NER_400_220,NER_600_400,NER_670_600,NER_771_670, &
NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
NER_TOP_CENTRAL_CUBE_ICB,&
@@ -316,7 +317,7 @@
! calculates number of elements (NSPEC)
- call rcp_count_elements(NEX_XI,NEX_ETA,NEX_PER_PROC_XI,NPROC,&
+ call count_elements(NEX_XI,NEX_ETA,NEX_PER_PROC_XI,NPROC,&
NEX_PER_PROC_ETA,ratio_divide_central_cube,&
NSPEC,NSPEC2D_XI,NSPEC2D_ETA, &
NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
@@ -335,7 +336,7 @@
! calculates number of points (NGLOB)
- call rcp_count_points(NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube,&
+ call count_points(NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube,&
NSPEC1D_RADIAL,NGLOB1D_RADIAL, &
NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX,NGLOB,&
nblocks_xi,nblocks_eta,ner,ratio_sampling_array,&
@@ -353,436 +354,8 @@
end subroutine read_compute_parameters
-!
-!-------------------------------------------------------------------------------------------------
-!
- subroutine rcp_set_timestep_and_layers(DT,MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD, &
- NER_CRUST,NER_80_MOHO,NER_220_80,NER_400_220,&
- NER_600_400,NER_670_600,NER_771_670, &
- NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
- NER_TOP_CENTRAL_CUBE_ICB,R_CENTRAL_CUBE, &
- NEX_MAX,NCHUNKS,REFERENCE_1D_MODEL, &
- ANGULAR_WIDTH_XI_IN_DEGREES,ANGULAR_WIDTH_ETA_IN_DEGREES,&
- ONE_CRUST,HONOR_1D_SPHERICAL_MOHO,CASE_3D,CRUSTAL, &
- ANISOTROPIC_INNER_CORE)
-
-
- implicit none
-
- include "constants.h"
-
-! parameters read from parameter file
- integer MIN_ATTENUATION_PERIOD,MAX_ATTENUATION_PERIOD
-
- integer NER_CRUST,NER_80_MOHO,NER_220_80,NER_400_220,NER_600_400,NER_670_600,NER_771_670, &
- NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
- NER_TOP_CENTRAL_CUBE_ICB
-
- integer NEX_MAX,NCHUNKS,REFERENCE_1D_MODEL
-
- double precision DT
- double precision R_CENTRAL_CUBE
- double precision ANGULAR_WIDTH_XI_IN_DEGREES,ANGULAR_WIDTH_ETA_IN_DEGREES
-
- logical ONE_CRUST,HONOR_1D_SPHERICAL_MOHO,CASE_3D,CRUSTAL,ANISOTROPIC_INNER_CORE
-
-! local variables
- integer multiplication_factor
-
- !----
- !---- case prem_onecrust by default
- !----
- if (SUPPRESS_CRUSTAL_MESH) then
- multiplication_factor=2
- else
- multiplication_factor=1
- endif
-
- ! element width = 0.5625000 degrees = 62.54715 km
- if(NEX_MAX*multiplication_factor <= 160) then
- ! time step
- DT = 0.252d0
-
- ! attenuation period range
- MIN_ATTENUATION_PERIOD = 30
- MAX_ATTENUATION_PERIOD = 1500
-
- ! number of element layers in each mesh region
- NER_CRUST = 1
- NER_80_MOHO = 1
- NER_220_80 = 2
- NER_400_220 = 2
- NER_600_400 = 2
- NER_670_600 = 1
- NER_771_670 = 1
- NER_TOPDDOUBLEPRIME_771 = 15
- NER_CMB_TOPDDOUBLEPRIME = 1
- NER_OUTER_CORE = 16
- NER_TOP_CENTRAL_CUBE_ICB = 2
-
- ! radius of central cube
- R_CENTRAL_CUBE = 950000.d0
-
- ! element width = 0.3515625 degrees = 39.09196 km
- else if(NEX_MAX*multiplication_factor <= 256) then
- DT = 0.225d0
-
- MIN_ATTENUATION_PERIOD = 20
- MAX_ATTENUATION_PERIOD = 1000
-
- NER_CRUST = 1
- NER_80_MOHO = 1
- NER_220_80 = 2
- NER_400_220 = 3
- NER_600_400 = 3
- NER_670_600 = 1
- NER_771_670 = 1
- NER_TOPDDOUBLEPRIME_771 = 22
- NER_CMB_TOPDDOUBLEPRIME = 2
- NER_OUTER_CORE = 24
- NER_TOP_CENTRAL_CUBE_ICB = 3
- R_CENTRAL_CUBE = 965000.d0
-
- ! element width = 0.2812500 degrees = 31.27357 km
- else if(NEX_MAX*multiplication_factor <= 320) then
- DT = 0.16d0
-
- MIN_ATTENUATION_PERIOD = 15
- MAX_ATTENUATION_PERIOD = 750
-
- NER_CRUST = 1
- NER_80_MOHO = 1
- NER_220_80 = 3
- NER_400_220 = 4
- NER_600_400 = 4
- NER_670_600 = 1
- NER_771_670 = 2
- NER_TOPDDOUBLEPRIME_771 = 29
- NER_CMB_TOPDDOUBLEPRIME = 2
- NER_OUTER_CORE = 32
- NER_TOP_CENTRAL_CUBE_ICB = 4
- R_CENTRAL_CUBE = 940000.d0
-
- ! element width = 0.1875000 degrees = 20.84905 km
- else if(NEX_MAX*multiplication_factor <= 480) then
- DT = 0.11d0
-
- MIN_ATTENUATION_PERIOD = 10
- MAX_ATTENUATION_PERIOD = 500
-
- NER_CRUST = 1
- NER_80_MOHO = 2
- NER_220_80 = 4
- NER_400_220 = 5
- NER_600_400 = 6
- NER_670_600 = 2
- NER_771_670 = 2
- NER_TOPDDOUBLEPRIME_771 = 44
- NER_CMB_TOPDDOUBLEPRIME = 3
- NER_OUTER_CORE = 48
- NER_TOP_CENTRAL_CUBE_ICB = 5
- R_CENTRAL_CUBE = 988000.d0
-
- ! element width = 0.1757812 degrees = 19.54598 km
- else if(NEX_MAX*multiplication_factor <= 512) then
- DT = 0.1125d0
-
- MIN_ATTENUATION_PERIOD = 9
- MAX_ATTENUATION_PERIOD = 500
-
- NER_CRUST = 1
- NER_80_MOHO = 2
- NER_220_80 = 4
- NER_400_220 = 6
- NER_600_400 = 6
- NER_670_600 = 2
- NER_771_670 = 3
- NER_TOPDDOUBLEPRIME_771 = 47
- NER_CMB_TOPDDOUBLEPRIME = 3
- NER_OUTER_CORE = 51
- NER_TOP_CENTRAL_CUBE_ICB = 5
- R_CENTRAL_CUBE = 1010000.d0
-
- ! element width = 0.1406250 degrees = 15.63679 km
- else if(NEX_MAX*multiplication_factor <= 640) then
- DT = 0.09d0
-
- MIN_ATTENUATION_PERIOD = 8
- MAX_ATTENUATION_PERIOD = 400
-
- NER_CRUST = 2
- NER_80_MOHO = 3
- NER_220_80 = 5
- NER_400_220 = 7
- NER_600_400 = 8
- NER_670_600 = 3
- NER_771_670 = 3
- NER_TOPDDOUBLEPRIME_771 = 59
- NER_CMB_TOPDDOUBLEPRIME = 4
- NER_OUTER_CORE = 64
- NER_TOP_CENTRAL_CUBE_ICB = 6
- R_CENTRAL_CUBE = 1020000.d0
-
- ! element width = 0.1041667 degrees = 11.58280 km
- else if(NEX_MAX*multiplication_factor <= 864) then
- DT = 0.0667d0
-
- MIN_ATTENUATION_PERIOD = 6
- MAX_ATTENUATION_PERIOD = 300
-
- NER_CRUST = 2
- NER_80_MOHO = 4
- NER_220_80 = 6
- NER_400_220 = 10
- NER_600_400 = 10
- NER_670_600 = 3
- NER_771_670 = 4
- NER_TOPDDOUBLEPRIME_771 = 79
- NER_CMB_TOPDDOUBLEPRIME = 5
- NER_OUTER_CORE = 86
- NER_TOP_CENTRAL_CUBE_ICB = 9
- R_CENTRAL_CUBE = 990000.d0
-
- ! element width = 7.8125000E-02 degrees = 8.687103 km
- else if(NEX_MAX*multiplication_factor <= 1152) then
- DT = 0.05d0
-
- MIN_ATTENUATION_PERIOD = 4
- MAX_ATTENUATION_PERIOD = 200
-
- NER_CRUST = 3
- NER_80_MOHO = 6
- NER_220_80 = 8
- NER_400_220 = 13
- NER_600_400 = 13
- NER_670_600 = 4
- NER_771_670 = 6
- NER_TOPDDOUBLEPRIME_771 = 106
- NER_CMB_TOPDDOUBLEPRIME = 7
- NER_OUTER_CORE = 116
- NER_TOP_CENTRAL_CUBE_ICB = 12
- R_CENTRAL_CUBE = 985000.d0
-
- ! element width = 7.2115384E-02 degrees = 8.018865 km
- else if(NEX_MAX*multiplication_factor <= 1248) then
- DT = 0.0462d0
-
- MIN_ATTENUATION_PERIOD = 4
- MAX_ATTENUATION_PERIOD = 200
-
- NER_CRUST = 3
- NER_80_MOHO = 6
- NER_220_80 = 9
- NER_400_220 = 14
- NER_600_400 = 14
- NER_670_600 = 5
- NER_771_670 = 6
- NER_TOPDDOUBLEPRIME_771 = 114
- NER_CMB_TOPDDOUBLEPRIME = 8
- NER_OUTER_CORE = 124
- NER_TOP_CENTRAL_CUBE_ICB = 13
- R_CENTRAL_CUBE = 985000.d0
-
- else
-
- ! scale with respect to 1248 if above that limit
- DT = 0.0462d0 * 1248.d0 / (2.d0*NEX_MAX)
-
- MIN_ATTENUATION_PERIOD = 4
- MAX_ATTENUATION_PERIOD = 200
-
- NER_CRUST = nint(3 * 2.d0*NEX_MAX / 1248.d0)
- NER_80_MOHO = nint(6 * 2.d0*NEX_MAX / 1248.d0)
- NER_220_80 = nint(9 * 2.d0*NEX_MAX / 1248.d0)
- NER_400_220 = nint(14 * 2.d0*NEX_MAX / 1248.d0)
- NER_600_400 = nint(14 * 2.d0*NEX_MAX / 1248.d0)
- NER_670_600 = nint(5 * 2.d0*NEX_MAX / 1248.d0)
- NER_771_670 = nint(6 * 2.d0*NEX_MAX / 1248.d0)
- NER_TOPDDOUBLEPRIME_771 = nint(114 * 2.d0*NEX_MAX / 1248.d0)
- NER_CMB_TOPDDOUBLEPRIME = nint(8 * 2.d0*NEX_MAX / 1248.d0)
- NER_OUTER_CORE = nint(124 * 2.d0*NEX_MAX / 1248.d0)
- NER_TOP_CENTRAL_CUBE_ICB = nint(13 * 2.d0*NEX_MAX / 1248.d0)
- R_CENTRAL_CUBE = 985000.d0
-
- !! removed this limit else
- !! removed this limit stop 'problem with this value of NEX_MAX'
- endif
-
- !> Hejun
- ! avoids elongated elements below the 670-discontinuity,
- ! since for model REFERENCE_MODEL_1DREF,
- ! the 670-discontinuity is moved up to 650 km depth.
- if (REFERENCE_1D_MODEL == REFERENCE_MODEL_1DREF) then
- NER_771_670 = NER_771_670 + 1
- end if
-
- !----
- !---- change some values in the case of regular PREM with two crustal layers or of 3D models
- !----
-
- ! case of regular PREM with two crustal layers: change the time step for small meshes
- ! because of a different size of elements in the radial direction in the crust
- if (HONOR_1D_SPHERICAL_MOHO) then
- ! 1D models honor 1D spherical moho
- if (.not. ONE_CRUST) then
- ! case 1D + two crustal layers
- if (NER_CRUST < 2 ) NER_CRUST = 2
- ! makes time step smaller
- if(NEX_MAX*multiplication_factor <= 160) then
- DT = 0.20d0
- else if(NEX_MAX*multiplication_factor <= 256) then
- DT = 0.20d0
- endif
- endif
- else
- ! 3D models: must have two element layers for crust
- if (NER_CRUST < 2 ) NER_CRUST = 2
- ! makes time step smaller
- if(NEX_MAX*multiplication_factor <= 80) then
- DT = 0.125d0
- else if(NEX_MAX*multiplication_factor <= 160) then
- DT = 0.15d0
- else if(NEX_MAX*multiplication_factor <= 256) then
- DT = 0.17d0
- else if(NEX_MAX*multiplication_factor <= 320) then
- DT = 0.155d0
- endif
- endif
-
- if( .not. ATTENUATION_RANGE_PREDEFINED ) then
- call auto_attenuation_periods(ANGULAR_WIDTH_XI_IN_DEGREES, NEX_MAX, &
- MIN_ATTENUATION_PERIOD, MAX_ATTENUATION_PERIOD)
- endif
-
- if(ANGULAR_WIDTH_XI_IN_DEGREES < 90.0d0 .or. &
- ANGULAR_WIDTH_ETA_IN_DEGREES < 90.0d0 .or. &
- NEX_MAX > 1248) then
-
- call auto_ner(ANGULAR_WIDTH_XI_IN_DEGREES, NEX_MAX, &
- NER_CRUST, NER_80_MOHO, NER_220_80, NER_400_220, NER_600_400, &
- NER_670_600, NER_771_670, NER_TOPDDOUBLEPRIME_771, &
- NER_CMB_TOPDDOUBLEPRIME, NER_OUTER_CORE, NER_TOP_CENTRAL_CUBE_ICB, &
- R_CENTRAL_CUBE, CASE_3D, CRUSTAL, &
- HONOR_1D_SPHERICAL_MOHO, REFERENCE_1D_MODEL)
-
- call auto_attenuation_periods(ANGULAR_WIDTH_XI_IN_DEGREES, NEX_MAX, &
- MIN_ATTENUATION_PERIOD, MAX_ATTENUATION_PERIOD)
-
- call auto_time_stepping(ANGULAR_WIDTH_XI_IN_DEGREES, NEX_MAX, DT)
-
- !! DK DK suppressed because this routine should not write anything to the screen
- ! write(*,*)'##############################################################'
- ! write(*,*)
- ! write(*,*)' Auto Radial Meshing Code '
- ! write(*,*)' Consult read_compute_parameters.f90 and auto_ner.f90 '
- ! write(*,*)' This should only be invoked for chunks less than 90 degrees'
- ! write(*,*)' and for chunks greater than 1248 elements wide'
- ! write(*,*)
- ! write(*,*)'CHUNK WIDTH: ', ANGULAR_WIDTH_XI_IN_DEGREES
- ! write(*,*)'NEX: ', NEX_MAX
- ! write(*,*)'NER_CRUST: ', NER_CRUST
- ! write(*,*)'NER_80_MOHO: ', NER_80_MOHO
- ! write(*,*)'NER_220_80: ', NER_220_80
- ! write(*,*)'NER_400_220: ', NER_400_220
- ! write(*,*)'NER_600_400: ', NER_600_400
- ! write(*,*)'NER_670_600: ', NER_670_600
- ! write(*,*)'NER_771_670: ', NER_771_670
- ! write(*,*)'NER_TOPDDOUBLEPRIME_771: ', NER_TOPDDOUBLEPRIME_771
- ! write(*,*)'NER_CMB_TOPDDOUBLEPRIME: ', NER_CMB_TOPDDOUBLEPRIME
- ! write(*,*)'NER_OUTER_CORE: ', NER_OUTER_CORE
- ! write(*,*)'NER_TOP_CENTRAL_CUBE_ICB: ', NER_TOP_CENTRAL_CUBE_ICB
- ! write(*,*)'R_CENTRAL_CUBE: ', R_CENTRAL_CUBE
- ! write(*,*)'multiplication factor: ', multiplication_factor
- ! write(*,*)
- ! write(*,*)'DT: ',DT
- ! write(*,*)'MIN_ATTENUATION_PERIOD ',MIN_ATTENUATION_PERIOD
- ! write(*,*)'MAX_ATTENUATION_PERIOD ',MAX_ATTENUATION_PERIOD
- ! write(*,*)
- ! write(*,*)'##############################################################'
-
- if (HONOR_1D_SPHERICAL_MOHO) then
- if (.not. ONE_CRUST) then
- ! case 1D + two crustal layers
- if (NER_CRUST < 2 ) NER_CRUST = 2
- endif
- else
- ! case 3D
- if (NER_CRUST < 2 ) NER_CRUST = 2
- endif
-
- endif
-
-!---
!
-! ADD YOUR MODEL HERE
-!
-!---
-
-
- ! time step reductions are based on empirical values (..somehow)
-
- ! following models need special attention, at least for global simulations:
- if( NCHUNKS == 6 ) then
-
- ! makes time step smaller for this ref model, otherwise becomes unstable in fluid
- if (REFERENCE_1D_MODEL == REFERENCE_MODEL_IASP91) &
- DT = DT*(1.d0 - 0.3d0)
-
- ! using inner core anisotropy, simulations might become unstable in solid
- if( ANISOTROPIC_INNER_CORE ) then
- ! DT = DT*(1.d0 - 0.1d0) not working yet...
- stop 'anisotropic inner core - unstable feature, uncomment this line in read_compute_parameters.f90'
- endif
-
- endif
-
- ! following models need special attention, regardless of number of chunks:
- ! it makes the time step smaller for this ref model, otherwise becomes unstable in fluid
- if (REFERENCE_1D_MODEL == REFERENCE_MODEL_1066A) &
- DT = DT*(1.d0 - 0.8d0) ! *0.20d0
-
-
- if( ITYPE_CRUSTAL_MODEL == ICRUST_CRUSTMAPS ) &
- DT = DT*(1.d0 - 0.3d0)
-
- ! decreases time step as otherwise the solution might become unstable for rougher/unsmoothed models
- ! if( THREE_D_MODEL == THREE_D_MODEL_PPM ) &
- ! DT = DT * (1.d0 - 0.2d0)
-
- ! takes a 5% safety margin on the maximum stable time step
- ! which was obtained by trial and error
- DT = DT * (1.d0 - 0.05d0)
-
- ! adapts number of element layers in crust and time step for regional simulations
- if( REGIONAL_MOHO_MESH ) then
- ! hard coded number of crustal element layers and time step
-
- ! checks
- if( NCHUNKS > 1 ) stop 'regional moho mesh: NCHUNKS error in rcp_set_timestep_and_layers'
- if( HONOR_1D_SPHERICAL_MOHO ) return
-
- ! original values
- !print*,'NER:',NER_CRUST
- !print*,'DT:',DT
-
- ! enforce 3 element layers
- NER_CRUST = 3
-
- ! increased stability, empirical
- DT = DT*(1.d0 + 0.5d0)
-
- if( REGIONAL_MOHO_MESH_EUROPE ) DT = 0.17 ! europe
- if( REGIONAL_MOHO_MESH_ASIA ) DT = 0.15 ! asia & middle east
-
- endif
-
-
- end subroutine rcp_set_timestep_and_layers
-
-
-
-!
!-------------------------------------------------------------------------------------------------
!
@@ -874,1505 +447,15 @@
! support for only one slice per chunk has been discontinued when there is more than one chunk
! because it induces topological problems, and we are not interested in using small meshes
- if(NCHUNKS > 1 .and. (NPROC_XI == 1 .or. NPROC_ETA == 1)) stop 'support for only one slice per chunk has been discontinued'
+!daniel: debug topological problems?
+ !if(NCHUNKS > 1 .and. (NPROC_XI == 1 .or. NPROC_ETA == 1)) stop 'support for only one slice per chunk has been discontinued'
- end subroutine rcp_check_parameters
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
-
- subroutine rcp_define_all_layers(NER_CRUST,NER_80_MOHO,NER_220_80,&
- NER_400_220,NER_600_400,NER_670_600,NER_771_670, &
- NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
- NER_TOP_CENTRAL_CUBE_ICB,&
- RMIDDLE_CRUST,R220,R400,R600,R670,R771,RTOPDDOUBLEPRIME,RCMB,RICB, &
- R_CENTRAL_CUBE,RMOHO_FICTITIOUS_IN_MESHER,R80_FICTITIOUS_IN_MESHER,&
- ONE_CRUST,ner,ratio_sampling_array,&
- NUMBER_OF_MESH_LAYERS,layer_offset,last_doubling_layer, &
- r_bottom,r_top,this_region_has_a_doubling,&
- ielem,elem_doubling_mantle,elem_doubling_middle_outer_core,&
- elem_doubling_bottom_outer_core,&
- DEPTH_SECOND_DOUBLING_REAL,DEPTH_THIRD_DOUBLING_REAL, &
- DEPTH_FOURTH_DOUBLING_REAL,distance,distance_min,zval,&
- doubling_index,rmins,rmaxs)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!
-!!!!!! definition of general mesh parameters below
-!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- implicit none
-
- include "constants.h"
-
-! parameters read from parameter file
- integer NER_CRUST,NER_80_MOHO,NER_220_80,NER_400_220,NER_600_400,NER_670_600,NER_771_670, &
- NER_TOPDDOUBLEPRIME_771,NER_CMB_TOPDDOUBLEPRIME,NER_OUTER_CORE, &
- NER_TOP_CENTRAL_CUBE_ICB
- integer NUMBER_OF_MESH_LAYERS,layer_offset,last_doubling_layer
-
- double precision RMIDDLE_CRUST,R220,R400,R600,R670,R771,RTOPDDOUBLEPRIME,RCMB,RICB, &
- R_CENTRAL_CUBE,RMOHO_FICTITIOUS_IN_MESHER,R80_FICTITIOUS_IN_MESHER
-
- logical ONE_CRUST
-
- integer, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: ner,ratio_sampling_array
- double precision, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: r_bottom,r_top
- logical, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: this_region_has_a_doubling
-
- integer :: ielem,elem_doubling_mantle,elem_doubling_middle_outer_core,elem_doubling_bottom_outer_core
- double precision :: DEPTH_SECOND_DOUBLING_REAL,DEPTH_THIRD_DOUBLING_REAL, &
- DEPTH_FOURTH_DOUBLING_REAL,distance,distance_min,zval
-
-
- integer, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: doubling_index
- double precision, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: rmins,rmaxs
-
-
-
-! find element below top of which we should implement the second doubling in the mantle
-! locate element closest to optimal value
- distance_min = HUGEVAL
- do ielem = 2,NER_TOPDDOUBLEPRIME_771
- zval = RTOPDDOUBLEPRIME + ielem * (R771 - RTOPDDOUBLEPRIME) / dble(NER_TOPDDOUBLEPRIME_771)
- distance = abs(zval - (R_EARTH - DEPTH_SECOND_DOUBLING_OPTIMAL))
- if(distance < distance_min) then
- elem_doubling_mantle = ielem
- distance_min = distance
- DEPTH_SECOND_DOUBLING_REAL = R_EARTH - zval
- endif
- enddo
-
-! find element below top of which we should implement the third doubling in the middle of the outer core
-! locate element closest to optimal value
- distance_min = HUGEVAL
-! start at element number 4 because we need at least two elements below for the fourth doubling
-! implemented at the bottom of the outer core
- do ielem = 4,NER_OUTER_CORE
- zval = RICB + ielem * (RCMB - RICB) / dble(NER_OUTER_CORE)
- distance = abs(zval - (R_EARTH - DEPTH_THIRD_DOUBLING_OPTIMAL))
- if(distance < distance_min) then
- elem_doubling_middle_outer_core = ielem
- distance_min = distance
- DEPTH_THIRD_DOUBLING_REAL = R_EARTH - zval
- endif
- enddo
-
- if (ADD_4TH_DOUBLING) then
-! find element below top of which we should implement the fourth doubling in the middle of the outer core
-! locate element closest to optimal value
- distance_min = HUGEVAL
-! end two elements before the top because we need at least two elements above for the third doubling
-! implemented in the middle of the outer core
- do ielem = 2,NER_OUTER_CORE-2
- zval = RICB + ielem * (RCMB - RICB) / dble(NER_OUTER_CORE)
- distance = abs(zval - (R_EARTH - DEPTH_FOURTH_DOUBLING_OPTIMAL))
- if(distance < distance_min) then
- elem_doubling_bottom_outer_core = ielem
- distance_min = distance
- DEPTH_FOURTH_DOUBLING_REAL = R_EARTH - zval
- endif
- enddo
-! make sure that the two doublings in the outer core are found in the right order
- if(elem_doubling_bottom_outer_core >= elem_doubling_middle_outer_core) &
- stop 'error in location of the two doublings in the outer core'
+ if(NCHUNKS > 1 .and. (NPROC_XI == 1 .or. NPROC_ETA == 1) ) then
+ if( NUMFACES_SHARED < 4 ) &
+ stop 'NPROC_XI,NPROC_ETA==1: please set in constants.h NUMFACES_SHARED and NUMCORNERS_SHARED equal to 4 and recompile'
+ if( NUMCORNERS_SHARED < 4 ) &
+ stop 'NPROC_XI,NPROC_ETA==1: please set in constants.h NUMFACES_SHARED and NUMCORNERS_SHARED equal to 4 and recompile'
endif
- ratio_sampling_array(15) = 0
+ end subroutine rcp_check_parameters
-! define all the layers of the mesh
- if (.not. ADD_4TH_DOUBLING) then
-
- ! default case:
- ! no fourth doubling at the bottom of the outer core
-
- if (SUPPRESS_CRUSTAL_MESH) then
-
- ! suppress the crustal layers
- ! will be replaced by an extension of the mantle: R_EARTH is not modified,
- ! but no more crustal doubling
-
- NUMBER_OF_MESH_LAYERS = 14
- layer_offset = 1
-
- ! now only one region
- ner( 1) = NER_CRUST + NER_80_MOHO
- ner( 2) = 0
- ner( 3) = 0
-
- ner( 4) = NER_220_80
- ner( 5) = NER_400_220
- ner( 6) = NER_600_400
- ner( 7) = NER_670_600
- ner( 8) = NER_771_670
- ner( 9) = NER_TOPDDOUBLEPRIME_771 - elem_doubling_mantle
- ner(10) = elem_doubling_mantle
- ner(11) = NER_CMB_TOPDDOUBLEPRIME
- ner(12) = NER_OUTER_CORE - elem_doubling_middle_outer_core
- ner(13) = elem_doubling_middle_outer_core
- ner(14) = NER_TOP_CENTRAL_CUBE_ICB
-
- ! value of the doubling ratio in each radial region of the mesh
- ratio_sampling_array(1:9) = 1
- ratio_sampling_array(10:12) = 2
- ratio_sampling_array(13:14) = 4
-
- ! value of the doubling index flag in each radial region of the mesh
- doubling_index(1:3) = IFLAG_CRUST !!!!! IFLAG_80_MOHO
- doubling_index(4) = IFLAG_220_80
- doubling_index(5:7) = IFLAG_670_220
- doubling_index(8:11) = IFLAG_MANTLE_NORMAL
- doubling_index(12:13) = IFLAG_OUTER_CORE_NORMAL
- doubling_index(14) = IFLAG_INNER_CORE_NORMAL
-
- ! define the three regions in which we implement a mesh doubling at the top of that region
- this_region_has_a_doubling(:) = .false.
- this_region_has_a_doubling(10) = .true.
- this_region_has_a_doubling(13) = .true.
- last_doubling_layer = 13
-
- ! define the top and bottom radii of all the regions of the mesh in the radial direction
- ! the first region is the crust at the surface of the Earth
- ! the last region is in the inner core near the center of the Earth
-
- r_top(1) = R_EARTH
- r_bottom(1) = R80_FICTITIOUS_IN_MESHER
-
- r_top(2) = RMIDDLE_CRUST !!!! now fictitious
- r_bottom(2) = RMOHO_FICTITIOUS_IN_MESHER !!!! now fictitious
-
- r_top(3) = RMOHO_FICTITIOUS_IN_MESHER !!!! now fictitious
- r_bottom(3) = R80_FICTITIOUS_IN_MESHER !!!! now fictitious
-
- r_top(4) = R80_FICTITIOUS_IN_MESHER
- r_bottom(4) = R220
-
- r_top(5) = R220
- r_bottom(5) = R400
-
- r_top(6) = R400
- r_bottom(6) = R600
-
- r_top(7) = R600
- r_bottom(7) = R670
-
- r_top(8) = R670
- r_bottom(8) = R771
-
- r_top(9) = R771
- r_bottom(9) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
-
- r_top(10) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
- r_bottom(10) = RTOPDDOUBLEPRIME
-
- r_top(11) = RTOPDDOUBLEPRIME
- r_bottom(11) = RCMB
-
- r_top(12) = RCMB
- r_bottom(12) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
-
- r_top(13) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
- r_bottom(13) = RICB
-
- r_top(14) = RICB
- r_bottom(14) = R_CENTRAL_CUBE
-
- ! new definition of rmins & rmaxs
- rmaxs(1) = ONE
- rmins(1) = R80_FICTITIOUS_IN_MESHER / R_EARTH
-
- rmaxs(2) = RMIDDLE_CRUST / R_EARTH !!!! now fictitious
- rmins(2) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH !!!! now fictitious
-
- rmaxs(3) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH !!!! now fictitious
- rmins(3) = R80_FICTITIOUS_IN_MESHER / R_EARTH !!!! now fictitious
-
- rmaxs(4) = R80_FICTITIOUS_IN_MESHER / R_EARTH
- rmins(4) = R220 / R_EARTH
-
- rmaxs(5) = R220 / R_EARTH
- rmins(5) = R400 / R_EARTH
-
- rmaxs(6) = R400 / R_EARTH
- rmins(6) = R600 / R_EARTH
-
- rmaxs(7) = R600 / R_EARTH
- rmins(7) = R670 / R_EARTH
-
- rmaxs(8) = R670 / R_EARTH
- rmins(8) = R771 / R_EARTH
-
- rmaxs(9:10) = R771 / R_EARTH
- rmins(9:10) = RTOPDDOUBLEPRIME / R_EARTH
-
- rmaxs(11) = RTOPDDOUBLEPRIME / R_EARTH
- rmins(11) = RCMB / R_EARTH
-
- rmaxs(12:13) = RCMB / R_EARTH
- rmins(12:13) = RICB / R_EARTH
-
- rmaxs(14) = RICB / R_EARTH
- rmins(14) = R_CENTRAL_CUBE / R_EARTH
-
- elseif (ONE_CRUST) then
-
- ! 1D models:
- ! in order to increase stability and therefore to allow cheaper
- ! simulations (larger time step), 1D models can be run with just one average crustal
- ! layer instead of two.
-
- NUMBER_OF_MESH_LAYERS = 13
- layer_offset = 0
-
- ner( 1) = NER_CRUST
- ner( 2) = NER_80_MOHO
- ner( 3) = NER_220_80
- ner( 4) = NER_400_220
- ner( 5) = NER_600_400
- ner( 6) = NER_670_600
- ner( 7) = NER_771_670
- ner( 8) = NER_TOPDDOUBLEPRIME_771 - elem_doubling_mantle
- ner( 9) = elem_doubling_mantle
- ner(10) = NER_CMB_TOPDDOUBLEPRIME
- ner(11) = NER_OUTER_CORE - elem_doubling_middle_outer_core
- ner(12) = elem_doubling_middle_outer_core
- ner(13) = NER_TOP_CENTRAL_CUBE_ICB
-
- ! value of the doubling ratio in each radial region of the mesh
- ratio_sampling_array(1) = 1
- ratio_sampling_array(2:8) = 2
- ratio_sampling_array(9:11) = 4
- ratio_sampling_array(12:13) = 8
-
- ! value of the doubling index flag in each radial region of the mesh
- doubling_index(1) = IFLAG_CRUST
- doubling_index(2) = IFLAG_80_MOHO
- doubling_index(3) = IFLAG_220_80
- doubling_index(4:6) = IFLAG_670_220
- doubling_index(7:10) = IFLAG_MANTLE_NORMAL
- doubling_index(11:12) = IFLAG_OUTER_CORE_NORMAL
- doubling_index(13) = IFLAG_INNER_CORE_NORMAL
-
- ! define the three regions in which we implement a mesh doubling at the top of that region
- this_region_has_a_doubling(:) = .false.
- this_region_has_a_doubling(2) = .true.
- this_region_has_a_doubling(9) = .true.
- this_region_has_a_doubling(12) = .true.
- last_doubling_layer = 12
-
- ! define the top and bottom radii of all the regions of the mesh in the radial direction
- ! the first region is the crust at the surface of the Earth
- ! the last region is in the inner core near the center of the Earth
-
- !!!!!!!!!!! DK DK UGLY: beware, is there a bug when 3D crust crosses anisotropy in the mantle?
- !!!!!!!!!!! DK DK UGLY: i.e. if there is no thick crust there, some elements above the Moho
- !!!!!!!!!!! DK DK UGLY: should be anisotropic but anisotropy is currently only
- !!!!!!!!!!! DK DK UGLY: stored between d220 and MOHO to save memory? Clarify this one day.
- !!!!!!!!!!! DK DK UGLY: The Moho stretching and squishing that Jeroen added to V4.0
- !!!!!!!!!!! DK DK UGLY: should partly deal with this problem.
-
- r_top(1) = R_EARTH
- r_bottom(1) = RMOHO_FICTITIOUS_IN_MESHER
-
- r_top(2) = RMOHO_FICTITIOUS_IN_MESHER
- r_bottom(2) = R80_FICTITIOUS_IN_MESHER
-
- r_top(3) = R80_FICTITIOUS_IN_MESHER
- r_bottom(3) = R220
-
- r_top(4) = R220
- r_bottom(4) = R400
-
- r_top(5) = R400
- r_bottom(5) = R600
-
- r_top(6) = R600
- r_bottom(6) = R670
-
- r_top(7) = R670
- r_bottom(7) = R771
-
- r_top(8) = R771
- r_bottom(8) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
-
- r_top(9) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
- r_bottom(9) = RTOPDDOUBLEPRIME
-
- r_top(10) = RTOPDDOUBLEPRIME
- r_bottom(10) = RCMB
-
- r_top(11) = RCMB
- r_bottom(11) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
-
- r_top(12) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
- r_bottom(12) = RICB
-
- r_top(13) = RICB
- r_bottom(13) = R_CENTRAL_CUBE
-
- ! new definition of rmins & rmaxs
- rmaxs(1) = ONE
- rmins(1) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
-
- rmaxs(2) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
- rmins(2) = R80_FICTITIOUS_IN_MESHER / R_EARTH
-
- rmaxs(3) = R80_FICTITIOUS_IN_MESHER / R_EARTH
- rmins(3) = R220 / R_EARTH
-
- rmaxs(4) = R220 / R_EARTH
- rmins(4) = R400 / R_EARTH
-
- rmaxs(5) = R400 / R_EARTH
- rmins(5) = R600 / R_EARTH
-
- rmaxs(6) = R600 / R_EARTH
- rmins(6) = R670 / R_EARTH
-
- rmaxs(7) = R670 / R_EARTH
- rmins(7) = R771 / R_EARTH
-
- rmaxs(8:9) = R771 / R_EARTH
- rmins(8:9) = RTOPDDOUBLEPRIME / R_EARTH
-
- rmaxs(10) = RTOPDDOUBLEPRIME / R_EARTH
- rmins(10) = RCMB / R_EARTH
-
- rmaxs(11:12) = RCMB / R_EARTH
- rmins(11:12) = RICB / R_EARTH
-
- rmaxs(13) = RICB / R_EARTH
- rmins(13) = R_CENTRAL_CUBE / R_EARTH
-
- else
-
- ! default case for 3D models:
- ! contains the crustal layers
- ! doubling at the base of the crust
-
- NUMBER_OF_MESH_LAYERS = 14
- layer_offset = 1
- if ((RMIDDLE_CRUST-RMOHO_FICTITIOUS_IN_MESHER)<(R_EARTH-RMIDDLE_CRUST)) then
- ner( 1) = ceiling (NER_CRUST / 2.d0)
- ner( 2) = floor (NER_CRUST / 2.d0)
- else
- ner( 1) = floor (NER_CRUST / 2.d0) ! regional mesh: ner(1) = 1 since NER_CRUST=3
- ner( 2) = ceiling (NER_CRUST / 2.d0) ! ner(2) = 2
- endif
- ner( 3) = NER_80_MOHO
- ner( 4) = NER_220_80
- ner( 5) = NER_400_220
- ner( 6) = NER_600_400
- ner( 7) = NER_670_600
- ner( 8) = NER_771_670
- ner( 9) = NER_TOPDDOUBLEPRIME_771 - elem_doubling_mantle
- ner(10) = elem_doubling_mantle
- ner(11) = NER_CMB_TOPDDOUBLEPRIME
- ner(12) = NER_OUTER_CORE - elem_doubling_middle_outer_core
- ner(13) = elem_doubling_middle_outer_core
- ner(14) = NER_TOP_CENTRAL_CUBE_ICB
-
- ! value of the doubling ratio in each radial region of the mesh
- ratio_sampling_array(1:2) = 1
- ratio_sampling_array(3:9) = 2
- ratio_sampling_array(10:12) = 4
- ratio_sampling_array(13:14) = 8
-
- ! value of the doubling index flag in each radial region of the mesh
- doubling_index(1:2) = IFLAG_CRUST
- doubling_index(3) = IFLAG_80_MOHO
- doubling_index(4) = IFLAG_220_80
- doubling_index(5:7) = IFLAG_670_220
- doubling_index(8:11) = IFLAG_MANTLE_NORMAL
- doubling_index(12:13) = IFLAG_OUTER_CORE_NORMAL
- doubling_index(14) = IFLAG_INNER_CORE_NORMAL
-
- ! define the three regions in which we implement a mesh doubling at the top of that region
- this_region_has_a_doubling(:) = .false.
- this_region_has_a_doubling(3) = .true.
- this_region_has_a_doubling(10) = .true.
- this_region_has_a_doubling(13) = .true.
- this_region_has_a_doubling(14) = .false.
- last_doubling_layer = 13
-
- ! define the top and bottom radii of all the regions of the mesh in the radial direction
- ! the first region is the crust at the surface of the Earth
- ! the last region is in the inner core near the center of the Earth
-
- r_top(1) = R_EARTH
- r_bottom(1) = RMIDDLE_CRUST
-
- r_top(2) = RMIDDLE_CRUST
- r_bottom(2) = RMOHO_FICTITIOUS_IN_MESHER
-
- r_top(3) = RMOHO_FICTITIOUS_IN_MESHER
- r_bottom(3) = R80_FICTITIOUS_IN_MESHER
-
- r_top(4) = R80_FICTITIOUS_IN_MESHER
- r_bottom(4) = R220
-
- r_top(5) = R220
- r_bottom(5) = R400
-
- r_top(6) = R400
- r_bottom(6) = R600
-
- r_top(7) = R600
- r_bottom(7) = R670
-
- r_top(8) = R670
- r_bottom(8) = R771
-
- r_top(9) = R771
- r_bottom(9) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
-
- r_top(10) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
- r_bottom(10) = RTOPDDOUBLEPRIME
-
- r_top(11) = RTOPDDOUBLEPRIME
- r_bottom(11) = RCMB
-
- r_top(12) = RCMB
- r_bottom(12) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
-
- r_top(13) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
- r_bottom(13) = RICB
-
- r_top(14) = RICB
- r_bottom(14) = R_CENTRAL_CUBE
-
- ! new definition of rmins & rmaxs
- rmaxs(1) = ONE
- rmins(1) = RMIDDLE_CRUST / R_EARTH
-
- rmaxs(2) = RMIDDLE_CRUST / R_EARTH
- rmins(2) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
-
- rmaxs(3) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
- rmins(3) = R80_FICTITIOUS_IN_MESHER / R_EARTH
-
- rmaxs(4) = R80_FICTITIOUS_IN_MESHER / R_EARTH
- rmins(4) = R220 / R_EARTH
-
- rmaxs(5) = R220 / R_EARTH
- rmins(5) = R400 / R_EARTH
-
- rmaxs(6) = R400 / R_EARTH
- rmins(6) = R600 / R_EARTH
-
- rmaxs(7) = R600 / R_EARTH
- rmins(7) = R670 / R_EARTH
-
- rmaxs(8) = R670 / R_EARTH
- rmins(8) = R771 / R_EARTH
-
- rmaxs(9:10) = R771 / R_EARTH
- rmins(9:10) = RTOPDDOUBLEPRIME / R_EARTH
-
- rmaxs(11) = RTOPDDOUBLEPRIME / R_EARTH
- rmins(11) = RCMB / R_EARTH
-
- rmaxs(12:13) = RCMB / R_EARTH
- rmins(12:13) = RICB / R_EARTH
-
- rmaxs(14) = RICB / R_EARTH
- rmins(14) = R_CENTRAL_CUBE / R_EARTH
-
- endif
- else
-
- ! 4th doubling case:
- ! includes fourth doubling at the bottom of the outer core
-
- if (SUPPRESS_CRUSTAL_MESH) then
-
- ! suppress the crustal layers
- ! will be replaced by an extension of the mantle: R_EARTH is not modified,
- ! but no more crustal doubling
-
- NUMBER_OF_MESH_LAYERS = 15
- layer_offset = 1
-
- ! now only one region
- ner( 1) = NER_CRUST + NER_80_MOHO
- ner( 2) = 0
- ner( 3) = 0
-
- ner( 4) = NER_220_80
- ner( 5) = NER_400_220
- ner( 6) = NER_600_400
- ner( 7) = NER_670_600
- ner( 8) = NER_771_670
- ner( 9) = NER_TOPDDOUBLEPRIME_771 - elem_doubling_mantle
- ner(10) = elem_doubling_mantle
- ner(11) = NER_CMB_TOPDDOUBLEPRIME
- ner(12) = NER_OUTER_CORE - elem_doubling_middle_outer_core
- ner(13) = elem_doubling_middle_outer_core - elem_doubling_bottom_outer_core
- ner(14) = elem_doubling_bottom_outer_core
- ner(15) = NER_TOP_CENTRAL_CUBE_ICB
-
- ! value of the doubling ratio in each radial region of the mesh
- ratio_sampling_array(1:9) = 1
- ratio_sampling_array(10:12) = 2
- ratio_sampling_array(13) = 4
- ratio_sampling_array(14:15) = 8
-
- ! value of the doubling index flag in each radial region of the mesh
- doubling_index(1:3) = IFLAG_CRUST !!!!! IFLAG_80_MOHO
- doubling_index(4) = IFLAG_220_80
- doubling_index(5:7) = IFLAG_670_220
- doubling_index(8:11) = IFLAG_MANTLE_NORMAL
- doubling_index(12:14) = IFLAG_OUTER_CORE_NORMAL
- doubling_index(15) = IFLAG_INNER_CORE_NORMAL
-
- ! define the three regions in which we implement a mesh doubling at the top of that region
- this_region_has_a_doubling(:) = .false.
- this_region_has_a_doubling(10) = .true.
- this_region_has_a_doubling(13) = .true.
- this_region_has_a_doubling(14) = .true.
- last_doubling_layer = 14
-
- ! define the top and bottom radii of all the regions of the mesh in the radial direction
- ! the first region is the crust at the surface of the Earth
- ! the last region is in the inner core near the center of the Earth
-
- r_top(1) = R_EARTH
- r_bottom(1) = R80_FICTITIOUS_IN_MESHER
-
- r_top(2) = RMIDDLE_CRUST !!!! now fictitious
- r_bottom(2) = RMOHO_FICTITIOUS_IN_MESHER !!!! now fictitious
-
- r_top(3) = RMOHO_FICTITIOUS_IN_MESHER !!!! now fictitious
- r_bottom(3) = R80_FICTITIOUS_IN_MESHER !!!! now fictitious
-
- r_top(4) = R80_FICTITIOUS_IN_MESHER
- r_bottom(4) = R220
-
- r_top(5) = R220
- r_bottom(5) = R400
-
- r_top(6) = R400
- r_bottom(6) = R600
-
- r_top(7) = R600
- r_bottom(7) = R670
-
- r_top(8) = R670
- r_bottom(8) = R771
-
- r_top(9) = R771
- r_bottom(9) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
-
- r_top(10) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
- r_bottom(10) = RTOPDDOUBLEPRIME
-
- r_top(11) = RTOPDDOUBLEPRIME
- r_bottom(11) = RCMB
-
- r_top(12) = RCMB
- r_bottom(12) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
-
- r_top(13) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
- r_bottom(13) = R_EARTH - DEPTH_FOURTH_DOUBLING_REAL
-
- r_top(14) = R_EARTH - DEPTH_FOURTH_DOUBLING_REAL
- r_bottom(14) = RICB
-
- r_top(15) = RICB
- r_bottom(15) = R_CENTRAL_CUBE
-
- ! new definition of rmins & rmaxs
- rmaxs(1) = ONE
- rmins(1) = R80_FICTITIOUS_IN_MESHER / R_EARTH
-
- rmaxs(2) = RMIDDLE_CRUST / R_EARTH !!!! now fictitious
- rmins(2) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH !!!! now fictitious
-
- rmaxs(3) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH !!!! now fictitious
- rmins(3) = R80_FICTITIOUS_IN_MESHER / R_EARTH !!!! now fictitious
-
- rmaxs(4) = R80_FICTITIOUS_IN_MESHER / R_EARTH
- rmins(4) = R220 / R_EARTH
-
- rmaxs(5) = R220 / R_EARTH
- rmins(5) = R400 / R_EARTH
-
- rmaxs(6) = R400 / R_EARTH
- rmins(6) = R600 / R_EARTH
-
- rmaxs(7) = R600 / R_EARTH
- rmins(7) = R670 / R_EARTH
-
- rmaxs(8) = R670 / R_EARTH
- rmins(8) = R771 / R_EARTH
-
- rmaxs(9:10) = R771 / R_EARTH
- rmins(9:10) = RTOPDDOUBLEPRIME / R_EARTH
-
- rmaxs(11) = RTOPDDOUBLEPRIME / R_EARTH
- rmins(11) = RCMB / R_EARTH
-
- rmaxs(12:14) = RCMB / R_EARTH
- rmins(12:14) = RICB / R_EARTH
-
- rmaxs(15) = RICB / R_EARTH
- rmins(15) = R_CENTRAL_CUBE / R_EARTH
-
- elseif (ONE_CRUST) then
-
- ! 1D models:
- ! in order to increase stability and therefore to allow cheaper
- ! simulations (larger time step), 1D models can be run with just one average crustal
- ! layer instead of two.
-
- NUMBER_OF_MESH_LAYERS = 14
- layer_offset = 0
-
- ner( 1) = NER_CRUST
- ner( 2) = NER_80_MOHO
- ner( 3) = NER_220_80
- ner( 4) = NER_400_220
- ner( 5) = NER_600_400
- ner( 6) = NER_670_600
- ner( 7) = NER_771_670
- ner( 8) = NER_TOPDDOUBLEPRIME_771 - elem_doubling_mantle
- ner( 9) = elem_doubling_mantle
- ner(10) = NER_CMB_TOPDDOUBLEPRIME
- ner(11) = NER_OUTER_CORE - elem_doubling_middle_outer_core
- ner(12) = elem_doubling_middle_outer_core - elem_doubling_bottom_outer_core
- ner(13) = elem_doubling_bottom_outer_core
- ner(14) = NER_TOP_CENTRAL_CUBE_ICB
-
- ! value of the doubling ratio in each radial region of the mesh
- ratio_sampling_array(1) = 1
- ratio_sampling_array(2:8) = 2
- ratio_sampling_array(9:11) = 4
- ratio_sampling_array(12) = 8
- ratio_sampling_array(13:14) = 16
-
- ! value of the doubling index flag in each radial region of the mesh
- doubling_index(1) = IFLAG_CRUST
- doubling_index(2) = IFLAG_80_MOHO
- doubling_index(3) = IFLAG_220_80
- doubling_index(4:6) = IFLAG_670_220
- doubling_index(7:10) = IFLAG_MANTLE_NORMAL
- doubling_index(11:13) = IFLAG_OUTER_CORE_NORMAL
- doubling_index(14) = IFLAG_INNER_CORE_NORMAL
-
- ! define the three regions in which we implement a mesh doubling at the top of that region
- this_region_has_a_doubling(:) = .false.
- this_region_has_a_doubling(2) = .true.
- this_region_has_a_doubling(9) = .true.
- this_region_has_a_doubling(12) = .true.
- this_region_has_a_doubling(13) = .true.
- last_doubling_layer = 13
-
- ! define the top and bottom radii of all the regions of the mesh in the radial direction
- ! the first region is the crust at the surface of the Earth
- ! the last region is in the inner core near the center of the Earth
-
- !!!!!!!!!!! DK DK UGLY: beware, is there a bug when 3D crust crosses anisotropy in the mantle?
- !!!!!!!!!!! DK DK UGLY: i.e. if there is no thick crust there, some elements above the Moho
- !!!!!!!!!!! DK DK UGLY: should be anisotropic but anisotropy is currently only
- !!!!!!!!!!! DK DK UGLY: stored between d220 and MOHO to save memory? Clarify this one day.
- !!!!!!!!!!! DK DK UGLY: The Moho stretching and squishing that Jeroen added to V4.0
- !!!!!!!!!!! DK DK UGLY: should partly deal with this problem.
-
- r_top(1) = R_EARTH
- r_bottom(1) = RMOHO_FICTITIOUS_IN_MESHER
-
- r_top(2) = RMOHO_FICTITIOUS_IN_MESHER
- r_bottom(2) = R80_FICTITIOUS_IN_MESHER
-
- r_top(3) = R80_FICTITIOUS_IN_MESHER
- r_bottom(3) = R220
-
- r_top(4) = R220
- r_bottom(4) = R400
-
- r_top(5) = R400
- r_bottom(5) = R600
-
- r_top(6) = R600
- r_bottom(6) = R670
-
- r_top(7) = R670
- r_bottom(7) = R771
-
- r_top(8) = R771
- r_bottom(8) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
-
- r_top(9) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
- r_bottom(9) = RTOPDDOUBLEPRIME
-
- r_top(10) = RTOPDDOUBLEPRIME
- r_bottom(10) = RCMB
-
- r_top(11) = RCMB
- r_bottom(11) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
-
- r_top(12) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
- r_bottom(12) = R_EARTH - DEPTH_FOURTH_DOUBLING_REAL
-
- r_top(13) = R_EARTH - DEPTH_FOURTH_DOUBLING_REAL
- r_bottom(13) = RICB
-
- r_top(14) = RICB
- r_bottom(14) = R_CENTRAL_CUBE
-
- ! new definition of rmins & rmaxs
- rmaxs(1) = ONE
- rmins(1) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
-
- rmaxs(2) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
- rmins(2) = R80_FICTITIOUS_IN_MESHER / R_EARTH
-
- rmaxs(3) = R80_FICTITIOUS_IN_MESHER / R_EARTH
- rmins(3) = R220 / R_EARTH
-
- rmaxs(4) = R220 / R_EARTH
- rmins(4) = R400 / R_EARTH
-
- rmaxs(5) = R400 / R_EARTH
- rmins(5) = R600 / R_EARTH
-
- rmaxs(6) = R600 / R_EARTH
- rmins(6) = R670 / R_EARTH
-
- rmaxs(7) = R670 / R_EARTH
- rmins(7) = R771 / R_EARTH
-
- rmaxs(8:9) = R771 / R_EARTH
- rmins(8:9) = RTOPDDOUBLEPRIME / R_EARTH
-
- rmaxs(10) = RTOPDDOUBLEPRIME / R_EARTH
- rmins(10) = RCMB / R_EARTH
-
- rmaxs(11:13) = RCMB / R_EARTH
- rmins(11:13) = RICB / R_EARTH
-
- rmaxs(14) = RICB / R_EARTH
- rmins(14) = R_CENTRAL_CUBE / R_EARTH
-
- else
-
- ! for 3D models:
- ! contains the crustal layers
- ! doubling at the base of the crust
-
- NUMBER_OF_MESH_LAYERS = 15
- layer_offset = 1
- if ((RMIDDLE_CRUST-RMOHO_FICTITIOUS_IN_MESHER)<(R_EARTH-RMIDDLE_CRUST)) then
- ner( 1) = ceiling (NER_CRUST / 2.d0)
- ner( 2) = floor (NER_CRUST / 2.d0)
- else
- ner( 1) = floor (NER_CRUST / 2.d0)
- ner( 2) = ceiling (NER_CRUST / 2.d0)
- endif
- ner( 3) = NER_80_MOHO
- ner( 4) = NER_220_80
- ner( 5) = NER_400_220
- ner( 6) = NER_600_400
- ner( 7) = NER_670_600
- ner( 8) = NER_771_670
- ner( 9) = NER_TOPDDOUBLEPRIME_771 - elem_doubling_mantle
- ner(10) = elem_doubling_mantle
- ner(11) = NER_CMB_TOPDDOUBLEPRIME
- ner(12) = NER_OUTER_CORE - elem_doubling_middle_outer_core
- ner(13) = elem_doubling_middle_outer_core - elem_doubling_bottom_outer_core
- ner(14) = elem_doubling_bottom_outer_core
- ner(15) = NER_TOP_CENTRAL_CUBE_ICB
-
- ! value of the doubling ratio in each radial region of the mesh
- ratio_sampling_array(1:2) = 1
- ratio_sampling_array(3:9) = 2
- ratio_sampling_array(10:12) = 4
- ratio_sampling_array(13) = 8
- ratio_sampling_array(14:15) = 16
-
- ! value of the doubling index flag in each radial region of the mesh
- doubling_index(1:2) = IFLAG_CRUST
- doubling_index(3) = IFLAG_80_MOHO
- doubling_index(4) = IFLAG_220_80
- doubling_index(5:7) = IFLAG_670_220
- doubling_index(8:11) = IFLAG_MANTLE_NORMAL
- doubling_index(12:14) = IFLAG_OUTER_CORE_NORMAL
- doubling_index(15) = IFLAG_INNER_CORE_NORMAL
-
- ! define the three regions in which we implement a mesh doubling at the top of that region
- this_region_has_a_doubling(:) = .false.
- this_region_has_a_doubling(3) = .true.
- this_region_has_a_doubling(10) = .true.
- this_region_has_a_doubling(13) = .true.
- this_region_has_a_doubling(14) = .true.
- last_doubling_layer = 14
-
- ! define the top and bottom radii of all the regions of the mesh in the radial direction
- ! the first region is the crust at the surface of the Earth
- ! the last region is in the inner core near the center of the Earth
-
- r_top(1) = R_EARTH
- r_bottom(1) = RMIDDLE_CRUST
-
- r_top(2) = RMIDDLE_CRUST
- r_bottom(2) = RMOHO_FICTITIOUS_IN_MESHER
-
- r_top(3) = RMOHO_FICTITIOUS_IN_MESHER
- r_bottom(3) = R80_FICTITIOUS_IN_MESHER
-
- r_top(4) = R80_FICTITIOUS_IN_MESHER
- r_bottom(4) = R220
-
- r_top(5) = R220
- r_bottom(5) = R400
-
- r_top(6) = R400
- r_bottom(6) = R600
-
- r_top(7) = R600
- r_bottom(7) = R670
-
- r_top(8) = R670
- r_bottom(8) = R771
-
- r_top(9) = R771
- r_bottom(9) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
-
- r_top(10) = R_EARTH - DEPTH_SECOND_DOUBLING_REAL
- r_bottom(10) = RTOPDDOUBLEPRIME
-
- r_top(11) = RTOPDDOUBLEPRIME
- r_bottom(11) = RCMB
-
- r_top(12) = RCMB
- r_bottom(12) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
-
- r_top(13) = R_EARTH - DEPTH_THIRD_DOUBLING_REAL
- r_bottom(13) = R_EARTH - DEPTH_FOURTH_DOUBLING_REAL
-
- r_top(14) = R_EARTH - DEPTH_FOURTH_DOUBLING_REAL
- r_bottom(14) = RICB
-
- r_top(15) = RICB
- r_bottom(15) = R_CENTRAL_CUBE
-
- ! new definition of rmins & rmaxs
- rmaxs(1) = ONE
- rmins(1) = RMIDDLE_CRUST / R_EARTH
-
- rmaxs(2) = RMIDDLE_CRUST / R_EARTH
- rmins(2) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
-
- rmaxs(3) = RMOHO_FICTITIOUS_IN_MESHER / R_EARTH
- rmins(3) = R80_FICTITIOUS_IN_MESHER / R_EARTH
-
- rmaxs(4) = R80_FICTITIOUS_IN_MESHER / R_EARTH
- rmins(4) = R220 / R_EARTH
-
- rmaxs(5) = R220 / R_EARTH
- rmins(5) = R400 / R_EARTH
-
- rmaxs(6) = R400 / R_EARTH
- rmins(6) = R600 / R_EARTH
-
- rmaxs(7) = R600 / R_EARTH
- rmins(7) = R670 / R_EARTH
-
- rmaxs(8) = R670 / R_EARTH
- rmins(8) = R771 / R_EARTH
-
- rmaxs(9:10) = R771 / R_EARTH
- rmins(9:10) = RTOPDDOUBLEPRIME / R_EARTH
-
- rmaxs(11) = RTOPDDOUBLEPRIME / R_EARTH
- rmins(11) = RCMB / R_EARTH
-
- rmaxs(12:14) = RCMB / R_EARTH
- rmins(12:14) = RICB / R_EARTH
-
- rmaxs(15) = RICB / R_EARTH
- rmins(15) = R_CENTRAL_CUBE / R_EARTH
- endif
- endif
-
-
- end subroutine rcp_define_all_layers
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine rcp_count_elements(NEX_XI,NEX_ETA,NEX_PER_PROC_XI,NPROC,&
- NEX_PER_PROC_ETA,ratio_divide_central_cube,&
- NSPEC,NSPEC2D_XI,NSPEC2D_ETA, &
- NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
- NSPEC1D_RADIAL, &
- NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX, &
- ner,ratio_sampling_array,this_region_has_a_doubling, &
- ifirst_region,ilast_region,iter_region,iter_layer, &
- doubling,tmp_sum,tmp_sum_xi,tmp_sum_eta, &
- NUMBER_OF_MESH_LAYERS,layer_offset,nspec2D_xi_sb,nspec2D_eta_sb, &
- nb_lay_sb, nspec_sb, nglob_surf, &
- CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, INCLUDE_CENTRAL_CUBE, &
- last_doubling_layer, &
- DIFF_NSPEC1D_RADIAL,DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA,&
- tmp_sum_nglob2D_xi, tmp_sum_nglob2D_eta,divider,nglob_edges_h,&
- nglob_edge_v,to_remove)
-
-
- implicit none
-
- include "constants.h"
-
-
-! parameters to be computed based upon parameters above read from file
- integer NPROC,NEX_XI,NEX_ETA,NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube
-
- integer, dimension(MAX_NUM_REGIONS) :: NSPEC,NSPEC2D_XI,NSPEC2D_ETA, &
- NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
- NSPEC1D_RADIAL,NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX
-
-
- logical, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: this_region_has_a_doubling
-
- integer, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: ner,ratio_sampling_array
-
-
- integer :: ifirst_region, ilast_region, iter_region, iter_layer, doubling, tmp_sum, tmp_sum_xi, tmp_sum_eta
- integer :: NUMBER_OF_MESH_LAYERS,layer_offset,nspec2D_xi_sb,nspec2D_eta_sb, &
- nb_lay_sb, nspec_sb, nglob_surf
-
-
-! for the cut doublingbrick improvement
- logical :: CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA
- logical :: INCLUDE_CENTRAL_CUBE
- integer :: last_doubling_layer
- integer, dimension(NB_SQUARE_CORNERS,NB_CUT_CASE) :: DIFF_NSPEC1D_RADIAL
- integer, dimension(NB_SQUARE_EDGES_ONEDIR,NB_CUT_CASE) :: DIFF_NSPEC2D_XI,DIFF_NSPEC2D_ETA
-
- integer :: tmp_sum_nglob2D_xi, tmp_sum_nglob2D_eta,divider,nglob_edges_h,nglob_edge_v,to_remove
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!
-!!!!!! calculation of number of elements (NSPEC) below
-!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- ratio_divide_central_cube = maxval(ratio_sampling_array(1:NUMBER_OF_MESH_LAYERS))
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!
-!!!!!! 1D case
-!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
- ! theoretical number of spectral elements in radial direction
- do iter_region = IREGION_CRUST_MANTLE,IREGION_INNER_CORE
- if(iter_region == IREGION_CRUST_MANTLE) then
- ifirst_region = 1
- ilast_region = 10 + layer_offset
- else if(iter_region == IREGION_OUTER_CORE) then
- ifirst_region = 11 + layer_offset
- ilast_region = NUMBER_OF_MESH_LAYERS - 1
- else if(iter_region == IREGION_INNER_CORE) then
- ifirst_region = NUMBER_OF_MESH_LAYERS
- ilast_region = NUMBER_OF_MESH_LAYERS
- else
- stop 'incorrect region code detected'
- endif
- NSPEC1D_RADIAL(iter_region) = sum(ner(ifirst_region:ilast_region))
- enddo
-
- ! difference of radial number of element for outer core if the superbrick is cut
- DIFF_NSPEC1D_RADIAL(:,:) = 0
- if (CUT_SUPERBRICK_XI) then
- if (CUT_SUPERBRICK_ETA) then
- DIFF_NSPEC1D_RADIAL(2,1) = 1
- DIFF_NSPEC1D_RADIAL(3,1) = 2
- DIFF_NSPEC1D_RADIAL(4,1) = 1
-
- DIFF_NSPEC1D_RADIAL(1,2) = 1
- DIFF_NSPEC1D_RADIAL(2,2) = 2
- DIFF_NSPEC1D_RADIAL(3,2) = 1
-
- DIFF_NSPEC1D_RADIAL(1,3) = 1
- DIFF_NSPEC1D_RADIAL(3,3) = 1
- DIFF_NSPEC1D_RADIAL(4,3) = 2
-
- DIFF_NSPEC1D_RADIAL(1,4) = 2
- DIFF_NSPEC1D_RADIAL(2,4) = 1
- DIFF_NSPEC1D_RADIAL(4,4) = 1
- else
- DIFF_NSPEC1D_RADIAL(2,1) = 1
- DIFF_NSPEC1D_RADIAL(3,1) = 1
-
- DIFF_NSPEC1D_RADIAL(1,2) = 1
- DIFF_NSPEC1D_RADIAL(4,2) = 1
- endif
- else
- if (CUT_SUPERBRICK_ETA) then
- DIFF_NSPEC1D_RADIAL(3,1) = 1
- DIFF_NSPEC1D_RADIAL(4,1) = 1
-
- DIFF_NSPEC1D_RADIAL(1,2) = 1
- DIFF_NSPEC1D_RADIAL(2,2) = 1
- endif
- endif
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!
-!!!!!! 2D case
-!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- ! exact number of surface elements for faces along XI and ETA
-
- do iter_region = IREGION_CRUST_MANTLE,IREGION_INNER_CORE
- if(iter_region == IREGION_CRUST_MANTLE) then
- ifirst_region = 1
- ilast_region = 10 + layer_offset
- else if(iter_region == IREGION_OUTER_CORE) then
- ifirst_region = 11 + layer_offset
- ilast_region = NUMBER_OF_MESH_LAYERS - 1
- else if(iter_region == IREGION_INNER_CORE) then
- ifirst_region = NUMBER_OF_MESH_LAYERS
- ilast_region = NUMBER_OF_MESH_LAYERS
- else
- stop 'incorrect region code detected'
- endif
- tmp_sum_xi = 0
- tmp_sum_eta = 0
- tmp_sum_nglob2D_xi = 0
- tmp_sum_nglob2D_eta = 0
- do iter_layer = ifirst_region, ilast_region
- if (this_region_has_a_doubling(iter_layer)) then
- if (iter_region == IREGION_OUTER_CORE .and. iter_layer == last_doubling_layer) then
- ! simple brick
- divider = 1
- nglob_surf = 6*NGLLX**2 - 7*NGLLX + 2
- nglob_edges_h = 2*(NGLLX-1)+1 + NGLLX
- ! minimum value to be safe
- nglob_edge_v = NGLLX-2
- nb_lay_sb = 2
- nspec2D_xi_sb = NSPEC2D_XI_SUPERBRICK
- nspec2D_eta_sb = NSPEC2D_ETA_SUPERBRICK
- else
- ! double brick
- divider = 2
- if (ner(iter_layer) == 1) then
- nglob_surf = 6*NGLLX**2 - 8*NGLLX + 3
- nglob_edges_h = 4*(NGLLX-1)+1 + 2*(NGLLX-1)+1
- nglob_edge_v = NGLLX-2
- nb_lay_sb = 1
- nspec2D_xi_sb = NSPEC2D_XI_SUPERBRICK_1L
- nspec2D_eta_sb = NSPEC2D_ETA_SUPERBRICK_1L
- else
- nglob_surf = 8*NGLLX**2 - 11*NGLLX + 4
- nglob_edges_h = 4*(NGLLX-1)+1 + 2*(NGLLX-1)+1
- nglob_edge_v = 2*(NGLLX-1)+1 -2
- nb_lay_sb = 2
- nspec2D_xi_sb = NSPEC2D_XI_SUPERBRICK
- nspec2D_eta_sb = NSPEC2D_ETA_SUPERBRICK
- divider = 2
- endif
- endif
- doubling = 1
- to_remove = 1
- else
- if (iter_layer /= ifirst_region) then
- to_remove = 0
- else
- to_remove = 1
- endif
- ! dummy values to avoid a warning
- nglob_surf = 0
- nglob_edges_h = 0
- nglob_edge_v = 0
- divider = 1
- doubling = 0
- nb_lay_sb = 0
- nspec2D_xi_sb = 0
- nspec2D_eta_sb = 0
- endif
-
- tmp_sum_xi = tmp_sum_xi + ((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer)) * &
- (ner(iter_layer) - doubling*nb_lay_sb)) + &
- doubling * ((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer)) * (nspec2D_xi_sb/2))
-
- tmp_sum_eta = tmp_sum_eta + ((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer)) * &
- (ner(iter_layer) - doubling*nb_lay_sb)) + &
- doubling * ((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer)) * (nspec2D_eta_sb/2))
-
- tmp_sum_nglob2D_xi = tmp_sum_nglob2D_xi + (((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer)) * &
- (ner(iter_layer) - doubling*nb_lay_sb))*NGLLX*NGLLX) - &
- ((((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer))-1)*(ner(iter_layer) - doubling*nb_lay_sb)) + &
- ((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer))*(ner(iter_layer) - to_remove - doubling*nb_lay_sb))*NGLLX) + &
- (((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer))-1)*(ner(iter_layer) - to_remove - doubling*nb_lay_sb)) + &
- doubling * (((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer))/divider) * (nglob_surf-nglob_edges_h) - &
- ((NEX_PER_PROC_XI / ratio_sampling_array(iter_layer))/divider -1) * nglob_edge_v)
-
- tmp_sum_nglob2D_eta = tmp_sum_nglob2D_eta + (((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer)) * &
- (ner(iter_layer) - doubling*nb_lay_sb))*NGLLX*NGLLX) - &
- ((((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer))-1)*(ner(iter_layer) - doubling*nb_lay_sb)) + &
- ((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer))* &
- (ner(iter_layer) - to_remove - doubling*nb_lay_sb))*NGLLX) + &
- (((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer))-1)*(ner(iter_layer) - to_remove - doubling*nb_lay_sb)) + &
- doubling * (((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer))/divider) * (nglob_surf-nglob_edges_h) - &
- ((NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer))/divider -1) * nglob_edge_v)
-
- enddo ! iter_layer
-
- NSPEC2D_XI(iter_region) = tmp_sum_xi
- NSPEC2D_ETA(iter_region) = tmp_sum_eta
-
- NGLOB2DMAX_YMIN_YMAX(iter_region) = tmp_sum_nglob2D_xi
- NGLOB2DMAX_XMIN_XMAX(iter_region) = tmp_sum_nglob2D_eta
-
- if (iter_region == IREGION_INNER_CORE .and. INCLUDE_CENTRAL_CUBE) then
- NSPEC2D_XI(iter_region) = NSPEC2D_XI(iter_region) + &
- ((NEX_PER_PROC_XI / ratio_divide_central_cube)*(NEX_XI / ratio_divide_central_cube))
- NSPEC2D_ETA(iter_region) = NSPEC2D_ETA(iter_region) + &
- ((NEX_PER_PROC_ETA / ratio_divide_central_cube)*(NEX_XI / ratio_divide_central_cube))
-
- NGLOB2DMAX_YMIN_YMAX(iter_region) = NGLOB2DMAX_YMIN_YMAX(iter_region) + &
- (((NEX_PER_PROC_XI / ratio_divide_central_cube)*(NGLLX-1)+1)*((NEX_XI / ratio_divide_central_cube)*(NGLLX-1)+1))
-
- NGLOB2DMAX_XMIN_XMAX(iter_region) = NGLOB2DMAX_XMIN_XMAX(iter_region) + &
- (((NEX_PER_PROC_ETA / ratio_divide_central_cube)*(NGLLX-1)+1)*((NEX_XI / ratio_divide_central_cube)*(NGLLX-1)+1))
- endif
- enddo ! iter_region
-
- ! difference of number of surface elements along xi or eta for outer core if the superbrick is cut
- DIFF_NSPEC2D_XI(:,:) = 0
- DIFF_NSPEC2D_ETA(:,:) = 0
- if (CUT_SUPERBRICK_XI) then
- if (CUT_SUPERBRICK_ETA) then
- DIFF_NSPEC2D_XI(2,1) = 2
- DIFF_NSPEC2D_XI(1,2) = 2
- DIFF_NSPEC2D_XI(2,3) = 2
- DIFF_NSPEC2D_XI(1,4) = 2
-
- DIFF_NSPEC2D_ETA(2,1) = 1
- DIFF_NSPEC2D_ETA(2,2) = 1
- DIFF_NSPEC2D_ETA(1,3) = 1
- DIFF_NSPEC2D_ETA(1,4) = 1
- else
- DIFF_NSPEC2D_ETA(2,1) = 1
- DIFF_NSPEC2D_ETA(1,2) = 1
- endif
- else
- if (CUT_SUPERBRICK_ETA) then
- DIFF_NSPEC2D_XI(2,1) = 2
- DIFF_NSPEC2D_XI(1,2) = 2
- endif
- endif
- DIFF_NSPEC2D_XI(:,:) = DIFF_NSPEC2D_XI(:,:) * (NEX_PER_PROC_XI / ratio_divide_central_cube)
- DIFF_NSPEC2D_ETA(:,:) = DIFF_NSPEC2D_ETA(:,:) * (NEX_PER_PROC_ETA / ratio_divide_central_cube)
-
-! exact number of surface elements on the bottom and top boundaries
-
- ! in the crust and mantle
- NSPEC2D_TOP(IREGION_CRUST_MANTLE) = (NEX_XI/ratio_sampling_array(1))*(NEX_ETA/ratio_sampling_array(1))/NPROC
- NSPEC2D_BOTTOM(IREGION_CRUST_MANTLE) = (NEX_XI/ratio_sampling_array(10+layer_offset))*&
- (NEX_ETA/ratio_sampling_array(10+layer_offset))/NPROC
-
- ! in the outer core with mesh doubling
- if (ADD_4TH_DOUBLING) then
- NSPEC2D_TOP(IREGION_OUTER_CORE) = (NEX_XI/(ratio_divide_central_cube/4))*(NEX_ETA/(ratio_divide_central_cube/4))/NPROC
- NSPEC2D_BOTTOM(IREGION_OUTER_CORE) = (NEX_XI/ratio_divide_central_cube)*(NEX_ETA/ratio_divide_central_cube)/NPROC
- else
- NSPEC2D_TOP(IREGION_OUTER_CORE) = (NEX_XI/(ratio_divide_central_cube/2))*(NEX_ETA/(ratio_divide_central_cube/2))/NPROC
- NSPEC2D_BOTTOM(IREGION_OUTER_CORE) = (NEX_XI/ratio_divide_central_cube)*(NEX_ETA/ratio_divide_central_cube)/NPROC
- endif
-
- ! in the top of the inner core
- NSPEC2D_TOP(IREGION_INNER_CORE) = (NEX_XI/ratio_divide_central_cube)*(NEX_ETA/ratio_divide_central_cube)/NPROC
- NSPEC2D_BOTTOM(IREGION_INNER_CORE) = NSPEC2D_TOP(IREGION_INNER_CORE)
-
- ! maximum number of surface elements on vertical boundaries of the slices
- NSPEC2DMAX_XMIN_XMAX(:) = NSPEC2D_ETA(:)
- NSPEC2DMAX_XMIN_XMAX(IREGION_OUTER_CORE) = NSPEC2DMAX_XMIN_XMAX(IREGION_OUTER_CORE) + maxval(DIFF_NSPEC2D_ETA(:,:))
- NSPEC2DMAX_YMIN_YMAX(:) = NSPEC2D_XI(:)
- NSPEC2DMAX_YMIN_YMAX(IREGION_OUTER_CORE) = NSPEC2DMAX_YMIN_YMAX(IREGION_OUTER_CORE) + maxval(DIFF_NSPEC2D_XI(:,:))
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!
-!!!!!! 3D case
-!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- ! exact number of spectral elements in each region
-
- do iter_region = IREGION_CRUST_MANTLE,IREGION_INNER_CORE
- if(iter_region == IREGION_CRUST_MANTLE) then
- ifirst_region = 1
- ilast_region = 10 + layer_offset
- else if(iter_region == IREGION_OUTER_CORE) then
- ifirst_region = 11 + layer_offset
- ilast_region = NUMBER_OF_MESH_LAYERS - 1
- else if(iter_region == IREGION_INNER_CORE) then
- ifirst_region = NUMBER_OF_MESH_LAYERS
- ilast_region = NUMBER_OF_MESH_LAYERS
- else
- stop 'incorrect region code detected'
- endif
- tmp_sum = 0;
- do iter_layer = ifirst_region, ilast_region
- if (this_region_has_a_doubling(iter_layer)) then
- if (ner(iter_layer) == 1) then
- nb_lay_sb = 1
- nspec_sb = NSPEC_SUPERBRICK_1L
- else
- nb_lay_sb = 2
- nspec_sb = NSPEC_DOUBLING_SUPERBRICK
- endif
- doubling = 1
- else
- doubling = 0
- nb_lay_sb = 0
- nspec_sb = 0
- endif
- tmp_sum = tmp_sum + (((NEX_XI / ratio_sampling_array(iter_layer)) * (NEX_ETA / ratio_sampling_array(iter_layer)) * &
- (ner(iter_layer) - doubling*nb_lay_sb)) + &
- doubling * ((NEX_XI / ratio_sampling_array(iter_layer)) * (NEX_ETA / ratio_sampling_array(iter_layer)) * &
- (nspec_sb/4))) / NPROC
- enddo
- NSPEC(iter_region) = tmp_sum
- enddo
-
- if(INCLUDE_CENTRAL_CUBE) NSPEC(IREGION_INNER_CORE) = NSPEC(IREGION_INNER_CORE) + &
- (NEX_PER_PROC_XI / ratio_divide_central_cube) * &
- (NEX_PER_PROC_ETA / ratio_divide_central_cube) * &
- (NEX_XI / ratio_divide_central_cube)
-
- if(minval(NSPEC) <= 0) stop 'negative NSPEC, there is a problem somewhere, try to recompile :) '
-
-
- end subroutine rcp_count_elements
-
-
-!
-!-------------------------------------------------------------------------------------------------
-!
-
- subroutine rcp_count_points(NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube,&
- NSPEC1D_RADIAL,NGLOB1D_RADIAL, &
- NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX,NGLOB,&
- nblocks_xi,nblocks_eta,ner,ratio_sampling_array,&
- this_region_has_a_doubling,&
- ifirst_region, ilast_region, iter_region, iter_layer, &
- doubling, padding, tmp_sum, &
- INCLUDE_CENTRAL_CUBE,NER_TOP_CENTRAL_CUBE_ICB,NEX_XI, &
- NUMBER_OF_MESH_LAYERS,layer_offset, &
- nb_lay_sb, nglob_vol, nglob_surf, nglob_edge, &
- CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, &
- last_doubling_layer, cut_doubling, nglob_int_surf_xi, nglob_int_surf_eta,nglob_ext_surf,&
- normal_doubling, nglob_center_edge, nglob_corner_edge, nglob_border_edge)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!
-!!!!!! calculation of number of points (NGLOB) below
-!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
- implicit none
-
- include "constants.h"
-
-! parameters read from parameter file
-
-! parameters to be computed based upon parameters above read from file
- integer NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube
-
- integer, dimension(MAX_NUM_REGIONS) :: &
- NSPEC1D_RADIAL,NGLOB1D_RADIAL, &
- NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX, &
- NGLOB
-
- integer NER_TOP_CENTRAL_CUBE_ICB,NEX_XI
- integer nblocks_xi,nblocks_eta
-
- integer, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: ner,ratio_sampling_array
- logical, dimension(MAX_NUMBER_OF_MESH_LAYERS) :: this_region_has_a_doubling
-
- integer :: ifirst_region, ilast_region, iter_region, iter_layer, doubling, padding, tmp_sum
- integer :: NUMBER_OF_MESH_LAYERS,layer_offset, &
- nb_lay_sb, nglob_vol, nglob_surf, nglob_edge
-
-! for the cut doublingbrick improvement
- logical :: CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA,INCLUDE_CENTRAL_CUBE
- integer :: last_doubling_layer, cut_doubling, nglob_int_surf_xi, nglob_int_surf_eta,nglob_ext_surf,&
- normal_doubling, nglob_center_edge, nglob_corner_edge, nglob_border_edge
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!
-!!!!!! 1D case
-!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! theoretical number of Gauss-Lobatto points in radial direction
- NGLOB1D_RADIAL(:) = NSPEC1D_RADIAL(:)*(NGLLZ-1)+1
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!
-!!!!!! 2D case
-!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! 2-D addressing and buffers for summation between slices
-! we add one to number of points because of the flag after the last point
- NGLOB2DMAX_XMIN_XMAX(:) = NGLOB2DMAX_XMIN_XMAX(:) + 1
- NGLOB2DMAX_YMIN_YMAX(:) = NGLOB2DMAX_YMIN_YMAX(:) + 1
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!
-!!!!!! 3D case
-!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! exact number of global points in each region
-
-! initialize array
- NGLOB(:) = 0
-
-! in the inner core (no doubling region + eventually central cube)
- if(INCLUDE_CENTRAL_CUBE) then
- NGLOB(IREGION_INNER_CORE) = ((NEX_PER_PROC_XI/ratio_divide_central_cube) &
- *(NGLLX-1)+1)*((NEX_PER_PROC_ETA/ratio_divide_central_cube) &
- *(NGLLY-1)+1)*((NER_TOP_CENTRAL_CUBE_ICB + NEX_XI / ratio_divide_central_cube)*(NGLLZ-1)+1)
- else
- NGLOB(IREGION_INNER_CORE) = ((NEX_PER_PROC_XI/ratio_divide_central_cube) &
- *(NGLLX-1)+1)*((NEX_PER_PROC_ETA/ratio_divide_central_cube) &
- *(NGLLY-1)+1)*((NER_TOP_CENTRAL_CUBE_ICB)*(NGLLZ-1)+1)
- endif
-
-! in the crust-mantle and outercore
- do iter_region = IREGION_CRUST_MANTLE,IREGION_OUTER_CORE
- if(iter_region == IREGION_CRUST_MANTLE) then
- ifirst_region = 1
- ilast_region = 10 + layer_offset
- else if(iter_region == IREGION_OUTER_CORE) then
- ifirst_region = 11 + layer_offset
- ilast_region = NUMBER_OF_MESH_LAYERS - 1
- else
- stop 'incorrect region code detected'
- endif
- tmp_sum = 0;
- do iter_layer = ifirst_region, ilast_region
- nglob_int_surf_eta=0
- nglob_int_surf_xi=0
- nglob_ext_surf = 0
- nglob_center_edge = 0
- nglob_corner_edge = 0
- nglob_border_edge = 0
- if (this_region_has_a_doubling(iter_layer)) then
- if (iter_region == IREGION_OUTER_CORE .and. iter_layer == last_doubling_layer .and. &
- (CUT_SUPERBRICK_XI .or. CUT_SUPERBRICK_ETA)) then
- doubling = 1
- normal_doubling = 0
- cut_doubling = 1
- nb_lay_sb = 2
- nglob_edge = 0
- nglob_surf = 0
- nglob_vol = 8*NGLLX**3 - 12*NGLLX**2 + 6*NGLLX - 1
- nglob_int_surf_eta = 6*NGLLX**2 - 7*NGLLX + 2
- nglob_int_surf_xi = 5*NGLLX**2 - 5*NGLLX + 1
- nglob_ext_surf = 4*NGLLX**2-4*NGLLX+1
- nglob_center_edge = 4*(NGLLX-1)+1
- nglob_corner_edge = 2*(NGLLX-1)+1
- nglob_border_edge = 3*(NGLLX-1)+1
- else
- if (ner(iter_layer) == 1) then
- nb_lay_sb = 1
- nglob_vol = 28*NGLLX**3 - 62*NGLLX**2 + 47*NGLLX - 12
- nglob_surf = 6*NGLLX**2-8*NGLLX+3
- nglob_edge = NGLLX
- else
- nb_lay_sb = 2
- nglob_vol = 32*NGLLX**3 - 70*NGLLX**2 + 52*NGLLX - 13
- nglob_surf = 8*NGLLX**2-11*NGLLX+4
- nglob_edge = 2*NGLLX-1
- endif
- doubling = 1
- normal_doubling = 1
- cut_doubling = 0
- endif
- padding = -1
- else
- doubling = 0
- normal_doubling = 0
- cut_doubling = 0
- padding = 0
- nb_lay_sb = 0
- nglob_vol = 0
- nglob_surf = 0
- nglob_edge = 0
- endif
- if (iter_layer == ilast_region) padding = padding +1
- nblocks_xi = NEX_PER_PROC_XI / ratio_sampling_array(iter_layer)
- nblocks_eta = NEX_PER_PROC_ETA / ratio_sampling_array(iter_layer)
-
- tmp_sum = tmp_sum + &
- ((nblocks_xi)*(NGLLX-1)+1) * ((nblocks_eta)*(NGLLX-1)+1) * ((ner(iter_layer) - doubling*nb_lay_sb)*(NGLLX-1)+padding)+&
- normal_doubling * ((((nblocks_xi*nblocks_eta)/4)*nglob_vol) - &
- (((nblocks_eta/2-1)*nblocks_xi/2+(nblocks_xi/2-1)*nblocks_eta/2)*nglob_surf) + &
- ((nblocks_eta/2-1)*(nblocks_xi/2-1)*nglob_edge)) + &
- cut_doubling*(nglob_vol*(nblocks_xi*nblocks_eta) - &
- ( nblocks_eta*(int(nblocks_xi/2)*nglob_int_surf_xi + int((nblocks_xi-1)/2)*nglob_ext_surf) + &
- nblocks_xi*(int(nblocks_eta/2)*nglob_int_surf_eta + int((nblocks_eta-1)/2)*nglob_ext_surf)&
- ) + &
- ( int(nblocks_xi/2)*int(nblocks_eta/2)*nglob_center_edge + &
- int((nblocks_xi-1)/2)*int((nblocks_eta-1)/2)*nglob_corner_edge + &
- ((int(nblocks_eta/2)*int((nblocks_xi-1)/2))+(int((nblocks_eta-1)/2)*int(nblocks_xi/2)))*nglob_border_edge&
- ))
- enddo
- NGLOB(iter_region) = tmp_sum
- enddo
-
-!!! example :
-!!! nblocks_xi/2=5
-!!! ____________________________________
-!!! I I I I I I
-!!! I I I I I I
-!!! I I I I I I
-!!! nblocks_eta/2=3 I______+______+______+______+______I
-!!! I I I I I I
-!!! I I I I I I
-!!! I I I I I I
-!!! I______+______+______+______+______I
-!!! I I I I I I
-!!! I I I I I I
-!!! I I I I I I
-!!! I______I______I______I______I______I
-!!!
-!!! NGLOB for this doubling layer = 3*5*Volume - ((3-1)*5+(5-1)*3)*Surface + (3-1)*(5-1)*Edge
-!!!
-!!! 32*NGLLX**3 - 70*NGLLX**2 + 52*NGLLX - 13 -> nb GLL points in a superbrick (Volume)
-!!! 8*NGLLX**2-11*NGLLX+4 -> nb GLL points on a superbrick side (Surface)
-!!! 2*NGLLX-1 -> nb GLL points on a corner edge of a superbrick (Edge)
-
-!!! for the one layer superbrick :
-!!! NGLOB = 28.NGLL^3 - 62.NGLL^2 + 47.NGLL - 12 (Volume)
-!!! NGLOB = 6.NGLL^2 - 8.NGLL + 3 (Surface)
-!!! NGLOB = NGLL (Edge)
-!!!
-!!! those results were obtained by using the script UTILS/doubling_brick/count_nglob_analytical.pl
-!!! with an opendx file of the superbrick's geometry
-
-!!! for the basic doubling bricks (two layers)
-!!! NGLOB = 8.NGLL^3 - 12.NGLL^2 + 6.NGLL - 1 (VOLUME)
-!!! NGLOB = 5.NGLL^2 - 5.NGLL + 1 (SURFACE 1)
-!!! NGLOB = 6.NGLL^2 - 7.NGLL + 2 (SURFACE 2)
-
- end subroutine rcp_count_points
-
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/Makefile.in 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/Makefile.in 2012-04-02 06:04:51 UTC (rev 19915)
@@ -102,7 +102,10 @@
$O/convert_time.check.o \
$O/create_central_cube_buffers.mpicheck.o \
$O/create_name_database.shared.o \
+ $O/count_elements.shared.o \
$O/count_number_of_sources.shared.o \
+ $O/count_points.shared.o \
+ $O/define_all_layers.shared.o \
$O/define_derivation_matrices.check.o \
$O/euler_angles.shared.o \
$O/force_ftz.cc.o \
@@ -111,6 +114,7 @@
$O/get_cmt.check.o \
$O/get_event_info.mpicheck.o \
$O/get_model_parameters.shared.o \
+ $O/get_timestep_and_layers.shared.o \
$O/get_value_parameters.shared.o \
$O/gll_library.shared.o \
$O/hex_nodes.shared.o \
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/assemble_MPI_central_cube_block.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/assemble_MPI_central_cube_block.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/assemble_MPI_central_cube_block.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -32,7 +32,8 @@
receiver_cube_from_slices, ibool_inner_core, &
idoubling_inner_core, NSPEC_INNER_CORE, &
ibelm_bottom_inner_core, NSPEC2D_BOTTOM_INNER_CORE,NGLOB_INNER_CORE, &
- vector_assemble,ndim_assemble)
+ vector_assemble,ndim_assemble, &
+ iproc_eta,addressing,NCHUNKS,NPROC_XI,NPROC_ETA)
! this version of the routine is based on blocking MPI calls
@@ -62,6 +63,11 @@
integer ndim_assemble
real(kind=CUSTOM_REAL), dimension(ndim_assemble,NGLOB_INNER_CORE) :: vector_assemble
+!daniel: for addressing of the slices
+ integer, intent(in) :: NCHUNKS,NPROC_XI,NPROC_ETA
+ integer, dimension(NCHUNKS,0:NPROC_XI-1,0:NPROC_ETA-1), intent(in) :: addressing
+ integer, intent(in) :: iproc_eta
+
integer ipoin,idimension, ispec2D, ispec
integer i,j,k
integer sender,receiver,imsg
@@ -117,8 +123,18 @@
! send buffer to central cube
receiver = receiver_cube_from_slices
call MPI_SEND(buffer_slices,ndim_assemble*npoin2D_cube_from_slices, &
- MPI_DOUBLE_PRECISION,receiver,itag,MPI_COMM_WORLD,ier)
+ MPI_DOUBLE_PRECISION,receiver,itag,MPI_COMM_WORLD,ier)
+ ! daniel: in case NPROC_XI == 1, the other chunks exchange all bottom points with
+ ! CHUNK_AB **and** CHUNK_AB_ANTIPODE
+ if(NPROC_XI==1) then
+ call MPI_SEND(buffer_slices,ndim_assemble*npoin2D_cube_from_slices, &
+ MPI_DOUBLE_PRECISION, &
+ addressing(CHUNK_AB_ANTIPODE,0,iproc_eta), &
+ itag,MPI_COMM_WORLD,ier)
+ endif
+
+
endif ! end sending info to central cube
@@ -160,10 +176,17 @@
! distinguish between single and double precision for reals
do imsg = 1,nb_msgs_theor_in_cube-1
do ipoin = 1,npoin2D_cube_from_slices
- if(CUSTOM_REAL == SIZE_REAL) then
- array_central_cube(ibool_central_cube(imsg,ipoin)) = sngl(buffer_all_cube_from_slices(imsg,ipoin,idimension))
+!daniel: debug
+ if(NPROC_XI==1) then
+ if(ibool_central_cube(imsg,ipoin) > 0 ) then
+ array_central_cube(ibool_central_cube(imsg,ipoin)) = buffer_all_cube_from_slices(imsg,ipoin,idimension)
+ endif
else
- array_central_cube(ibool_central_cube(imsg,ipoin)) = buffer_all_cube_from_slices(imsg,ipoin,idimension)
+ if(CUSTOM_REAL == SIZE_REAL) then
+ array_central_cube(ibool_central_cube(imsg,ipoin)) = sngl(buffer_all_cube_from_slices(imsg,ipoin,idimension))
+ else
+ array_central_cube(ibool_central_cube(imsg,ipoin)) = buffer_all_cube_from_slices(imsg,ipoin,idimension)
+ endif
endif
enddo
enddo
@@ -171,16 +194,28 @@
! use a mask to avoid taking the same point into account several times.
mask(:) = .false.
do ipoin = 1,npoin2D_cube_from_slices
- if (.not. mask(ibool_central_cube(nb_msgs_theor_in_cube,ipoin))) then
- if(CUSTOM_REAL == SIZE_REAL) then
- array_central_cube(ibool_central_cube(nb_msgs_theor_in_cube,ipoin)) = &
- array_central_cube(ibool_central_cube(nb_msgs_theor_in_cube,ipoin)) + &
- sngl(buffer_all_cube_from_slices(nb_msgs_theor_in_cube,ipoin,idimension))
- else
- array_central_cube(ibool_central_cube(nb_msgs_theor_in_cube,ipoin)) = &
- array_central_cube(ibool_central_cube(nb_msgs_theor_in_cube,ipoin)) + &
- buffer_all_cube_from_slices(nb_msgs_theor_in_cube,ipoin,idimension)
+!daniel:debug
+ if(NPROC_XI==1) then
+ if( ibool_central_cube(nb_msgs_theor_in_cube,ipoin) > 0 ) then
+ if (.not. mask(ibool_central_cube(nb_msgs_theor_in_cube,ipoin))) then
+ array_central_cube(ibool_central_cube(nb_msgs_theor_in_cube,ipoin)) = &
+ array_central_cube(ibool_central_cube(nb_msgs_theor_in_cube,ipoin)) + &
+ buffer_all_cube_from_slices(nb_msgs_theor_in_cube,ipoin,idimension)
+ endif
+ mask(ibool_central_cube(nb_msgs_theor_in_cube,ipoin)) = .true.
endif
+ else
+ if (.not. mask(ibool_central_cube(nb_msgs_theor_in_cube,ipoin))) then
+ if(CUSTOM_REAL == SIZE_REAL) then
+ array_central_cube(ibool_central_cube(nb_msgs_theor_in_cube,ipoin)) = &
+ array_central_cube(ibool_central_cube(nb_msgs_theor_in_cube,ipoin)) + &
+ sngl(buffer_all_cube_from_slices(nb_msgs_theor_in_cube,ipoin,idimension))
+ else
+ array_central_cube(ibool_central_cube(nb_msgs_theor_in_cube,ipoin)) = &
+ array_central_cube(ibool_central_cube(nb_msgs_theor_in_cube,ipoin)) + &
+ buffer_all_cube_from_slices(nb_msgs_theor_in_cube,ipoin,idimension)
+ endif
+ endif
mask(ibool_central_cube(nb_msgs_theor_in_cube,ipoin)) = .true.
endif
enddo
@@ -203,7 +238,18 @@
! copy sum back
do imsg = 1,nb_msgs_theor_in_cube-1
do ipoin = 1,npoin2D_cube_from_slices
- buffer_all_cube_from_slices(imsg,ipoin,idimension) = vector_assemble(idimension,ibool_central_cube(imsg,ipoin))
+!daniel:debug
+ if(NPROC_XI==1) then
+ if( ibool_central_cube(imsg,ipoin) > 0 ) then
+ buffer_all_cube_from_slices(imsg,ipoin,idimension) = &
+ vector_assemble(idimension,ibool_central_cube(imsg,ipoin))
+ else
+ buffer_all_cube_from_slices(imsg,ipoin,idimension) = 0._CUSTOM_REAL
+ endif
+ else
+ buffer_all_cube_from_slices(imsg,ipoin,idimension) = &
+ vector_assemble(idimension,ibool_central_cube(imsg,ipoin))
+ endif
enddo
enddo
@@ -217,11 +263,23 @@
if(ichunk /= CHUNK_AB .and. ichunk /= CHUNK_AB_ANTIPODE) then
! receive buffers from slices
- sender = receiver_cube_from_slices
- call MPI_RECV(buffer_slices, &
- ndim_assemble*npoin2D_cube_from_slices,MPI_DOUBLE_PRECISION,sender, &
- itag,MPI_COMM_WORLD,msg_status,ier)
+ sender = receiver_cube_from_slices
+ call MPI_RECV(buffer_slices, &
+ ndim_assemble*npoin2D_cube_from_slices,MPI_DOUBLE_PRECISION,sender, &
+ itag,MPI_COMM_WORLD,msg_status,ier)
+ ! daniel: in case NPROC_XI == 1, the other chunks exchange all bottom points with
+ ! CHUNK_AB **and** CHUNK_AB_ANTIPODE
+ if(NPROC_XI==1) then
+ call MPI_RECV(buffer_slices2, &
+ ndim_assemble*npoin2D_cube_from_slices,MPI_DOUBLE_PRECISION, &
+ addressing(CHUNK_AB_ANTIPODE,0,iproc_eta), &
+ itag,MPI_COMM_WORLD,msg_status,ier)
+
+ buffer_slices = buffer_slices + buffer_slices2
+ endif
+
+
! for bottom elements in contact with central cube from the slices side
ipoin = 0
do ispec2D = 1,NSPEC2D_BOTTOM_INNER_CORE
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/check_simulation_stability.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/check_simulation_stability.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/check_simulation_stability.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -118,6 +118,14 @@
call check_norm_acoustic_from_device(Ufluidnorm,Mesh_pointer,1)
endif
+ ! check stability of the code, exit if unstable
+ ! negative values can occur with some compilers when the unstable value is greater
+ ! than the greatest possible floating-point number of the machine
+ if(Usolidnorm > STABILITY_THRESHOLD .or. Usolidnorm < 0) &
+ call exit_MPI(myrank,'forward simulation became unstable in solid and blew up')
+ if(Ufluidnorm > STABILITY_THRESHOLD .or. Ufluidnorm < 0) &
+ call exit_MPI(myrank,'forward simulation became unstable in fluid and blew up')
+
! compute the maximum of the maxima for all the slices using an MPI reduction
call MPI_REDUCE(Usolidnorm,Usolidnorm_all,1,CUSTOM_MPI_TYPE,MPI_MAX,0, &
MPI_COMM_WORLD,ier)
@@ -141,6 +149,11 @@
call check_norm_acoustic_from_device(b_Ufluidnorm,Mesh_pointer,3)
endif
+ if(b_Usolidnorm > STABILITY_THRESHOLD .or. b_Usolidnorm < 0) &
+ call exit_MPI(myrank,'backward simulation became unstable and blew up in the solid')
+ if(b_Ufluidnorm > STABILITY_THRESHOLD .or. b_Ufluidnorm < 0) &
+ call exit_MPI(myrank,'backward simulation became unstable and blew up in the fluid')
+
! compute the maximum of the maxima for all the slices using an MPI reduction
call MPI_REDUCE(b_Usolidnorm,b_Usolidnorm_all,1,CUSTOM_MPI_TYPE,MPI_MAX,0, &
MPI_COMM_WORLD,ier)
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_crust_mantle.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_crust_mantle.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_crust_mantle.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -41,9 +41,6 @@
hprime_xx,hprime_yy,hprime_zz,hprimewgll_xx,hprimewgll_yy,hprimewgll_zz, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,wgll_cube, &
minus_gravity_table,density_table,minus_deriv_gravity_table, &
- myrank,iproc_xi,iproc_eta,ichunk,addressing, &
- iprocfrom_faces,iprocto_faces, &
- iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
npoin2D_max_all_CM_IC,INCLUDE_CENTRAL_CUBE
use specfem_par_crustmantle,only: &
@@ -71,16 +68,6 @@
nspec_outer => nspec_outer_crust_mantle, &
nspec_inner => nspec_inner_crust_mantle
-! use specfem_par_innercore,only: &
-! ibool_inner_core,idoubling_inner_core, &
-! iboolleft_xi_inner_core,iboolright_xi_inner_core,iboolleft_eta_inner_core,iboolright_eta_inner_core, &
-! npoin2D_faces_inner_core,npoin2D_xi_inner_core,npoin2D_eta_inner_core, &
-! iboolfaces_inner_core,iboolcorner_inner_core, &
-! nb_msgs_theor_in_cube,sender_from_slices_to_cube, &
-! npoin2D_cube_from_slices, &
-! ibool_central_cube, &
-! receiver_cube_from_slices,ibelm_bottom_inner_core,NSPEC2D_BOTTOM_IC
-
implicit none
integer :: NSPEC,NGLOB,NSPEC_ATT
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_crust_mantle_Dev.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_crust_mantle_Dev.F90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_crust_mantle_Dev.F90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -51,9 +51,6 @@
use specfem_par,only: &
hprime_xx,hprime_xxT,hprimewgll_xx,hprimewgll_xxT,wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,wgll_cube, &
minus_gravity_table,density_table,minus_deriv_gravity_table, &
- myrank,iproc_xi,iproc_eta,ichunk,addressing, &
- iprocfrom_faces,iprocto_faces, &
- iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
npoin2D_max_all_CM_IC,INCLUDE_CENTRAL_CUBE
use specfem_par_crustmantle,only: &
@@ -81,16 +78,6 @@
nspec_outer => nspec_outer_crust_mantle, &
nspec_inner => nspec_inner_crust_mantle
-! use specfem_par_innercore,only: &
-! ibool_inner_core,idoubling_inner_core, &
-! iboolleft_xi_inner_core,iboolright_xi_inner_core,iboolleft_eta_inner_core,iboolright_eta_inner_core, &
-! npoin2D_faces_inner_core,npoin2D_xi_inner_core,npoin2D_eta_inner_core, &
-! iboolfaces_inner_core,iboolcorner_inner_core, &
-! nb_msgs_theor_in_cube,sender_from_slices_to_cube, &
-! npoin2D_cube_from_slices, &
-! ibool_central_cube, &
-! receiver_cube_from_slices,ibelm_bottom_inner_core,NSPEC2D_BOTTOM_IC
-
implicit none
integer :: NSPEC,NGLOB,NSPEC_ATT
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_inner_core.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_inner_core.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_inner_core.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -41,9 +41,6 @@
hprime_xx,hprime_yy,hprime_zz,hprimewgll_xx,hprimewgll_yy,hprimewgll_zz, &
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,wgll_cube, &
minus_gravity_table,density_table,minus_deriv_gravity_table, &
- myrank,iproc_xi,iproc_eta,ichunk,addressing, &
- iprocfrom_faces,iprocto_faces, &
- iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
npoin2D_max_all_CM_IC,INCLUDE_CENTRAL_CUBE
use specfem_par_innercore,only: &
@@ -57,7 +54,7 @@
c33store => c33store_inner_core,c44store => c44store_inner_core, &
ibool => ibool_inner_core,idoubling => idoubling_inner_core, &
one_minus_sum_beta => one_minus_sum_beta_inner_core, &
- ibool_inner_core,idoubling_inner_core, &
+ ibool_inner_core, &
iboolleft_xi_inner_core,iboolright_xi_inner_core,iboolleft_eta_inner_core,iboolright_eta_inner_core, &
npoin2D_faces_inner_core,npoin2D_xi_inner_core,npoin2D_eta_inner_core, &
iboolfaces_inner_core,iboolcorner_inner_core, &
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_inner_core_Dev.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_inner_core_Dev.F90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_inner_core_Dev.F90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -51,9 +51,6 @@
use specfem_par,only: &
hprime_xx,hprime_xxT,hprimewgll_xx,hprimewgll_xxT,wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,wgll_cube, &
minus_gravity_table,density_table,minus_deriv_gravity_table, &
- myrank,iproc_xi,iproc_eta,ichunk,addressing, &
- iprocfrom_faces,iprocto_faces, &
- iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
npoin2D_max_all_CM_IC,INCLUDE_CENTRAL_CUBE
use specfem_par_innercore,only: &
@@ -67,7 +64,7 @@
c33store => c33store_inner_core,c44store => c44store_inner_core, &
ibool => ibool_inner_core,idoubling => idoubling_inner_core, &
one_minus_sum_beta => one_minus_sum_beta_inner_core, &
- ibool_inner_core,idoubling_inner_core, &
+ ibool_inner_core, &
iboolleft_xi_inner_core,iboolright_xi_inner_core,iboolleft_eta_inner_core,iboolright_eta_inner_core, &
npoin2D_faces_inner_core,npoin2D_xi_inner_core,npoin2D_eta_inner_core, &
iboolfaces_inner_core,iboolcorner_inner_core, &
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_outer_core.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_outer_core.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_outer_core.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -38,9 +38,6 @@
wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,wgll_cube, &
minus_rho_g_over_kappa_fluid,d_ln_density_dr_table, &
MOVIE_VOLUME, &
- myrank,iproc_xi,iproc_eta,ichunk,addressing, &
- iprocfrom_faces,iprocto_faces, &
- iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
npoin2D_max_all_CM_IC
use specfem_par_outercore,only: &
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_outer_core_Dev.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_outer_core_Dev.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/compute_forces_outer_core_Dev.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -39,9 +39,6 @@
hprime_xx,hprime_xxT,hprimewgll_xx,hprimewgll_xxT,wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,wgll_cube, &
minus_rho_g_over_kappa_fluid,d_ln_density_dr_table, &
MOVIE_VOLUME, &
- myrank,iproc_xi,iproc_eta,ichunk,addressing, &
- iprocfrom_faces,iprocto_faces, &
- iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
npoin2D_max_all_CM_IC
use specfem_par_outercore,only: &
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/create_central_cube_buffers.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/create_central_cube_buffers.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/create_central_cube_buffers.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -89,17 +89,27 @@
! MPI status of messages to be received
integer msg_status(MPI_STATUS_SIZE)
+ integer :: nproc_xi_half_floor,nproc_xi_half_ceil
+
+ if( mod(NPROC_XI,2) /= 0 ) then
+ nproc_xi_half_floor = floor(NPROC_XI/2.d0)
+ nproc_xi_half_ceil = ceiling(NPROC_XI/2.d0)
+ else
+ nproc_xi_half_floor = NPROC_XI/2
+ nproc_xi_half_ceil = NPROC_XI/2
+ endif
+
!--- processor to send information to in cube from slices
! four vertical sides first
if(ichunk == CHUNK_AC) then
- if (iproc_xi < floor(NPROC_XI/2.d0)) then
+ if (iproc_xi < nproc_xi_half_floor) then
receiver_cube_from_slices = addressing(CHUNK_AB_ANTIPODE,NPROC_XI-1,iproc_eta)
else
receiver_cube_from_slices = addressing(CHUNK_AB,0,iproc_eta)
endif
else if(ichunk == CHUNK_BC) then
- if (iproc_xi < floor(NPROC_XI/2.d0)) then
+ if (iproc_xi < nproc_xi_half_floor) then
receiver_cube_from_slices = addressing(CHUNK_AB_ANTIPODE,NPROC_XI-1-iproc_eta,NPROC_ETA-1)
else
receiver_cube_from_slices = addressing(CHUNK_AB,iproc_eta,NPROC_ETA-1)
@@ -111,7 +121,7 @@
receiver_cube_from_slices = addressing(CHUNK_AB_ANTIPODE,0,iproc_eta)
endif
else if(ichunk == CHUNK_BC_ANTIPODE) then
- if (iproc_xi < floor(NPROC_XI/2.d0)) then
+ if (iproc_xi < nproc_xi_half_floor) then
receiver_cube_from_slices = addressing(CHUNK_AB_ANTIPODE,iproc_eta,0)
else
receiver_cube_from_slices = addressing(CHUNK_AB,NPROC_XI-1-iproc_eta,0)
@@ -134,7 +144,7 @@
! define sender for xi = xi_min edge
if(iproc_xi == 0) then
- do iproc_xi_loop = floor(NPROC_XI/2.d0),NPROC_XI-1
+ do iproc_xi_loop = nproc_xi_half_floor,NPROC_XI-1
imsg = imsg + 1
sender_from_slices_to_cube(imsg) = addressing(CHUNK_AC,iproc_xi_loop,iproc_eta)
enddo
@@ -150,7 +160,7 @@
! define sender for eta = eta_min edge
if(iproc_eta == 0) then
- do iproc_xi_loop = floor(NPROC_XI/2.d0),NPROC_XI-1
+ do iproc_xi_loop = nproc_xi_half_floor,NPROC_XI-1
imsg = imsg + 1
sender_from_slices_to_cube(imsg) = addressing(CHUNK_BC_ANTIPODE,iproc_xi_loop,NPROC_ETA-1-iproc_xi)
enddo
@@ -158,7 +168,7 @@
! define sender for eta = eta_max edge
if(iproc_eta == NPROC_ETA-1) then
- do iproc_xi_loop = floor(NPROC_XI/2.d0),NPROC_XI-1
+ do iproc_xi_loop = nproc_xi_half_floor,NPROC_XI-1
imsg = imsg + 1
sender_from_slices_to_cube(imsg) = addressing(CHUNK_BC,iproc_xi_loop,iproc_xi)
enddo
@@ -170,7 +180,10 @@
sender_from_slices_to_cube(imsg) = addressing(CHUNK_AB_ANTIPODE,NPROC_XI-1-iproc_xi,iproc_eta)
! check that total number of faces found is correct
- if(imsg /= nb_msgs_theor_in_cube) call exit_MPI(myrank,'wrong number of faces found for central cube')
+ if(imsg /= nb_msgs_theor_in_cube) then
+ print*,'error ',myrank,'nb_msgs_theor_in_cube:',nb_msgs_theor_in_cube,imsg
+ call exit_MPI(myrank,'wrong number of faces found for central cube')
+ endif
else if(ichunk == CHUNK_AB_ANTIPODE) then
@@ -179,7 +192,7 @@
! define sender for xi = xi_min edge
if(iproc_xi == 0) then
- do iproc_xi_loop = ceiling(NPROC_XI/2.d0),NPROC_XI-1
+ do iproc_xi_loop = nproc_xi_half_ceil,NPROC_XI-1
imsg = imsg + 1
sender_from_slices_to_cube(imsg) = addressing(CHUNK_AC_ANTIPODE,iproc_xi_loop,iproc_eta)
enddo
@@ -209,13 +222,44 @@
enddo
endif
+ ! daniel: in case NPROC_XI == 1, the other chunks exchange all bottom points with
+ ! CHUNK_AB **and** CHUNK_AB_ANTIPODE
+ if(NPROC_XI==1) then
+ ! define sender for xi = xi_min edge
+ if(iproc_xi == 0) then
+ imsg = imsg + 1
+ sender_from_slices_to_cube(imsg) = addressing(CHUNK_AC_ANTIPODE,0,iproc_eta)
+ endif
+
+ ! define sender for xi = xi_max edge
+ if(iproc_xi == NPROC_XI-1) then
+ imsg = imsg + 1
+ sender_from_slices_to_cube(imsg) = addressing(CHUNK_AC,0,iproc_eta)
+ endif
+
+ ! define sender for eta = eta_min edge
+ if(iproc_eta == 0) then
+ imsg = imsg + 1
+ sender_from_slices_to_cube(imsg) = addressing(CHUNK_BC_ANTIPODE,0,iproc_xi)
+ endif
+
+ ! define sender for eta = eta_max edge
+ if(iproc_eta == NPROC_ETA-1) then
+ imsg = imsg + 1
+ sender_from_slices_to_cube(imsg) = addressing(CHUNK_BC,0,NPROC_ETA-1-iproc_xi)
+ endif
+ endif
+
! define sender for bottom edge
! bottom of cube, direct correspondence but with inverted xi axis
imsg = imsg + 1
sender_from_slices_to_cube(imsg) = addressing(CHUNK_AB,NPROC_XI-1-iproc_xi,iproc_eta)
! check that total number of faces found is correct
- if(imsg /= nb_msgs_theor_in_cube) call exit_MPI(myrank,'wrong number of faces found for central cube')
+ if(imsg /= nb_msgs_theor_in_cube) then
+ print*,'error ',myrank,'nb_msgs_theor_in_cube:',nb_msgs_theor_in_cube,imsg
+ call exit_MPI(myrank,'wrong number of faces found for central cube')
+ endif
else
@@ -227,31 +271,30 @@
! on chunk AB & AB ANTIPODE, receive all (except bottom) the messages from slices
if(ichunk == CHUNK_AB .or. ichunk == CHUNK_AB_ANTIPODE) then
-
do imsg = 1,nb_msgs_theor_in_cube-1
-! receive buffers from slices
+ ! receive buffers from slices
sender = sender_from_slices_to_cube(imsg)
call MPI_RECV(buffer_slices, &
NDIM*npoin2D_cube_from_slices,MPI_DOUBLE_PRECISION,sender, &
itag,MPI_COMM_WORLD,msg_status,ier)
-! copy buffer in 2D array for each slice
+ ! copy buffer in 2D array for each slice
buffer_all_cube_from_slices(imsg,:,:) = buffer_slices(:,:)
enddo
endif
-! send info to central cube from all the slices except those in CHUNK_AB & CHUNK_AB_ANTIPODE
+ ! send info to central cube from all the slices except those in CHUNK_AB & CHUNK_AB_ANTIPODE
if(ichunk /= CHUNK_AB .and. ichunk /= CHUNK_AB_ANTIPODE ) then
-! for bottom elements in contact with central cube from the slices side
+ ! for bottom elements in contact with central cube from the slices side
ipoin = 0
do ispec2D = 1,NSPEC2D_BOTTOM_INNER_CORE
ispec = ibelm_bottom_inner_core(ispec2D)
-! only for DOFs exactly on surface of central cube (bottom of these elements)
+ ! only for DOFs exactly on surface of central cube (bottom of these elements)
k = 1
do j = 1,NGLLY
do i = 1,NGLLX
@@ -264,15 +307,24 @@
enddo
enddo
-! send buffer to central cube
+ ! send buffer to central cube
receiver = receiver_cube_from_slices
call MPI_SEND(buffer_slices,NDIM*npoin2D_cube_from_slices, &
MPI_DOUBLE_PRECISION,receiver,itag,MPI_COMM_WORLD,ier)
- endif ! end sending info to central cube
+ ! daniel: in case NPROC_XI == 1, the other chunks exchange all bottom points with
+ ! CHUNK_AB **and** CHUNK_AB_ANTIPODE
+ if(NPROC_XI==1) then
+ call MPI_SEND(buffer_slices,NDIM*npoin2D_cube_from_slices, &
+ MPI_DOUBLE_PRECISION, &
+ addressing(CHUNK_AB_ANTIPODE,0,iproc_eta), &
+ itag,MPI_COMM_WORLD,ier)
+ endif
+ endif ! end sending info to central cube
-! exchange of their bottom faces between chunks AB and AB_ANTIPODE
+
+ ! exchange of their bottom faces between chunks AB and AB_ANTIPODE
if(ichunk == CHUNK_AB .or. ichunk == CHUNK_AB_ANTIPODE) then
ipoin = 0
do ispec = NSPEC_INNER_CORE, 1, -1
@@ -289,7 +341,10 @@
enddo
endif
enddo
- if (ipoin /= npoin2D_cube_from_slices) call exit_MPI(myrank,'wrong number of points found for bottom CC AB or !AB')
+ if (ipoin /= npoin2D_cube_from_slices) then
+ print*,'error',myrank,'bottom points:',npoin2D_cube_from_slices,ipoin
+ call exit_MPI(myrank,'wrong number of points found for bottom CC AB or !AB')
+ endif
sender = sender_from_slices_to_cube(nb_msgs_theor_in_cube)
@@ -301,173 +356,194 @@
endif
-!--- now we need to find the points received and create indirect addressing
+ !--- now we need to find the points received and create indirect addressing
+ ibool_central_cube(:,:) = -1
if(ichunk == CHUNK_AB .or. ichunk == CHUNK_AB_ANTIPODE) then
do imsg = 1,nb_msgs_theor_in_cube
- do ipoin = 1,npoin2D_cube_from_slices
+ do ipoin = 1,npoin2D_cube_from_slices
- x_target = buffer_all_cube_from_slices(imsg,ipoin,1)
- y_target = buffer_all_cube_from_slices(imsg,ipoin,2)
- z_target = buffer_all_cube_from_slices(imsg,ipoin,3)
+ x_target = buffer_all_cube_from_slices(imsg,ipoin,1)
+ y_target = buffer_all_cube_from_slices(imsg,ipoin,2)
+ z_target = buffer_all_cube_from_slices(imsg,ipoin,3)
-! x = x_min
- do ispec2D = 1,nspec2D_xmin_inner_core
+ ! x = x_min
+ do ispec2D = 1,nspec2D_xmin_inner_core
+ ispec = ibelm_xmin_inner_core(ispec2D)
+ ! do not loop on elements outside of the central cube
+ if(idoubling_inner_core(ispec) /= IFLAG_MIDDLE_CENTRAL_CUBE .and. &
+ idoubling_inner_core(ispec) /= IFLAG_BOTTOM_CENTRAL_CUBE .and. &
+ idoubling_inner_core(ispec) /= IFLAG_TOP_CENTRAL_CUBE) cycle
+ !daniel: debug
+ if(idoubling_inner_core(ispec) == IFLAG_IN_FICTITIOUS_CUBE ) stop 'error xmin ibelm'
+ i = 1
+ do k = 1,NGLLZ
+ do j = 1,NGLLY
+ iglob = ibool_inner_core(i,j,k,ispec)
+ x_current = dble(xstore_inner_core(iglob))
+ y_current = dble(ystore_inner_core(iglob))
+ z_current = dble(zstore_inner_core(iglob))
+ ! look for matching point
+ if(dsqrt((x_current-x_target)**2 + (y_current-y_target)**2 + (z_current-z_target)**2) < SMALLVALTOL) then
+ ibool_central_cube(imsg,ipoin) = ibool_inner_core(i,j,k,ispec)
+ goto 100
+ endif
+ enddo
+ enddo
+ enddo
- ispec = ibelm_xmin_inner_core(ispec2D)
+ ! x = x_max
+ do ispec2D = 1,nspec2D_xmax_inner_core
+ ispec = ibelm_xmax_inner_core(ispec2D)
+ ! do not loop on elements outside of the central cube
+ if(idoubling_inner_core(ispec) /= IFLAG_MIDDLE_CENTRAL_CUBE .and. &
+ idoubling_inner_core(ispec) /= IFLAG_BOTTOM_CENTRAL_CUBE .and. &
+ idoubling_inner_core(ispec) /= IFLAG_TOP_CENTRAL_CUBE) cycle
+ !daniel: debug
+ if(idoubling_inner_core(ispec) == IFLAG_IN_FICTITIOUS_CUBE ) stop 'error xmax ibelm'
+ i = NGLLX
+ do k = 1,NGLLZ
+ do j = 1,NGLLY
+ iglob = ibool_inner_core(i,j,k,ispec)
+ x_current = dble(xstore_inner_core(iglob))
+ y_current = dble(ystore_inner_core(iglob))
+ z_current = dble(zstore_inner_core(iglob))
+ ! look for matching point
+ if(dsqrt((x_current-x_target)**2 + (y_current-y_target)**2 + (z_current-z_target)**2) < SMALLVALTOL) then
+ ibool_central_cube(imsg,ipoin) = ibool_inner_core(i,j,k,ispec)
+ goto 100
+ endif
+ enddo
+ enddo
+ enddo
-! do not loop on elements outside of the central cube
- if(idoubling_inner_core(ispec) /= IFLAG_MIDDLE_CENTRAL_CUBE .and. &
- idoubling_inner_core(ispec) /= IFLAG_BOTTOM_CENTRAL_CUBE .and. &
- idoubling_inner_core(ispec) /= IFLAG_TOP_CENTRAL_CUBE) cycle
+ ! y = y_min
+ do ispec2D = 1,nspec2D_ymin_inner_core
+ ispec = ibelm_ymin_inner_core(ispec2D)
+ ! do not loop on elements outside of the central cube
+ if(idoubling_inner_core(ispec) /= IFLAG_MIDDLE_CENTRAL_CUBE .and. &
+ idoubling_inner_core(ispec) /= IFLAG_BOTTOM_CENTRAL_CUBE .and. &
+ idoubling_inner_core(ispec) /= IFLAG_TOP_CENTRAL_CUBE) cycle
+ !daniel: debug
+ if(idoubling_inner_core(ispec) == IFLAG_IN_FICTITIOUS_CUBE ) stop 'error ymin ibelm'
+ j = 1
+ do k = 1,NGLLZ
+ do i = 1,NGLLX
+ iglob = ibool_inner_core(i,j,k,ispec)
+ x_current = dble(xstore_inner_core(iglob))
+ y_current = dble(ystore_inner_core(iglob))
+ z_current = dble(zstore_inner_core(iglob))
+ ! look for matching point
+ if(dsqrt((x_current-x_target)**2 + (y_current-y_target)**2 + (z_current-z_target)**2) < SMALLVALTOL) then
+ ibool_central_cube(imsg,ipoin) = ibool_inner_core(i,j,k,ispec)
+ goto 100
+ endif
+ enddo
+ enddo
+ enddo
- i = 1
- do k = 1,NGLLZ
- do j = 1,NGLLY
+ ! y = y_max
+ do ispec2D = 1,nspec2D_ymax_inner_core
+ ispec = ibelm_ymax_inner_core(ispec2D)
+ ! do not loop on elements outside of the central cube
+ if(idoubling_inner_core(ispec) /= IFLAG_MIDDLE_CENTRAL_CUBE .and. &
+ idoubling_inner_core(ispec) /= IFLAG_BOTTOM_CENTRAL_CUBE .and. &
+ idoubling_inner_core(ispec) /= IFLAG_TOP_CENTRAL_CUBE) cycle
+ !daniel: debug
+ if(idoubling_inner_core(ispec) == IFLAG_IN_FICTITIOUS_CUBE ) stop 'error ymax ibelm'
+ j = NGLLY
+ do k = 1,NGLLZ
+ do i = 1,NGLLX
+ iglob = ibool_inner_core(i,j,k,ispec)
+ x_current = dble(xstore_inner_core(iglob))
+ y_current = dble(ystore_inner_core(iglob))
+ z_current = dble(zstore_inner_core(iglob))
+ ! look for matching point
+ if(dsqrt((x_current-x_target)**2 + (y_current-y_target)**2 + (z_current-z_target)**2) < SMALLVALTOL) then
+ ibool_central_cube(imsg,ipoin) = ibool_inner_core(i,j,k,ispec)
+ goto 100
+ endif
+ enddo
+ enddo
+ enddo
- iglob = ibool_inner_core(i,j,k,ispec)
- x_current = dble(xstore_inner_core(iglob))
- y_current = dble(ystore_inner_core(iglob))
- z_current = dble(zstore_inner_core(iglob))
+ ! bottom of cube
+ do ispec = 1,NSPEC_INNER_CORE
+ ! loop on elements at the bottom of the cube only
+ if(idoubling_inner_core(ispec) /= IFLAG_BOTTOM_CENTRAL_CUBE) cycle
+ k = 1
+ do j = 1,NGLLY
+ do i = 1,NGLLX
+ iglob = ibool_inner_core(i,j,k,ispec)
+ x_current = dble(xstore_inner_core(iglob))
+ y_current = dble(ystore_inner_core(iglob))
+ z_current = dble(zstore_inner_core(iglob))
+ ! look for matching point
+ if(dsqrt((x_current-x_target)**2 + (y_current-y_target)**2 + (z_current-z_target)**2) < SMALLVALTOL) then
+ ibool_central_cube(imsg,ipoin) = ibool_inner_core(i,j,k,ispec)
+ goto 100
+ endif
+ enddo
+ enddo
+ enddo
-! look for matching point
- if(dsqrt((x_current-x_target)**2 + (y_current-y_target)**2 + (z_current-z_target)**2) < SMALLVALTOL) then
- ibool_central_cube(imsg,ipoin) = ibool_inner_core(i,j,k,ispec)
- goto 100
- endif
+ ! point not found so far
+ if(NPROC_XI==1) then
+ ! ignores point
+ ibool_central_cube(imsg,ipoin) = 0
+ else
+ ! check that a matching point is found in all cases
+ call exit_MPI(myrank,'point never found in central cube')
+ endif
- enddo
- enddo
+ 100 continue
- enddo
+ enddo ! ipoin
-! x = x_max
- do ispec2D = 1,nspec2D_xmax_inner_core
+ ! daniel: check ibool array
+ if(NPROC_XI==1) then
+ if( minval(ibool_central_cube(imsg,:)) < 0 ) call exit_mpi(myrank,'error ibool_central_cube point not found')
- ispec = ibelm_xmax_inner_core(ispec2D)
+ ! removes points on bottom surface in antipode chunk for other chunks than its AB sharing chunk
+ ! (to avoid adding the same point twice from other chunks)
+ if( ichunk == CHUNK_AB_ANTIPODE .and. imsg < nb_msgs_theor_in_cube ) then
+ do ipoin = 1,npoin2D_cube_from_slices
+ x_target = buffer_all_cube_from_slices(imsg,ipoin,1)
+ y_target = buffer_all_cube_from_slices(imsg,ipoin,2)
+ z_target = buffer_all_cube_from_slices(imsg,ipoin,3)
-! do not loop on elements outside of the central cube
- if(idoubling_inner_core(ispec) /= IFLAG_MIDDLE_CENTRAL_CUBE .and. &
- idoubling_inner_core(ispec) /= IFLAG_BOTTOM_CENTRAL_CUBE .and. &
- idoubling_inner_core(ispec) /= IFLAG_TOP_CENTRAL_CUBE) cycle
+ ! bottom of cube
+ do ispec = 1,NSPEC_INNER_CORE
+ ! loop on elements at the bottom of the cube only
+ if(idoubling_inner_core(ispec) /= IFLAG_BOTTOM_CENTRAL_CUBE) cycle
+ k = 1
+ do j = 1,NGLLY
+ do i = 1,NGLLX
+ iglob = ibool_inner_core(i,j,k,ispec)
+ x_current = dble(xstore_inner_core(iglob))
+ y_current = dble(ystore_inner_core(iglob))
+ z_current = dble(zstore_inner_core(iglob))
+ ! look for matching point
+ if(dsqrt((x_current-x_target)**2 + (y_current-y_target)**2 + (z_current-z_target)**2) < SMALLVALTOL) then
+ ibool_central_cube(imsg,ipoin) = 0
+ goto 200
+ endif
+ enddo
+ enddo
+ enddo
- i = NGLLX
- do k = 1,NGLLZ
- do j = 1,NGLLY
+ 200 continue
- iglob = ibool_inner_core(i,j,k,ispec)
- x_current = dble(xstore_inner_core(iglob))
- y_current = dble(ystore_inner_core(iglob))
- z_current = dble(zstore_inner_core(iglob))
+ enddo ! ipoin
+ endif
-! look for matching point
- if(dsqrt((x_current-x_target)**2 + (y_current-y_target)**2 + (z_current-z_target)**2) < SMALLVALTOL) then
- ibool_central_cube(imsg,ipoin) = ibool_inner_core(i,j,k,ispec)
- goto 100
- endif
+ endif ! NPROC_XI==1
- enddo
- enddo
+ enddo ! imsg
+ endif
- enddo
-
-! y = y_min
- do ispec2D = 1,nspec2D_ymin_inner_core
-
- ispec = ibelm_ymin_inner_core(ispec2D)
-
-! do not loop on elements outside of the central cube
- if(idoubling_inner_core(ispec) /= IFLAG_MIDDLE_CENTRAL_CUBE .and. &
- idoubling_inner_core(ispec) /= IFLAG_BOTTOM_CENTRAL_CUBE .and. &
- idoubling_inner_core(ispec) /= IFLAG_TOP_CENTRAL_CUBE) cycle
-
- j = 1
- do k = 1,NGLLZ
- do i = 1,NGLLX
-
- iglob = ibool_inner_core(i,j,k,ispec)
- x_current = dble(xstore_inner_core(iglob))
- y_current = dble(ystore_inner_core(iglob))
- z_current = dble(zstore_inner_core(iglob))
-
-! look for matching point
- if(dsqrt((x_current-x_target)**2 + (y_current-y_target)**2 + (z_current-z_target)**2) < SMALLVALTOL) then
- ibool_central_cube(imsg,ipoin) = ibool_inner_core(i,j,k,ispec)
- goto 100
- endif
-
- enddo
- enddo
-
- enddo
-
-! y = y_max
- do ispec2D = 1,nspec2D_ymax_inner_core
-
- ispec = ibelm_ymax_inner_core(ispec2D)
-
-! do not loop on elements outside of the central cube
- if(idoubling_inner_core(ispec) /= IFLAG_MIDDLE_CENTRAL_CUBE .and. &
- idoubling_inner_core(ispec) /= IFLAG_BOTTOM_CENTRAL_CUBE .and. &
- idoubling_inner_core(ispec) /= IFLAG_TOP_CENTRAL_CUBE) cycle
-
- j = NGLLY
- do k = 1,NGLLZ
- do i = 1,NGLLX
-
- iglob = ibool_inner_core(i,j,k,ispec)
- x_current = dble(xstore_inner_core(iglob))
- y_current = dble(ystore_inner_core(iglob))
- z_current = dble(zstore_inner_core(iglob))
-
-! look for matching point
- if(dsqrt((x_current-x_target)**2 + (y_current-y_target)**2 + (z_current-z_target)**2) < SMALLVALTOL) then
- ibool_central_cube(imsg,ipoin) = ibool_inner_core(i,j,k,ispec)
- goto 100
- endif
-
- enddo
- enddo
-
- enddo
-
-! bottom of cube
- do ispec = 1,NSPEC_INNER_CORE
-
-! loop on elements at the bottom of the cube only
- if(idoubling_inner_core(ispec) /= IFLAG_BOTTOM_CENTRAL_CUBE) cycle
-
- k = 1
- do j = 1,NGLLY
- do i = 1,NGLLX
-
- iglob = ibool_inner_core(i,j,k,ispec)
- x_current = dble(xstore_inner_core(iglob))
- y_current = dble(ystore_inner_core(iglob))
- z_current = dble(zstore_inner_core(iglob))
-
-! look for matching point
- if(dsqrt((x_current-x_target)**2 + (y_current-y_target)**2 + (z_current-z_target)**2) < SMALLVALTOL) then
- ibool_central_cube(imsg,ipoin) = ibool_inner_core(i,j,k,ispec)
- goto 100
- endif
-
- enddo
- enddo
-
- enddo
-
-! check that a matching point is found in all cases
- call exit_MPI(myrank,'point never found in central cube')
-
- 100 continue
-
- enddo
- enddo
- endif
-
end subroutine create_central_cube_buffers
!
@@ -488,53 +564,64 @@
integer, intent(out) :: nb_msgs_theor_in_cube,npoin2D_cube_from_slices
+!daniel: debug
+ integer :: nproc_xi_half_floor,nproc_xi_half_ceil
+
+ if( mod(NPROC_XI,2) /= 0 ) then
+ nproc_xi_half_floor = floor(NPROC_XI/2.d0)
+ nproc_xi_half_ceil = ceiling(NPROC_XI/2.d0)
+ else
+ nproc_xi_half_floor = NPROC_XI/2
+ nproc_xi_half_ceil = NPROC_XI/2
+ endif
+
! only for slices in central cube
if(ichunk == CHUNK_AB) then
if(NPROC_XI == 1) then
-! five sides if only one processor in cube
+ ! five sides if only one processor in cube
nb_msgs_theor_in_cube = 5
else
-! case of a corner
+ ! case of a corner
if((iproc_xi == 0 .or. iproc_xi == NPROC_XI-1).and. &
(iproc_eta == 0 .or. iproc_eta == NPROC_ETA-1)) then
-! slices on both "vertical" faces plus one slice at the bottom
- nb_msgs_theor_in_cube = 2*(ceiling(NPROC_XI/2.d0)) + 1
-! case of an edge
+ ! slices on both "vertical" faces plus one slice at the bottom
+ nb_msgs_theor_in_cube = 2*(nproc_xi_half_ceil) + 1
+ ! case of an edge
else if(iproc_xi == 0 .or. iproc_xi == NPROC_XI-1 .or. &
iproc_eta == 0 .or. iproc_eta == NPROC_ETA-1) then
-! slices on the "vertical" face plus one slice at the bottom
- nb_msgs_theor_in_cube = ceiling(NPROC_XI/2.d0) + 1
+ ! slices on the "vertical" face plus one slice at the bottom
+ nb_msgs_theor_in_cube = nproc_xi_half_ceil + 1
else
-! bottom element only
+ ! bottom element only
nb_msgs_theor_in_cube = 1
endif
endif
else if(ichunk == CHUNK_AB_ANTIPODE) then
if(NPROC_XI == 1) then
-! five sides if only one processor in cube
+ ! five sides if only one processor in cube
nb_msgs_theor_in_cube = 5
else
-! case of a corner
+ ! case of a corner
if((iproc_xi == 0 .or. iproc_xi == NPROC_XI-1).and. &
(iproc_eta == 0 .or. iproc_eta == NPROC_ETA-1)) then
-! slices on both "vertical" faces plus one slice at the bottom
- nb_msgs_theor_in_cube = 2*(floor(NPROC_XI/2.d0)) + 1
-! case of an edge
+ ! slices on both "vertical" faces plus one slice at the bottom
+ nb_msgs_theor_in_cube = 2*(nproc_xi_half_floor) + 1
+ ! case of an edge
else if(iproc_xi == 0 .or. iproc_xi == NPROC_XI-1 .or. &
iproc_eta == 0 .or. iproc_eta == NPROC_ETA-1) then
-! slices on the "vertical" face plus one slice at the bottom
- nb_msgs_theor_in_cube = floor(NPROC_XI/2.d0) + 1
+ ! slices on the "vertical" face plus one slice at the bottom
+ nb_msgs_theor_in_cube = nproc_xi_half_floor + 1
else
-! bottom element only
+ ! bottom element only
nb_msgs_theor_in_cube = 1
endif
endif
else
-! not in chunk AB
+ ! not in chunk AB
nb_msgs_theor_in_cube = 0
endif
-! number of points to send or receive (bottom of slices)
+ ! number of points to send or receive (bottom of slices)
npoin2D_cube_from_slices = NSPEC2D_BOTTOM_INNER_CORE * NGLLX * NGLLY
end subroutine comp_central_cube_buffer_size
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/fix_non_blocking_flags.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/fix_non_blocking_flags.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/fix_non_blocking_flags.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -103,13 +103,15 @@
subroutine fix_non_blocking_central_cube(is_on_a_slice_edge, &
ibool,nspec,nglob,nb_msgs_theor_in_cube,ibelm_bottom_inner_core, &
idoubling_inner_core,npoin2D_cube_from_slices, &
- ibool_central_cube,NSPEC2D_BOTTOM_INNER_CORE,ichunk)
+ ibool_central_cube,NSPEC2D_BOTTOM_INNER_CORE, &
+ ichunk,NPROC_XI)
implicit none
include "constants.h"
- integer :: nspec,nglob,nb_msgs_theor_in_cube,NSPEC2D_BOTTOM_INNER_CORE,ichunk,npoin2D_cube_from_slices
+ integer :: nspec,nglob,nb_msgs_theor_in_cube,NSPEC2D_BOTTOM_INNER_CORE
+ integer :: ichunk,npoin2D_cube_from_slices,NPROC_XI
logical, dimension(nspec) :: is_on_a_slice_edge
@@ -150,7 +152,13 @@
do imsg = 1,nb_msgs_theor_in_cube
do ipoin = 1,npoin2D_cube_from_slices
- mask_ibool(ibool_central_cube(imsg,ipoin)) = .true.
+ if(NPROC_XI==1) then
+ if(ibool_central_cube(imsg,ipoin) > 0 ) then
+ mask_ibool(ibool_central_cube(imsg,ipoin)) = .true.
+ endif
+ else
+ mask_ibool(ibool_central_cube(imsg,ipoin)) = .true.
+ endif
enddo
enddo
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/get_event_info.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/get_event_info.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/get_event_info.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -33,9 +33,6 @@
! Also, t_shift is added as a new parameter to be written on sac headers!
! by Ebru Bozdag
- !subroutine get_event_info_parallel(myrank,yr,jda,ho,mi,sec,tshift_cmt, &
- ! elat,elon,depth,mb,ename,cmt_lat,cmt_lon,cmt_depth,cmt_hdur,NSOURCES)
-
subroutine get_event_info_parallel(myrank,yr,jda,ho,mi,sec,&
event_name,tshift_cmt,t_shift, &
elat,elon,depth,mb,cmt_lat, &
@@ -78,9 +75,6 @@
elat,elon,depth,mb, &
cmt_lat,cmt_lon,cmt_depth,cmt_hdur,NSOURCES)
- !call get_event_info_serial(yr,jda,ho,mi,sec,tshift_cmt,elat,elon,depth,mb,region, &
- ! cmt_lat,cmt_lon,cmt_depth,cmt_hdur,NSOURCES,LENGTH_REGION_NAME)
-
! create the event name
!write(ename(1:12),'(a12)') region(1:12)
@@ -133,10 +127,6 @@
elat_pde,elon_pde,depth_pde,mb,&
cmt_lat,cmt_lon,cmt_depth,cmt_hdur,NSOURCES)
-
- !subroutine get_event_info_serial(yr,jda,ho,mi,sec,tshift_cmt,elat,elon,depth,mb,region,&
- ! cmt_lat,cmt_lon,cmt_depth,cmt_hdur,NSOURCES,LENGTH_REGION_NAME)
-
implicit none
include "constants.h"
@@ -169,7 +159,6 @@
character(len=5) datasource
character(len=150) string,CMTSOLUTION
- !character(len=150) string,dummystring,CMTSOLUTION
!
@@ -180,18 +169,6 @@
open(unit=821,file=CMTSOLUTION,iostat=ios,status='old',action='read')
if(ios /= 0) stop 'error opening CMTSOLUTION file (in get_event_info_serial)'
- !icounter = 0
- !do while(ios == 0)
- ! read(821,"(a)",iostat=ios) dummystring
- ! if(ios == 0) icounter = icounter + 1
- !enddo
- !close(821)
- !if(mod(icounter,NLINES_PER_CMTSOLUTION_SOURCE) /= 0) &
- ! stop 'total number of lines in CMTSOLUTION file should be a multiple of NLINES_PER_CMTSOLUTION_SOURCE'
- !NSOURCES = icounter / NLINES_PER_CMTSOLUTION_SOURCE
- !if(NSOURCES < 1) stop 'need at least one source in CMTSOLUTION file'
- !open(unit=821,file=CMTSOLUTION,status='old',action='read')
-
! example header line of CMTSOLUTION file
!PDE 2003 09 25 19 50 08.93 41.78 144.08 18.0 7.9 8.0 Hokkaido, Japan
! which is: event_id, date,origin time,latitude,longitude,depth, mb, MS, region
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/iterate_time.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/iterate_time.F90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/iterate_time.F90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -110,9 +110,10 @@
endif
! outputs movie files
- if( MOVIE_SURFACE .or. MOVIE_VOLUME ) then
+!daniel: debug
+! if( MOVIE_SURFACE .or. MOVIE_VOLUME ) then
call write_movie_output()
- endif
+! endif
! first step of noise tomography, i.e., save a surface movie at every time step
! modified from the subroutine 'write_movie_surface'
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/locate_receivers.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/locate_receivers.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/locate_receivers.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -29,50 +29,43 @@
!---- locate_receivers finds the correct position of the receivers
!----
- subroutine locate_receivers(myrank,DT,NSTEP,nspec,nglob,ibool, &
- xstore,ystore,zstore,xigll,yigll,zigll,rec_filename, &
- nrec,islice_selected_rec,ispec_selected_rec, &
- xi_receiver,eta_receiver,gamma_receiver,station_name,network_name, &
- stlat,stlon,stele,stbur,nu, &
- yr,jda,ho,mi,sec,&
- ELLIPTICITY,TOPOGRAPHY, &
- theta_source,phi_source,rspl,espl,espl2,nspl, &
- ibathy_topo,RECEIVERS_CAN_BE_BURIED,NCHUNKS)
+ subroutine locate_receivers(nspec,nglob,ibool, &
+ xstore,ystore,zstore, &
+ yr,jda,ho,mi,sec, &
+ theta_source,phi_source,NCHUNKS,ELLIPTICITY)
use constants
+ use specfem_par,only: &
+ myrank,DT,NSTEP, &
+ xigll,yigll,zigll, &
+ rec_filename,nrec,islice_selected_rec,ispec_selected_rec, &
+ xi_receiver,eta_receiver,gamma_receiver,station_name,network_name, &
+ stlat,stlon,stele,stbur,nu, &
+ rspl,espl,espl2,nspl,ibathy_topo, &
+ TOPOGRAPHY,RECEIVERS_CAN_BE_BURIED
+
implicit none
! standard include of the MPI library
include 'mpif.h'
include "precision.h"
- integer NCHUNKS
+ integer nspec,nglob
- logical ELLIPTICITY,TOPOGRAPHY,RECEIVERS_CAN_BE_BURIED
+ integer ibool(NGLLX,NGLLY,NGLLZ,nspec)
- integer nspl
- double precision rspl(NR),espl(NR),espl2(NR)
+ ! arrays containing coordinates of the points
+ real(kind=CUSTOM_REAL), dimension(nglob) :: xstore,ystore,zstore
- integer nspec,nglob,nrec,myrank,nrec_found
-
integer yr,jda,ho,mi
double precision sec
+ double precision theta_source,phi_source
- integer ibool(NGLLX,NGLLY,NGLLZ,nspec)
- integer NSTEP
- double precision DT
+ integer NCHUNKS
+ logical ELLIPTICITY
-! arrays containing coordinates of the points
- real(kind=CUSTOM_REAL), dimension(nglob) :: xstore,ystore,zstore
-
-! Gauss-Lobatto-Legendre points of integration
- double precision xigll(NGLLX),yigll(NGLLY),zigll(NGLLZ)
-
- character(len=*) rec_filename
-
-! use integer array to store values
- integer, dimension(NX_BATHY,NY_BATHY) :: ibathy_topo
-
+ ! local parameters
+ integer :: nrec_found
integer, allocatable, dimension(:) :: ix_initial_guess,iy_initial_guess,iz_initial_guess
integer iorientation
@@ -95,7 +88,6 @@
double precision sint,cost,sinp,cosp
double precision r0,p20
double precision theta,phi
- double precision theta_source,phi_source
double precision dist
double precision xi,eta,gamma,dx,dy,dz,dxi,deta,dgamma
@@ -126,11 +118,6 @@
! timing information for the stations
! station information for writing the seismograms
integer nsamp
- integer, dimension(nrec) :: islice_selected_rec,ispec_selected_rec
- double precision, dimension(nrec) :: xi_receiver,eta_receiver,gamma_receiver
- double precision, dimension(3,3,nrec) :: nu
- character(len=MAX_LENGTH_STATION_NAME), dimension(nrec) :: station_name
- character(len=MAX_LENGTH_NETWORK_NAME), dimension(nrec) :: network_name
integer, dimension(nrec) :: islice_selected_rec_found,ispec_selected_rec_found
double precision, dimension(nrec) :: xi_receiver_found,eta_receiver_found,gamma_receiver_found
@@ -141,7 +128,6 @@
character(len=150) STATIONS
integer, allocatable, dimension(:,:) :: ispec_selected_rec_all
- double precision, dimension(nrec) :: stlat,stlon,stele,stbur
double precision, allocatable, dimension(:,:) :: xi_receiver_all,eta_receiver_all,gamma_receiver_all
double precision typical_size
@@ -206,7 +192,7 @@
! read that STATIONS file on the master
if(myrank == 0) then
- call get_value_string(STATIONS, 'solver.STATIONS', rec_filename)
+ call get_value_string(STATIONS, 'solver.STATIONS', trim(rec_filename))
open(unit=1,file=STATIONS,status='old',action='read',iostat=ier)
if( ier /= 0 ) call exit_MPI(myrank,'error opening STATIONS file')
@@ -396,58 +382,44 @@
! therefore only the station name is included below
! compute total number of samples for normal modes with 1 sample per second
open(unit=1,file=trim(OUTPUT_FILES)//'/RECORDHEADERS',status='unknown')
+
nsamp = nint(dble(NSTEP-1)*DT)
+
do irec = 1,nrec
if(stele(irec) >= -999.9999) then
-! write(1,"(a8,1x,a3,6x,f8.4,1x,f9.4,1x,f6.1,1x,f6.1,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4,1x,i3,1x,i2,1x,i2,1x,f6.3)") &
-! station_name(irec),'LHN',stlat(irec),stlon(irec),stele(irec),stbur(irec), &
-! 0.,0.,1.,nsamp,yr,jda,ho,mi,sec
-! write(1,"(a8,1x,a3,6x,f8.4,1x,f9.4,1x,f6.1,1x,f6.1,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4,1x,i3,1x,i2,1x,i2,1x,f6.3)") &
-! station_name(irec),'LHE',stlat(irec),stlon(irec),stele(irec),stbur(irec), &
-! 90.,0.,1.,nsamp,yr,jda,ho,mi,sec
-! write(1,"(a8,1x,a3,6x,f8.4,1x,f9.4,1x,f6.1,1x,f6.1,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4,1x,i3,1x,i2,1x,i2,1x,f6.3)") &
-! station_name(irec),'LHZ',stlat(irec),stlon(irec),stele(irec),stbur(irec), &
-! 0.,-90.,1.,nsamp,yr,jda,ho,mi,sec
- write(1,"(a8,1x,a3,6x,f8.4,1x,f9.4,1x,f6.1,1x,f6.1,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4,1x,i3,1x,i2,1x,i2,1x,f6.3)") &
- station_name(irec),bic(1:2)//'N',stlat(irec),stlon(irec),stele(irec),stbur(irec), &
- 0.,0.,1.,nsamp,yr,jda,ho,mi,sec
- write(1,"(a8,1x,a3,6x,f8.4,1x,f9.4,1x,f6.1,1x,f6.1,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4,1x,i3,1x,i2,1x,i2,1x,f6.3)") &
- station_name(irec),bic(1:2)//'E',stlat(irec),stlon(irec),stele(irec),stbur(irec), &
- 90.,0.,1.,nsamp,yr,jda,ho,mi,sec
- write(1,"(a8,1x,a3,6x,f8.4,1x,f9.4,1x,f6.1,1x,f6.1,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4,1x,i3,1x,i2,1x,i2,1x,f6.3)") &
- station_name(irec),bic(1:2)//'Z',stlat(irec),stlon(irec),stele(irec),stbur(irec), &
- 0.,-90.,1.,nsamp,yr,jda,ho,mi,sec
-
+ write(1,500) station_name(irec),bic(1:2)//'N', &
+ stlat(irec),stlon(irec),stele(irec),stbur(irec), &
+ 0.,0.,1.,nsamp,yr,jda,ho,mi,sec
+ write(1,500) station_name(irec),bic(1:2)//'E', &
+ stlat(irec),stlon(irec),stele(irec),stbur(irec), &
+ 90.,0.,1.,nsamp,yr,jda,ho,mi,sec
+ write(1,500) station_name(irec),bic(1:2)//'Z', &
+ stlat(irec),stlon(irec),stele(irec),stbur(irec), &
+ 0.,-90.,1.,nsamp,yr,jda,ho,mi,sec
else
! very deep ocean-bottom stations such as H2O are not compatible
! with the standard RECORDHEADERS format because of the f6.1 format
! therefore suppress decimals for depth in that case
-! write(1,"(a8,1x,a3,6x,f8.4,1x,f9.4,1x,i6,1x,f6.1,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4,1x,i3,1x,i2,1x,i2,1x,f6.3)") &
-! station_name(irec),'LHN',stlat(irec),stlon(irec),nint(stele(irec)),stbur(irec), &
-! 0.,0.,1.,nsamp,yr,jda,ho,mi,sec
-! write(1,"(a8,1x,a3,6x,f8.4,1x,f9.4,1x,i6,1x,f6.1,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4,1x,i3,1x,i2,1x,i2,1x,f6.3)") &
-! station_name(irec),'LHE',stlat(irec),stlon(irec),nint(stele(irec)),stbur(irec), &
-! 90.,0.,1.,nsamp,yr,jda,ho,mi,sec
-! write(1,"(a8,1x,a3,6x,f8.4,1x,f9.4,1x,i6,1x,f6.1,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4,1x,i3,1x,i2,1x,i2,1x,f6.3)") &
-! station_name(irec),'LHZ',stlat(irec),stlon(irec),nint(stele(irec)),stbur(irec), &
-! 0.,-90.,1.,nsamp,yr,jda,ho,mi,sec
- write(1,"(a8,1x,a3,6x,f8.4,1x,f9.4,1x,i6,1x,f6.1,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4,1x,i3,1x,i2,1x,i2,1x,f6.3)") &
- station_name(irec),bic(1:2)//'N',stlat(irec),stlon(irec),nint(stele(irec)),stbur(irec), &
- 0.,0.,1.,nsamp,yr,jda,ho,mi,sec
- write(1,"(a8,1x,a3,6x,f8.4,1x,f9.4,1x,i6,1x,f6.1,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4,1x,i3,1x,i2,1x,i2,1x,f6.3)") &
- station_name(irec),bic(1:2)//'E',stlat(irec),stlon(irec),nint(stele(irec)),stbur(irec), &
- 90.,0.,1.,nsamp,yr,jda,ho,mi,sec
- write(1,"(a8,1x,a3,6x,f8.4,1x,f9.4,1x,i6,1x,f6.1,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4,1x,i3,1x,i2,1x,i2,1x,f6.3)") &
- station_name(irec),bic(1:2)//'Z',stlat(irec),stlon(irec),nint(stele(irec)),stbur(irec), &
- 0.,-90.,1.,nsamp,yr,jda,ho,mi,sec
-
+ write(1,600) station_name(irec),bic(1:2)//'N', &
+ stlat(irec),stlon(irec),nint(stele(irec)),stbur(irec), &
+ 0.,0.,1.,nsamp,yr,jda,ho,mi,sec
+ write(1,600) station_name(irec),bic(1:2)//'E', &
+ stlat(irec),stlon(irec),nint(stele(irec)),stbur(irec), &
+ 90.,0.,1.,nsamp,yr,jda,ho,mi,sec
+ write(1,600) station_name(irec),bic(1:2)//'Z', &
+ stlat(irec),stlon(irec),nint(stele(irec)),stbur(irec), &
+ 0.,-90.,1.,nsamp,yr,jda,ho,mi,sec
endif
enddo
close(1)
endif
+500 format(a8,1x,a3,6x,f9.4,1x,f9.4,1x,f6.1,1x,f6.1,1x,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4.4,1x,i3.3,1x,i2.2,1x,i2.2,1x,f6.3)
+600 format(a8,1x,a3,6x,f9.4,1x,f9.4,1x,i6,1x,f6.1,f6.1,1x,f6.1,1x,f12.4,1x,i7,1x,i4.4,1x,i3.3,1x,i2.2,1x,i2.2,1x,f6.3)
+
+
! ****************************************
! find the best (xi,eta) for each receiver
! ****************************************
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/locate_sources.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/locate_sources.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/locate_sources.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -29,65 +29,38 @@
!---- locate_sources finds the correct position of the sources
!----
- subroutine locate_sources(NSOURCES,myrank,nspec,nglob,ibool,&
- xstore,ystore,zstore,xigll,yigll,zigll, &
- ELLIPTICITY,TOPOGRAPHY, &
- sec,tshift_cmt,min_tshift_cmt_original,yr,jda,ho,mi,theta_source,phi_source, &
- NSTEP,DT,hdur,Mxx,Myy,Mzz,Mxy,Mxz,Myz, &
- islice_selected_source,ispec_selected_source, &
- xi_source,eta_source,gamma_source, nu_source, &
- rspl,espl,espl2,nspl,ibathy_topo,PRINT_SOURCE_TIME_FUNCTION, &
- LOCAL_TMP_PATH,SIMULATION_TYPE)
+ subroutine locate_sources(nspec,nglob,ibool, &
+ xstore,ystore,zstore, &
+ ELLIPTICITY,min_tshift_cmt_original)
use constants
+ use specfem_par,only: &
+ NSOURCES,myrank, &
+ tshift_cmt,theta_source,phi_source, &
+ NSTEP,DT,hdur,Mxx,Myy,Mzz,Mxy,Mxz,Myz, &
+ rspl,espl,espl2,nspl,ibathy_topo, &
+ PRINT_SOURCE_TIME_FUNCTION,LOCAL_TMP_PATH,SIMULATION_TYPE,TOPOGRAPHY, &
+ xigll,yigll,zigll, &
+ xi_source,eta_source,gamma_source,nu_source, &
+ islice_selected_source,ispec_selected_source
+
implicit none
! standard include of the MPI library
include 'mpif.h'
include "precision.h"
- integer NSTEP,NSOURCES
-
- logical ELLIPTICITY,TOPOGRAPHY,PRINT_SOURCE_TIME_FUNCTION
-
- double precision DT
-
- integer nspec,nglob,myrank
-
+ integer nspec,nglob
integer ibool(NGLLX,NGLLY,NGLLZ,nspec)
! arrays containing coordinates of the points
real(kind=CUSTOM_REAL), dimension(nglob) :: xstore,ystore,zstore
- ! Gauss-Lobatto-Legendre points of integration
- double precision xigll(NGLLX),yigll(NGLLY),zigll(NGLLZ)
+ logical ELLIPTICITY
- ! moment-tensor source parameters
- double precision sec,min_tshift_cmt_original
- double precision tshift_cmt(NSOURCES)
- integer yr,jda,ho,mi
- double precision, dimension(NSOURCES) :: theta_source,phi_source
- double precision hdur(NSOURCES)
- double precision, dimension(NSOURCES) :: Mxx,Myy,Mzz,Mxy,Mxz,Myz
+ double precision min_tshift_cmt_original
- ! source locations
- integer ispec_selected_source(NSOURCES)
- integer islice_selected_source(NSOURCES)
-
- double precision, dimension(NSOURCES) :: xi_source,eta_source,gamma_source
- double precision nu_source(NDIM,NDIM,NSOURCES)
-
- ! for ellipticity
- integer nspl
- double precision rspl(NR),espl(NR),espl2(NR)
-
- ! use integer array to store values
- integer, dimension(NX_BATHY,NY_BATHY) :: ibathy_topo
-
- character(len=150) :: LOCAL_TMP_PATH
- integer :: SIMULATION_TYPE
-
-! local parameters
+ ! local parameters
integer isource
integer iprocloop
integer i,j,k,ispec,iglob
@@ -172,6 +145,10 @@
! mask source region (mask values are between 0 and 1, with 0 around sources)
real(kind=CUSTOM_REAL),dimension(:,:,:,:),allocatable :: mask_source
+ ! event time
+ integer :: yr,jda,ho,mi
+ double precision :: sec
+
! get MPI starting time for all sources
time_start = MPI_WTIME()
@@ -186,13 +163,6 @@
DT,NSOURCES,min_tshift_cmt_original)
! broadcast the information read on the master to the nodes
- call MPI_BCAST(yr,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(jda,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(ho,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(mi,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
-
- call MPI_BCAST(sec,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
-
call MPI_BCAST(tshift_cmt,NSOURCES,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
call MPI_BCAST(hdur,NSOURCES,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
call MPI_BCAST(lat,NSOURCES,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
@@ -517,7 +487,8 @@
do iter_loop = 1,NUM_ITER
! recompute jacobian for the new point
- call recompute_jacobian(xelm,yelm,zelm,xi,eta,gamma,x,y,z,xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz)
+ call recompute_jacobian(xelm,yelm,zelm,xi,eta,gamma,x,y,z, &
+ xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz)
! compute distance to target location
dx = - (x - x_target_source)
@@ -536,12 +507,15 @@
! impose that we stay in that element
! (useful if user gives a source outside the mesh for instance)
- if (xi > 1.d0) xi = 1.d0
- if (xi < -1.d0) xi = -1.d0
- if (eta > 1.d0) eta = 1.d0
- if (eta < -1.d0) eta = -1.d0
- if (gamma > 1.d0) gamma = 1.d0
- if (gamma < -1.d0) gamma = -1.d0
+ ! we can go slightly outside the [1,1] segment since with finite elements
+ ! the polynomial solution is defined everywhere
+ ! can be useful for convergence of iterative scheme with distorted elements
+ if (xi > 1.10d0) xi = 1.10d0
+ if (xi < -1.10d0) xi = -1.10d0
+ if (eta > 1.10d0) eta = 1.10d0
+ if (eta < -1.10d0) eta = -1.10d0
+ if (gamma > 1.10d0) gamma = 1.10d0
+ if (gamma < -1.10d0) gamma = -1.10d0
enddo
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/prepare_timerun.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/prepare_timerun.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/prepare_timerun.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -79,15 +79,23 @@
if(GPU_MODE) call prepare_timerun_GPU()
! user output
- call sync_all()
if( myrank == 0 ) then
! elapsed time since beginning of mesh generation
tCPU = MPI_WTIME() - time_start
write(IMAIN,*)
write(IMAIN,*) 'Elapsed time for preparing timerun in seconds = ',sngl(tCPU)
write(IMAIN,*)
+ write(IMAIN,*) 'time loop:'
+ write(IMAIN,*)
+ write(IMAIN,*) ' time step: ',sngl(DT),' s'
+ write(IMAIN,*) 'number of time steps: ',NSTEP
+ write(IMAIN,*) 'total simulated time: ',sngl(((NSTEP-1)*DT-t0)/60.d0),' minutes'
+ write(IMAIN,*) 'start time :',sngl(-t0),' seconds'
+ write(IMAIN,*)
endif
+ call sync_all()
+
end subroutine prepare_timerun
!
@@ -172,6 +180,11 @@
use specfem_par_outercore
implicit none
+ if(myrank == 0 ) then
+ write(IMAIN,*) "preparing mass matrices."
+ write(IMAIN,*)
+ endif
+
! mass matrices need to be assembled with MPI here once and for all
call prepare_timerun_rmass_assembly()
@@ -289,14 +302,15 @@
idoubling_inner_core, NSPEC_INNER_CORE, &
ibelm_bottom_inner_core, NSPEC2D_BOTTOM(IREGION_INNER_CORE), &
NGLOB_INNER_CORE, &
- rmass_inner_core,ndim_assemble)
+ rmass_inner_core,ndim_assemble, &
+ iproc_eta,addressing,NCHUNKS_VAL,NPROC_XI_VAL,NPROC_ETA_VAL)
! suppress fictitious mass matrix elements in central cube
! because the slices do not compute all their spectral elements in the cube
where(rmass_inner_core(:) <= 0.) rmass_inner_core = 1.
endif
- if(myrank == 0) write(IMAIN,*) 'end assembling MPI mass matrix'
+ call sync_all()
end subroutine prepare_timerun_rmass_assembly
@@ -366,6 +380,12 @@
! local parameters
integer :: ier
+ if(myrank == 0 ) then
+ write(IMAIN,*) "preparing movie surface."
+ write(IMAIN,*)
+ endif
+
+
if(MOVIE_COARSE .and. NOISE_TOMOGRAPHY ==0) then ! only output corners !for noise tomography, must NOT be coarse
nmovie_points = 2 * 2 * NSPEC2D_TOP(IREGION_CRUST_MANTLE)
if(NGLLX /= NGLLY) &
@@ -404,6 +424,8 @@
write(IMAIN,*) ' time steps every: ',NTSTEP_BETWEEN_FRAMES
endif
+ call sync_all()
+
end subroutine prepare_timerun_movie_surface
!
@@ -420,6 +442,12 @@
! local parameters
integer :: ier
+ if(myrank == 0 ) then
+ write(IMAIN,*) "preparing movie volume."
+ write(IMAIN,*)
+ endif
+
+
! the following has to be true for the the array dimensions of eps to match with those of xstore etc..
! note that epsilondev and eps_trace_over_3 don't have the same dimensions.. could cause trouble
if (NSPEC_CRUST_MANTLE_STR_OR_ATT /= NSPEC_CRUST_MANTLE) &
@@ -466,6 +494,8 @@
if( MOVIE_VOLUME_TYPE < 1 .or. MOVIE_VOLUME_TYPE > 6) &
call exit_MPI(myrank, 'MOVIE_VOLUME_TYPE has to be 1,2,3,4,5 or 6')
+ call sync_all()
+
end subroutine prepare_timerun_movie_volume
!
@@ -479,13 +509,9 @@
use specfem_par
implicit none
- if(myrank == 0) then
+ if(myrank == 0 ) then
+ write(IMAIN,*) "preparing constants."
write(IMAIN,*)
- write(IMAIN,*) ' time step: ',sngl(DT),' s'
- write(IMAIN,*) 'number of time steps: ',NSTEP
- write(IMAIN,*) 'total simulated time: ',sngl(((NSTEP-1)*DT-t0)/60.d0),' minutes'
- write(IMAIN,*) 'start time:',sngl(-t0),' seconds'
- write(IMAIN,*)
endif
! define constants for the time integration
@@ -548,6 +574,7 @@
if (SIMULATION_TYPE == 3) b_two_omega_earth = 0._CUSTOM_REAL
endif
+ call sync_all()
end subroutine prepare_timerun_constants
@@ -569,12 +596,19 @@
double precision :: rho,drhodr,vp,vs,Qkappa,Qmu
integer :: int_radius,idoubling,nspl_gravity
+ if(myrank == 0 ) then
+ write(IMAIN,*) "preparing gravity arrays."
+ write(IMAIN,*)
+ endif
+
+
! store g, rho and dg/dr=dg using normalized radius in lookup table every 100 m
! get density and velocity from PREM model using dummy doubling flag
! this assumes that the gravity perturbations are small and smooth
! and that we can neglect the 3D model and use PREM every 100 m in all cases
! this is probably a rather reasonable assumption
if(GRAVITY_VAL) then
+
call make_gravity(nspl_gravity,rspl_gravity,gspl,gspl2,ONE_CRUST)
do int_radius = 1,NRAD_GRAVITY
radius = dble(int_radius) / (R_EARTH_KM * 10.d0)
@@ -636,6 +670,8 @@
endif
+ call sync_all()
+
end subroutine prepare_timerun_gravity
@@ -654,20 +690,42 @@
implicit none
! local parameters
- double precision, dimension(ATT1,ATT2,ATT3,ATT4) :: omsb_crust_mantle_dble, factor_scale_crust_mantle_dble
- double precision, dimension(ATT1,ATT2,ATT3,ATT5) :: omsb_inner_core_dble, factor_scale_inner_core_dble
- double precision, dimension(N_SLS,ATT1,ATT2,ATT3,ATT4) :: factor_common_crust_mantle_dble
- double precision, dimension(N_SLS,ATT1,ATT2,ATT3,ATT5) :: factor_common_inner_core_dble
+ double precision, dimension(:,:,:,:), allocatable :: &
+ omsb_crust_mantle_dble, factor_scale_crust_mantle_dble
+ double precision, dimension(:,:,:,:), allocatable :: &
+ omsb_inner_core_dble, factor_scale_inner_core_dble
+ double precision, dimension(:,:,:,:,:), allocatable :: factor_common_crust_mantle_dble
+ double precision, dimension(:,:,:,:,:), allocatable :: factor_common_inner_core_dble
+
double precision, dimension(N_SLS) :: alphaval_dble, betaval_dble, gammaval_dble
double precision, dimension(N_SLS) :: tau_sigma_dble
+ double precision :: scale_factor,scale_factor_minus_one
- double precision :: scale_factor,scale_factor_minus_one
real(kind=CUSTOM_REAL) :: mul
- integer :: ispec,i,j,k
+ integer :: ispec,i,j,k,ier
character(len=150) :: prnamel
! get and store PREM attenuation model
+ if(myrank == 0 ) then
+ write(IMAIN,*) "preparing attenuation."
+ write(IMAIN,*)
+ endif
+ ! allocates temporary arrays
+ allocate(omsb_crust_mantle_dble(ATT1,ATT2,ATT3,ATT4), &
+ factor_scale_crust_mantle_dble(ATT1,ATT2,ATT3,ATT4),stat=ier)
+ if( ier /= 0 ) call exit_MPI(myrank,'error allocating omsb crust_mantle arrays')
+
+ allocate(omsb_inner_core_dble(ATT1,ATT2,ATT3,ATT5), &
+ factor_scale_inner_core_dble(ATT1,ATT2,ATT3,ATT5),stat=ier)
+ if( ier /= 0 ) call exit_MPI(myrank,'error allocating omsb inner_core arrays')
+
+ allocate(factor_common_crust_mantle_dble(N_SLS,ATT1,ATT2,ATT3,ATT4),stat=ier)
+ if( ier /= 0 ) call exit_MPI(myrank,'error allocating factor_common crust_mantle array')
+
+ allocate(factor_common_inner_core_dble(N_SLS,ATT1,ATT2,ATT3,ATT5),stat=ier)
+ if( ier /= 0 ) call exit_MPI(myrank,'error allocating factor_common inner_core array')
+
! CRUST_MANTLE ATTENUATION
call create_name_database(prnamel, myrank, IREGION_CRUST_MANTLE, LOCAL_PATH)
call get_attenuation_model_3D(myrank, prnamel, omsb_crust_mantle_dble, &
@@ -696,6 +754,11 @@
factor_common_inner_core = factor_common_inner_core_dble
endif
+ deallocate(omsb_crust_mantle_dble,factor_scale_crust_mantle_dble)
+ deallocate(omsb_inner_core_dble,factor_scale_inner_core_dble)
+ deallocate(factor_common_crust_mantle_dble)
+ deallocate(factor_common_inner_core_dble)
+
! if attenuation is on, shift PREM to right frequency
! rescale mu in PREM to average frequency for attenuation
! the formulas to implement the scaling can be found for instance in
@@ -742,8 +805,6 @@
muvstore_crust_mantle(i,j,k,ispec) = muvstore_crust_mantle(i,j,k,ispec) * scale_factor
! scales transverse isotropic values for mu_h
- !if(TRANSVERSE_ISOTROPY_VAL .and. (idoubling_crust_mantle(ispec) == IFLAG_220_80 &
- ! .or. idoubling_crust_mantle(ispec) == IFLAG_80_MOHO)) &
if( ispec_is_tiso_crust_mantle(ispec) ) then
muhstore_crust_mantle(i,j,k,ispec) = muhstore_crust_mantle(i,j,k,ispec) * scale_factor
endif
@@ -808,6 +869,8 @@
endif
endif
+ call sync_all()
+
end subroutine prepare_timerun_attenuation
!
@@ -828,6 +891,12 @@
! local parameters
integer :: ier
+ if(myrank == 0 ) then
+ write(IMAIN,*) "initializing wavefields."
+ write(IMAIN,*)
+ endif
+
+
! initialize arrays to zero
displ_crust_mantle(:,:) = 0._CUSTOM_REAL
veloc_crust_mantle(:,:) = 0._CUSTOM_REAL
@@ -977,6 +1046,8 @@
endif
endif
+ call sync_all()
+
end subroutine prepare_timerun_init_wavefield
@@ -995,8 +1066,12 @@
! NOISE TOMOGRAPHY
if ( NOISE_TOMOGRAPHY /= 0 ) then
- NSPEC_TOP = NSPEC2D_TOP(IREGION_CRUST_MANTLE)
+ if(myrank == 0 ) then
+ write(IMAIN,*) "preparing noise arrays."
+ write(IMAIN,*)
+ endif
+
allocate(noise_sourcearray(NDIM,NGLLX,NGLLY,NGLLZ,NSTEP), &
normal_x_noise(nmovie_points), &
normal_y_noise(nmovie_points), &
@@ -1016,6 +1091,8 @@
call check_parameters_noise()
+ call sync_all()
+
endif
end subroutine prepare_timerun_noise
@@ -1047,8 +1124,9 @@
! GPU_MODE now defined in Par_file
if(myrank == 0 ) then
+ write(IMAIN,*) "GPU_MODE Active."
write(IMAIN,*)
- write(IMAIN,*) "GPU_MODE Active. Preparing Fields and Constants on Device."
+ write(IMAIN,*) "preparing Fields and Constants on GPU Device."
write(IMAIN,*)
endif
@@ -1356,4 +1434,6 @@
write(IMAIN,*)
endif
+ call sync_all()
+
end subroutine prepare_timerun_GPU
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/read_arrays_buffers_solver.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/read_arrays_buffers_solver.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/read_arrays_buffers_solver.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -83,7 +83,10 @@
! read 2-D addressing for summation between slices along xi with MPI
! read iboolleft_xi of this slice
- open(unit=IIN,file=prname(1:len_trim(prname))//'iboolleft_xi.txt',status='old',action='read')
+ open(unit=IIN,file=prname(1:len_trim(prname))//'iboolleft_xi.txt', &
+ status='old',action='read',iostat=ier)
+ if( ier /= 0 ) call exit_MPI(myrank,'error opening iboolleft_xi file')
+
npoin2D_xi(1) = 1
350 continue
read(IIN,*) iboolleft_xi(npoin2D_xi(1)),xdummy,ydummy,zdummy
@@ -100,7 +103,10 @@
close(IIN)
! read iboolright_xi of this slice
- open(unit=IIN,file=prname(1:len_trim(prname))//'iboolright_xi.txt',status='old',action='read')
+ open(unit=IIN,file=prname(1:len_trim(prname))//'iboolright_xi.txt', &
+ status='old',action='read',iostat=ier)
+ if( ier /= 0 ) call exit_MPI(myrank,'error opening iboolright_xi file')
+
npoin2D_xi(2) = 1
360 continue
read(IIN,*) iboolright_xi(npoin2D_xi(2)),xdummy,ydummy,zdummy
@@ -129,7 +135,10 @@
! read 2-D addressing for summation between slices along eta with MPI
! read iboolleft_eta of this slice
- open(unit=IIN,file=prname(1:len_trim(prname))//'iboolleft_eta.txt',status='old',action='read')
+ open(unit=IIN,file=prname(1:len_trim(prname))//'iboolleft_eta.txt', &
+ status='old',action='read',iostat=ier)
+ if( ier /= 0 ) call exit_MPI(myrank,'error opening iboolleft_eta file')
+
npoin2D_eta(1) = 1
370 continue
read(IIN,*) iboolleft_eta(npoin2D_eta(1)),xdummy,ydummy,zdummy
@@ -146,7 +155,10 @@
close(IIN)
! read iboolright_eta of this slice
- open(unit=IIN,file=prname(1:len_trim(prname))//'iboolright_eta.txt',status='old',action='read')
+ open(unit=IIN,file=prname(1:len_trim(prname))//'iboolright_eta.txt', &
+ status='old',action='read',iostat=ier)
+ if( ier /= 0 ) call exit_MPI(myrank,'error opening iboolright_eta file')
+
npoin2D_eta(2) = 1
380 continue
read(IIN,*) iboolright_eta(npoin2D_eta(2)),xdummy,ydummy,zdummy
@@ -181,7 +193,10 @@
if(myrank == 0) then
! file with the list of processors for each message for faces
- open(unit=IIN,file=trim(OUTPUT_FILES)//'/list_messages_faces.txt',status='old',action='read')
+ open(unit=IIN,file=trim(OUTPUT_FILES)//'/list_messages_faces.txt', &
+ status='old',action='read',iostat=ier)
+ if( ier /= 0 ) call exit_MPI(myrank,'error opening list_messages_faces file')
+
do imsg = 1,NUMMSGS_FACES
read(IIN,*) imsg_type(imsg),iprocfrom_faces(imsg),iprocto_faces(imsg)
if (iprocfrom_faces(imsg) < 0 &
@@ -195,7 +210,10 @@
close(IIN)
! file with the list of processors for each message for corners
- open(unit=IIN,file=trim(OUTPUT_FILES)//'/list_messages_corners.txt',status='old',action='read')
+ open(unit=IIN,file=trim(OUTPUT_FILES)//'/list_messages_corners.txt', &
+ status='old',action='read',iostat=ier)
+ if( ier /= 0 ) call exit_MPI(myrank,'error opening list_messages_corners file')
+
do imsg = 1,NCORNERSCHUNKS
read(IIN,*) iproc_master_corners(imsg),iproc_worker1_corners(imsg), &
iproc_worker2_corners(imsg)
@@ -219,32 +237,50 @@
call MPI_BCAST(iproc_master_corners,NCORNERSCHUNKS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
call MPI_BCAST(iproc_worker1_corners,NCORNERSCHUNKS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
call MPI_BCAST(iproc_worker2_corners,NCORNERSCHUNKS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
+ if( ier /= 0 ) call exit_MPI(myrank,'error mpi broadcast')
+
!---- read indirect addressing for each message for faces of the chunks
!---- a given slice can belong to at most two faces
icount_faces = 0
do imsg = 1,NUMMSGS_FACES
- if(myrank == iprocfrom_faces(imsg) .or. myrank == iprocto_faces(imsg)) then
- icount_faces = icount_faces + 1
- if(icount_faces>NUMFACES_SHARED) call exit_MPI(myrank,'more than NUMFACES_SHARED faces for this slice')
- if(icount_faces>2 .and. (NPROC_XI > 1 .or. NPROC_ETA > 1)) call exit_MPI(myrank,'more than two faces for this slice')
+ if(myrank == iprocfrom_faces(imsg) .or. myrank == iprocto_faces(imsg)) then
+ icount_faces = icount_faces + 1
-! read file with 2D buffer for faces
- if(myrank == iprocfrom_faces(imsg)) then
- write(filename,"('buffer_faces_chunks_sender_msg',i6.6,'.txt')") imsg
- else if(myrank == iprocto_faces(imsg)) then
- write(filename,"('buffer_faces_chunks_receiver_msg',i6.6,'.txt')") imsg
+ if(icount_faces > NUMFACES_SHARED) then
+ print*,'error ',myrank,' icount_faces: ',icount_faces,'NUMFACES_SHARED:',NUMFACES_SHARED
+ print*,'iregion_code:',iregion_code
+ call exit_MPI(myrank,'more than NUMFACES_SHARED faces for this slice')
+ endif
+ if(icount_faces > 2 .and. (NPROC_XI > 1 .or. NPROC_ETA > 1)) then
+ print*,'error ',myrank,' icount_faces: ',icount_faces,'NPROC_XI:',NPROC_XI,'NPROC_ETA:',NPROC_ETA
+ print*,'iregion_code:',iregion_code
+ call exit_MPI(myrank,'more than two faces for this slice')
+ endif
+
+ ! read file with 2D buffer for faces
+ if(myrank == iprocfrom_faces(imsg)) then
+ write(filename,"('buffer_faces_chunks_sender_msg',i6.6,'.txt')") imsg
+ else if(myrank == iprocto_faces(imsg)) then
+ write(filename,"('buffer_faces_chunks_receiver_msg',i6.6,'.txt')") imsg
+ endif
+
+ open(unit=IIN,file=prname(1:len_trim(prname))//filename,status='old',action='read',iostat=ier)
+ if( ier /= 0 ) call exit_MPI(myrank,'error opening buffer_faces file')
+
+ read(IIN,*) npoin2D_faces(icount_faces)
+ if(npoin2D_faces(icount_faces) > NGLOB2DMAX_XY) then
+ print*,'error ',myrank,' npoin2D_faces: ',npoin2D_faces(icount_faces),icount_faces
+ print*,'iregion_code:',iregion_code
+ call exit_MPI(myrank,'incorrect nb of points in face buffer')
+ endif
+
+ do ipoin2D = 1,npoin2D_faces(icount_faces)
+ read(IIN,*) iboolfaces(ipoin2D,icount_faces),xdummy,ydummy,zdummy
+ enddo
+ close(IIN)
+
endif
-
- open(unit=IIN,file=prname(1:len_trim(prname))//filename,status='old',action='read')
- read(IIN,*) npoin2D_faces(icount_faces)
- if(npoin2D_faces(icount_faces) > NGLOB2DMAX_XY) &
- call exit_MPI(myrank,'incorrect nb of points in face buffer')
- do ipoin2D = 1,npoin2D_faces(icount_faces)
- read(IIN,*) iboolfaces(ipoin2D,icount_faces),xdummy,ydummy,zdummy
- enddo
- close(IIN)
- endif
enddo
@@ -256,8 +292,11 @@
myrank == iproc_worker1_corners(imsg) .or. &
myrank == iproc_worker2_corners(imsg)) then
icount_corners = icount_corners + 1
- if(icount_corners>1 .and. (NPROC_XI > 1 .or. NPROC_ETA > 1)) &
+ if(icount_corners>1 .and. (NPROC_XI > 1 .or. NPROC_ETA > 1)) then
+ print*,'error ',myrank,'icount_corners:',icount_corners
+ print*,'iregion_code:',iregion_code
call exit_MPI(myrank,'more than one corner for this slice')
+ endif
if(icount_corners>4) call exit_MPI(myrank,'more than four corners for this slice')
! read file with 1D buffer for corner
@@ -270,7 +309,10 @@
endif
! matching codes
- open(unit=IIN,file=prname(1:len_trim(prname))//filename,status='old',action='read')
+ open(unit=IIN,file=prname(1:len_trim(prname))//filename, &
+ status='old',action='read',iostat=ier)
+ if( ier /= 0 ) call exit_MPI(myrank,'error opening buffer_corners_chunks file')
+
read(IIN,*) npoin1D_corner
if(npoin1D_corner /= NGLOB1D_RADIAL) &
call exit_MPI(myrank,'incorrect nb of points in corner buffer')
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/read_mesh_databases.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/read_mesh_databases.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/read_mesh_databases.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -136,6 +136,10 @@
READ_TISO = .true.
endif
+ ! sets number of top elements for surface movies & noise tomography
+ NSPEC_TOP = NSPEC2D_TOP(IREGION_CRUST_MANTLE)
+
+ ! reads databases file
call read_arrays_solver(IREGION_CRUST_MANTLE,myrank, &
rho_vp_crust_mantle,rho_vs_crust_mantle, &
xstore_crust_mantle,ystore_crust_mantle,zstore_crust_mantle, &
@@ -601,7 +605,7 @@
! local parameters
integer :: ier
- character(len=150) :: filename
+ !character(len=150) :: filename
! read 2-D addressing for summation between slices with MPI
@@ -746,8 +750,9 @@
! updates flags for elements on slice boundaries
call fix_non_blocking_central_cube(is_on_a_slice_edge_inner_core, &
ibool_inner_core,NSPEC_INNER_CORE,NGLOB_INNER_CORE,nb_msgs_theor_in_cube,ibelm_bottom_inner_core, &
- idoubling_inner_core,npoin2D_cube_from_slices,ibool_central_cube, &
- NSPEC2D_BOTTOM(IREGION_INNER_CORE),ichunk)
+ idoubling_inner_core,npoin2D_cube_from_slices, &
+ ibool_central_cube,NSPEC2D_BOTTOM(IREGION_INNER_CORE), &
+ ichunk,NPROC_XI_VAL)
endif
! debug: saves element flags
@@ -763,13 +768,12 @@
! xstore_outer_core,ystore_outer_core,zstore_outer_core, &
! ibool_outer_core, &
! is_on_a_slice_edge_outer_core,filename)
-!daniel
! inner core
- write(filename,'(a,i6.6)') trim(OUTPUT_FILES)//'/MPI_is_on_a_slice_edge_inner_core_proc',myrank
- call write_VTK_data_elem_l(NSPEC_INNER_CORE,NGLOB_INNER_CORE, &
- xstore_inner_core,ystore_inner_core,zstore_inner_core, &
- ibool_inner_core, &
- is_on_a_slice_edge_inner_core,filename)
+ !write(filename,'(a,i6.6)') trim(OUTPUT_FILES)//'/MPI_is_on_a_slice_edge_inner_core_proc',myrank
+ !call write_VTK_data_elem_l(NSPEC_INNER_CORE,NGLOB_INNER_CORE, &
+ ! xstore_inner_core,ystore_inner_core,zstore_inner_core, &
+ ! ibool_inner_core, &
+ ! is_on_a_slice_edge_inner_core,filename)
end subroutine read_mesh_databases_MPIbuffers
@@ -792,7 +796,6 @@
! local parameters
integer :: ier,ndim_assemble
- character(len=150) :: filename
! temporary buffers for send and receive between faces of the slices and the chunks
real(kind=CUSTOM_REAL), dimension(npoin2D_max_all_CM_IC) :: &
@@ -805,9 +808,10 @@
integer, dimension(:,:),allocatable :: ibool_neighbours
integer :: max_nibool
real(kind=CUSTOM_REAL),dimension(:),allocatable :: test_flag
- real(kind=CUSTOM_REAL),dimension(:),allocatable :: test_flag_cc
integer,dimension(:),allocatable :: dummy_i
integer :: i,j,k,ispec,iglob
+ !daniel: debug
+ !character(len=150) :: filename
! estimates initial maximum ibool array
max_nibool = npoin2D_max_all_CM_IC * NUMFACES_SHARED &
@@ -1049,13 +1053,6 @@
! suppress fictitious elements in central cube
if(idoubling_inner_core(ispec) == IFLAG_IN_FICTITIOUS_CUBE) cycle
- ! suppress central cube, will be handled afterwards
- if( INCLUDE_CENTRAL_CUBE ) then
- if(idoubling_inner_core(ispec) == IFLAG_MIDDLE_CENTRAL_CUBE .or. &
- idoubling_inner_core(ispec) == IFLAG_BOTTOM_CENTRAL_CUBE .or. &
- idoubling_inner_core(ispec) == IFLAG_TOP_CENTRAL_CUBE) cycle
- endif
-
! sets flags
do k = 1,NGLLZ
do j = 1,NGLLY
@@ -1082,73 +1079,27 @@
NPROC_XI_VAL,NPROC_ETA_VAL,NGLOB1D_RADIAL(IREGION_INNER_CORE), &
NGLOB2DMAX_XMIN_XMAX(IREGION_INNER_CORE),NGLOB2DMAX_YMIN_YMAX(IREGION_INNER_CORE),NGLOB2DMAX_XY,NCHUNKS_VAL)
- ! removes own myrank id (+1)
- test_flag(:) = test_flag(:) - ( myrank + 1.0)
- where( test_flag(:) < 0.0 ) test_flag(:) = 0.0
-
! debug: saves array
- write(filename,'(a,i6.6)') trim(OUTPUT_FILES)//'/MPI_test_flag_inner_core_A_proc',myrank
- call write_VTK_glob_points(NGLOB_INNER_CORE, &
- xstore_inner_core,ystore_inner_core,zstore_inner_core, &
- test_flag,filename)
+ !write(filename,'(a,i6.6)') trim(OUTPUT_FILES)//'/MPI_test_flag_inner_core_A_proc',myrank
+ !call write_VTK_glob_points(NGLOB_INNER_CORE, &
+ ! xstore_inner_core,ystore_inner_core,zstore_inner_core, &
+ ! test_flag,filename)
+ ! debug: idoubling inner core
+ !write(filename,'(a,i6.6)') trim(OUTPUT_FILES)//'/MPI_idoubling_inner_core_proc',myrank
+ !call write_VTK_data_elem_i(NSPEC_INNER_CORE,NGLOB_INNER_CORE, &
+ ! xstore_inner_core,ystore_inner_core,zstore_inner_core, &
+ ! ibool_inner_core, &
+ ! idoubling_inner_core,filename)
+ !call sync_all()
- ! in sequential order, for testing purpose
- do i=0,NPROCTOT_VAL - 1
- if( myrank == i ) then
-
- ! gets new interfaces for inner_core without central cube yet
- ! determines neighbor rank for shared faces
- call rmd_get_MPI_interfaces(myrank,NGLOB_INNER_CORE,NSPEC_INNER_CORE, &
- test_flag,my_neighbours,nibool_neighbours,ibool_neighbours, &
- num_interfaces_inner_core,max_nibool_interfaces_inner_core, &
- max_nibool,MAX_NEIGHBOURS, &
- ibool_inner_core,&
- is_on_a_slice_edge_inner_core, &
- IREGION_INNER_CORE,.false.,idoubling_inner_core,INCLUDE_CENTRAL_CUBE)
-
- endif
- call sync_all()
- enddo
-
- ! intermediate check
- call rmd_test_MPI_neighbours(num_interfaces_inner_core, &
- my_neighbours(1:num_interfaces_inner_core), &
- nibool_neighbours(1:num_interfaces_inner_core))
-
-
! including central cube
if(INCLUDE_CENTRAL_CUBE) then
+
if( myrank == 0 ) write(IMAIN,*) 'inner core with central cube mpi:'
! test_flag is a scalar, not a vector
ndim_assemble = 1
- allocate(test_flag_cc(NGLOB_INNER_CORE), &
- stat=ier)
- if( ier /= 0 ) call exit_mpi(myrank,'error allocating test_flag_cc inner core')
-
- ! re-sets flag to rank id (+1 to avoid problems with zero rank)
- test_flag_cc = 0.0
- do ispec=1,NSPEC_INNER_CORE
- ! suppress fictitious elements in central cube
- if(idoubling_inner_core(ispec) == IFLAG_IN_FICTITIOUS_CUBE) cycle
-
- ! only takes central cube
- if(idoubling_inner_core(ispec) /= IFLAG_MIDDLE_CENTRAL_CUBE .and. &
- idoubling_inner_core(ispec) /= IFLAG_BOTTOM_CENTRAL_CUBE .and. &
- idoubling_inner_core(ispec) /= IFLAG_TOP_CENTRAL_CUBE) cycle
-
- ! sets flags
- do k = 1,NGLLZ
- do j = 1,NGLLY
- do i = 1,NGLLX
- iglob = ibool_inner_core(i,j,k,ispec)
- test_flag_cc(iglob) = myrank + 1.0
- enddo
- enddo
- enddo
- enddo
-
! use central cube buffers to assemble the inner core mass matrix with the central cube
call assemble_MPI_central_cube_block(ichunk,nb_msgs_theor_in_cube, sender_from_slices_to_cube, &
npoin2D_cube_from_slices, buffer_all_cube_from_slices, &
@@ -1157,64 +1108,39 @@
idoubling_inner_core, NSPEC_INNER_CORE, &
ibelm_bottom_inner_core, NSPEC2D_BOTTOM(IREGION_INNER_CORE), &
NGLOB_INNER_CORE, &
- test_flag_cc,ndim_assemble)
+ test_flag,ndim_assemble, &
+ iproc_eta,addressing,NCHUNKS_VAL,NPROC_XI_VAL,NPROC_ETA_VAL)
+ endif
+ ! removes own myrank id (+1)
+ test_flag = test_flag - ( myrank + 1.0)
+ where( test_flag < 0.0 ) test_flag = 0.0
- ! removes own myrank id (+1)
- test_flag_cc = test_flag_cc - ( myrank + 1.0)
- where( test_flag_cc < 0.0 ) test_flag_cc = 0.0
+ ! debug: saves array
+ !write(filename,'(a,i6.6)') trim(OUTPUT_FILES)//'/MPI_test_flag_inner_core_B_proc',myrank
+ !call write_VTK_glob_points(NGLOB_INNER_CORE, &
+ ! xstore_inner_core,ystore_inner_core,zstore_inner_core, &
+ ! test_flag,filename)
+ !call sync_all()
- ! debug: saves array
- write(filename,'(a,i6.6)') trim(OUTPUT_FILES)//'/MPI_test_flag_inner_core_B_proc',myrank
- call write_VTK_glob_points(NGLOB_INNER_CORE, &
- xstore_inner_core,ystore_inner_core,zstore_inner_core, &
- test_flag_cc,filename)
-
- ! in sequential order, for testing purpose
- do i=0,NPROCTOT_VAL - 1
- if( myrank == i ) then
- ! adds additional inner core points
- call rmd_get_MPI_interfaces(myrank,NGLOB_INNER_CORE,NSPEC_INNER_CORE, &
- test_flag_cc,my_neighbours,nibool_neighbours,ibool_neighbours, &
+ ! in sequential order, for testing purpose
+ do i=0,NPROCTOT_VAL - 1
+ if( myrank == i ) then
+ ! gets new interfaces for inner_core without central cube yet
+ ! determines neighbor rank for shared faces
+ call rmd_get_MPI_interfaces(myrank,NGLOB_INNER_CORE,NSPEC_INNER_CORE, &
+ test_flag,my_neighbours,nibool_neighbours,ibool_neighbours, &
num_interfaces_inner_core,max_nibool_interfaces_inner_core, &
max_nibool,MAX_NEIGHBOURS, &
ibool_inner_core,&
is_on_a_slice_edge_inner_core, &
- IREGION_INNER_CORE,.true.,idoubling_inner_core,INCLUDE_CENTRAL_CUBE)
- endif
- call sync_all()
- enddo
+ IREGION_INNER_CORE,.false.,idoubling_inner_core,INCLUDE_CENTRAL_CUBE)
-! ! adds both together
-! test_flag(:) = test_flag(:) + test_flag_cc(:)
-!
-! ! debug: saves array
-! write(filename,'(a,i6.6)') trim(OUTPUT_FILES)//'/MPI_test_flag_inner_core_C_proc',myrank
-! call write_VTK_glob_points(NGLOB_INNER_CORE, &
-! xstore_inner_core,ystore_inner_core,zstore_inner_core, &
-! test_flag,filename)
+ endif
+ call sync_all()
+ enddo
- deallocate(test_flag_cc)
- endif
-
-! ! in sequential order, for testing purpose
-! do i=0,NPROCTOT_VAL - 1
-! if( myrank == i ) then
-! ! gets new interfaces for inner_core without central cube yet
-! ! determines neighbor rank for shared faces
-! call rmd_get_MPI_interfaces(myrank,NGLOB_INNER_CORE,NSPEC_INNER_CORE, &
-! test_flag,my_neighbours,nibool_neighbours,ibool_neighbours, &
-! num_interfaces_inner_core,max_nibool_interfaces_inner_core, &
-! max_nibool,MAX_NEIGHBOURS, &
-! ibool_inner_core,&
-! is_on_a_slice_edge_inner_core, &
-! IREGION_INNER_CORE,.false.,idoubling_inner_core,INCLUDE_CENTRAL_CUBE)
-!
-! endif
-! call sync_all()
-! enddo
-
deallocate(test_flag)
call sync_all()
@@ -1245,19 +1171,16 @@
allocate(ibool_interfaces_inner_core(0,0),stat=ier)
endif
- ! debug: saves 1. MPI interface
- !if( myrank == 4 .or. myrank == 13 ) then
- do i=1,num_interfaces_inner_core
- write(filename,'(a,i6.6,a,i2.2)') trim(OUTPUT_FILES)//'/MPI_points_inner_core_proc',myrank, &
- '_',my_neighbours_inner_core(i)
- call write_VTK_data_points(NGLOB_INNER_CORE, &
- xstore_inner_core,ystore_inner_core,zstore_inner_core, &
- ibool_interfaces_inner_core(1:nibool_interfaces_inner_core(i),i), &
- nibool_interfaces_inner_core(i),filename)
- !print*,'saved: ',trim(filename)//'.vtk'
- enddo
- !endif
- call sync_all()
+ ! debug: saves MPI interfaces
+ !do i=1,num_interfaces_inner_core
+ ! write(filename,'(a,i6.6,a,i2.2)') trim(OUTPUT_FILES)//'/MPI_points_inner_core_proc',myrank, &
+ ! '_',my_neighbours_inner_core(i)
+ ! call write_VTK_data_points(NGLOB_INNER_CORE, &
+ ! xstore_inner_core,ystore_inner_core,zstore_inner_core, &
+ ! ibool_interfaces_inner_core(1:nibool_interfaces_inner_core(i),i), &
+ ! nibool_interfaces_inner_core(i),filename)
+ !enddo
+ !call sync_all()
! checks addressing
call rmd_test_MPI_neighbours(num_interfaces_inner_core,my_neighbours_inner_core,nibool_interfaces_inner_core)
@@ -1882,8 +1805,9 @@
! checks if flag was set correctly
if( work_test_flag(iglob) <= 0 ) then
! we might have missed an interface point on an edge, just re-set to missing value
- print*,'warning flag:',myrank,'rank=',rank,'interface=',icurrent
- print*,' flag=',work_test_flag(iglob),'missed iglob=',iglob
+ print*,'warning ',myrank,' flag: missed rank=',rank
+ print*,' flag=',work_test_flag(iglob),'missed iglob=',iglob,'interface=',icurrent
+ print*
endif
! we might have missed an interface point on an edge, just re-set to missing value
if( is_face_edge ) then
@@ -1986,18 +1910,24 @@
! checks if addressing is okay
if( myrank == 0 ) then
+ ! for each process
do iproc=0,NPROCTOT_VAL-1
+ ! loops over all neighbors
do i=1,dummy_i(iproc)
+ ! gets neighbour rank and number of points on interface with it
ineighbour = test_interfaces(i,iproc)
+ ipoints = test_interfaces_nibool(i,iproc)
+
+ ! checks values
if( ineighbour < 0 .or. ineighbour > NPROCTOT_VAL-1 ) then
print*,'error neighbour:',iproc,ineighbour
call exit_mpi(myrank,'error ineighbour')
endif
- ipoints = test_interfaces_nibool(i,iproc)
if( ipoints <= 0 ) then
print*,'error neighbour points:',iproc,ipoints
call exit_mpi(myrank,'error ineighbour points')
endif
+
! looks up corresponding entry in neighbour array
is_okay = .false.
do j=1,dummy_i(ineighbour)
@@ -2006,19 +1936,21 @@
if( test_interfaces_nibool(j,ineighbour) == ipoints ) then
is_okay = .true.
else
- print*,'error neighbour points:',iproc,ipoints,'ineighbour found points: ', &
- ineighbour,test_interfaces_nibool(j,ineighbour)
+ print*,'error ',iproc,'neighbour ',ineighbour,' points =',ipoints
+ print*,' ineighbour has points = ',test_interfaces_nibool(j,ineighbour)
+ print*
call exit_mpi(myrank,'error ineighbour points differ')
endif
exit
endif
enddo
if( .not. is_okay ) then
- print*,'error neighbour:',iproc,'ineighbour not found: ',ineighbour
+ print*,'error ',iproc,' neighbour not found: ',ineighbour
print*,'iproc ',iproc,' interfaces:'
print*,test_interfaces(1:dummy_i(iproc),iproc)
print*,'ineighbour ',ineighbour,' interfaces:'
print*,test_interfaces(1:dummy_i(ineighbour),ineighbour)
+ print*
call exit_mpi(myrank,'error ineighbour not found')
endif
enddo
@@ -2317,7 +2249,7 @@
! local parameters
real :: percentage_edge
integer :: ier,ispec,iinner,iouter
- character(len=150) :: filename
+ !character(len=150) :: filename
! stores inner / outer elements
!
@@ -2433,11 +2365,11 @@
! ibool_outer_core, &
! is_on_a_slice_edge_outer_core,filename)
! inner core
- write(filename,'(a,i6.6)') trim(OUTPUT_FILES)//'/MPI_innerouter_inner_core_proc',myrank
- call write_VTK_data_elem_l(NSPEC_INNER_CORE,NGLOB_INNER_CORE, &
- xstore_inner_core,ystore_inner_core,zstore_inner_core, &
- ibool_inner_core, &
- is_on_a_slice_edge_inner_core,filename)
+ !write(filename,'(a,i6.6)') trim(OUTPUT_FILES)//'/MPI_innerouter_inner_core_proc',myrank
+ !call write_VTK_data_elem_l(NSPEC_INNER_CORE,NGLOB_INNER_CORE, &
+ ! xstore_inner_core,ystore_inner_core,zstore_inner_core, &
+ ! ibool_inner_core, &
+ ! is_on_a_slice_edge_inner_core,filename)
end subroutine read_mesh_databases_InnerOuter
@@ -3107,3 +3039,73 @@
end subroutine write_VTK_data_elem_l
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+! routine for saving vtk file holding integer value on each spectral element
+
+ subroutine write_VTK_data_elem_i(nspec,nglob, &
+ xstore_dummy,ystore_dummy,zstore_dummy,ibool, &
+ elem_flag,prname_file)
+
+
+ implicit none
+
+ include "constants.h"
+
+ integer :: nspec,nglob
+
+! global coordinates
+ integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
+ real(kind=CUSTOM_REAL), dimension(nglob) :: xstore_dummy,ystore_dummy,zstore_dummy
+
+! element flag array
+ integer, dimension(nspec) :: elem_flag
+ integer :: ispec,i
+
+! file name
+ character(len=150) prname_file
+
+! write source and receiver VTK files for Paraview
+ !debug
+ !write(IMAIN,*) ' vtk file: '
+ !write(IMAIN,*) ' ',prname_file(1:len_trim(prname_file))//'.vtk'
+
+ open(IOVTK,file=prname_file(1:len_trim(prname_file))//'.vtk',status='unknown')
+ write(IOVTK,'(a)') '# vtk DataFile Version 3.1'
+ write(IOVTK,'(a)') 'material model VTK file'
+ write(IOVTK,'(a)') 'ASCII'
+ write(IOVTK,'(a)') 'DATASET UNSTRUCTURED_GRID'
+ write(IOVTK, '(a,i12,a)') 'POINTS ', nglob, ' float'
+ do i=1,nglob
+ write(IOVTK,'(3e18.6)') xstore_dummy(i),ystore_dummy(i),zstore_dummy(i)
+ enddo
+ write(IOVTK,*) ""
+
+ ! note: indices for vtk start at 0
+ write(IOVTK,'(a,i12,i12)') "CELLS ",nspec,nspec*9
+ do ispec=1,nspec
+ write(IOVTK,'(9i12)') 8,ibool(1,1,1,ispec)-1,ibool(NGLLX,1,1,ispec)-1,ibool(NGLLX,NGLLY,1,ispec)-1,ibool(1,NGLLY,1,ispec)-1,&
+ ibool(1,1,NGLLZ,ispec)-1,ibool(NGLLX,1,NGLLZ,ispec)-1,ibool(NGLLX,NGLLY,NGLLZ,ispec)-1,ibool(1,NGLLY,NGLLZ,ispec)-1
+ enddo
+ write(IOVTK,*) ""
+
+ ! type: hexahedrons
+ write(IOVTK,'(a,i12)') "CELL_TYPES ",nspec
+ write(IOVTK,*) (12,ispec=1,nspec)
+ write(IOVTK,*) ""
+
+ write(IOVTK,'(a,i12)') "CELL_DATA ",nspec
+ write(IOVTK,'(a)') "SCALARS elem_val integer"
+ write(IOVTK,'(a)') "LOOKUP_TABLE default"
+ do ispec = 1,nspec
+ write(IOVTK,*) elem_flag(ispec)
+ enddo
+ write(IOVTK,*) ""
+ close(IOVTK)
+
+
+ end subroutine write_VTK_data_elem_i
+
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/save_kernels.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/save_kernels.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/save_kernels.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -119,9 +119,6 @@
! Get A,C,F,L,N,eta from kappa,mu
! element can have transverse isotropy if between d220 and Moho
- !if( .not. (TRANSVERSE_ISOTROPY_VAL .and. &
- ! (idoubling_crust_mantle(ispec) == IFLAG_80_MOHO .or. &
- ! idoubling_crust_mantle(ispec) == IFLAG_220_80))) then
if( .not. ispec_is_tiso_crust_mantle(ispec) ) then
! layer with no transverse isotropy
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/setup_sources_receivers.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/setup_sources_receivers.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/setup_sources_receivers.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -68,8 +68,6 @@
! local parameters
double precision :: min_tshift_cmt_original
- double precision :: sec
- integer :: yr,jda,ho,mi
integer :: isource
character(len=256) :: filename
integer :: ier
@@ -121,16 +119,9 @@
endif
! locate sources in the mesh
- call locate_sources(NSOURCES,myrank,NSPEC_CRUST_MANTLE,NGLOB_CRUST_MANTLE,ibool_crust_mantle, &
- xstore_crust_mantle,ystore_crust_mantle,zstore_crust_mantle, &
- xigll,yigll,zigll, &
- ELLIPTICITY_VAL,TOPOGRAPHY, &
- sec,tshift_cmt,min_tshift_cmt_original,yr,jda,ho,mi,theta_source,phi_source, &
- NSTEP,DT,hdur,Mxx,Myy,Mzz,Mxy,Mxz,Myz, &
- islice_selected_source,ispec_selected_source, &
- xi_source,eta_source,gamma_source, nu_source, &
- rspl,espl,espl2,nspl,ibathy_topo,PRINT_SOURCE_TIME_FUNCTION, &
- LOCAL_TMP_PATH,SIMULATION_TYPE)
+ call locate_sources(NSPEC_CRUST_MANTLE,NGLOB_CRUST_MANTLE,ibool_crust_mantle, &
+ xstore_crust_mantle,ystore_crust_mantle,zstore_crust_mantle, &
+ ELLIPTICITY_VAL,min_tshift_cmt_original)
if(abs(minval(tshift_cmt)) > TINYVAL) call exit_MPI(myrank,'one tshift_cmt must be zero, others must be positive')
@@ -226,7 +217,8 @@
call exit_mpi(myrank,'error negative USER_T0 parameter in constants.h')
endif
- ! get information about event name and location for SAC seismograms
+ ! get information about event name and location
+ ! (e.g. needed for SAC seismograms)
! The following line is added for get_event_info subroutine.
! Because the way NSOURCES_SAC was declared has been changed.
@@ -252,9 +244,7 @@
include 'mpif.h'
! local parameters
- double precision :: sec
double precision :: junk
- integer :: yr,jda,ho,mi
integer :: irec,isource,nrec_tot_found
integer :: icomp,itime,nadj_files_found,nadj_files_found_tot
character(len=3),dimension(NDIM) :: comp
@@ -293,16 +283,10 @@
endif
! locate receivers in the crust in the mesh
- call locate_receivers(myrank,DT,NSTEP,NSPEC_CRUST_MANTLE,NGLOB_CRUST_MANTLE,ibool_crust_mantle, &
+ call locate_receivers(NSPEC_CRUST_MANTLE,NGLOB_CRUST_MANTLE,ibool_crust_mantle, &
xstore_crust_mantle,ystore_crust_mantle,zstore_crust_mantle, &
- xigll,yigll,zigll,trim(rec_filename), &
- nrec,islice_selected_rec,ispec_selected_rec, &
- xi_receiver,eta_receiver,gamma_receiver,station_name,network_name, &
- stlat,stlon,stele,stbur,nu, &
- yr,jda,ho,mi,sec, &
- ELLIPTICITY_VAL,TOPOGRAPHY, &
- theta_source(1),phi_source(1),rspl,espl,espl2,nspl, &
- ibathy_topo,RECEIVERS_CAN_BE_BURIED,NCHUNKS_VAL)
+ yr_SAC,jda_SAC,ho_SAC,mi_SAC,sec_SAC, &
+ theta_source(1),phi_source(1),NCHUNKS_VAL,ELLIPTICITY_VAL)
! count number of receivers located in this slice
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/specfem3D_par.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/specfem3D_par.F90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/specfem3D_par.F90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -418,8 +418,7 @@
c44store_crust_mantle,c45store_crust_mantle,c46store_crust_mantle, &
c55store_crust_mantle,c56store_crust_mantle,c66store_crust_mantle
- ! local to global mapping
- ! integer, dimension(NSPEC_CRUST_MANTLE) :: idoubling_crust_mantle
+ ! flag for transversely isotropic elements
logical, dimension(NSPEC_CRUST_MANTLE) :: ispec_is_tiso_crust_mantle
! mass matrix
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/write_movie_output.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/write_movie_output.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/write_movie_output.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -36,8 +36,9 @@
! local parameters
!daniel: debugging
-! character(len=256) :: filename
-! logical, parameter :: SNAPSHOT_INNER_CORE = .true.
+ character(len=256) :: filename
+ !integer,dimension(:),allocatable :: dummy_i
+ logical, parameter :: SNAPSHOT_INNER_CORE = .true.
! save movie on surface
if( MOVIE_SURFACE ) then
@@ -51,16 +52,8 @@
endif
! save velocity here to avoid static offset on displacement for movies
- call write_movie_surface(myrank,nmovie_points,scale_veloc,veloc_crust_mantle, &
- scale_displ,displ_crust_mantle, &
- xstore_crust_mantle,ystore_crust_mantle,zstore_crust_mantle, &
- store_val_x,store_val_y,store_val_z, &
- store_val_x_all,store_val_y_all,store_val_z_all, &
- store_val_ux,store_val_uy,store_val_uz, &
- store_val_ux_all,store_val_uy_all,store_val_uz_all, &
- ibelm_top_crust_mantle,ibool_crust_mantle, &
- NSPEC2D_TOP(IREGION_CRUST_MANTLE), &
- NIT,it,OUTPUT_FILES,MOVIE_VOLUME_TYPE)
+ call write_movie_surface()
+
endif
endif
@@ -172,24 +165,44 @@
endif ! MOVIE_VOLUME
!daniel: debugging
-! if( SNAPSHOT_INNER_CORE .and. mod(it-MOVIE_START,NTSTEP_BETWEEN_FRAMES) == 0 &
-! .and. it >= MOVIE_START .and. it <= MOVIE_STOP) then
-! ! VTK file output
-! ! displacement values
-! !write(prname,'(a,i6.6,a)') trim(LOCAL_TMP_PATH)//'/'//'proc',myrank,'_'
-! !write(filename,'(a,a,i6.6)') prname(1:len_trim(prname)),'reg_3_displ_',it
-! !call write_VTK_data_cr(idoubling_inner_core,NSPEC_INNER_CORE,NGLOB_INNER_CORE, &
-! ! xstore_inner_core,ystore_inner_core,zstore_inner_core,ibool_inner_core, &
-! ! displ_inner_core,filename)
-!
-! write(prname,'(a)') 'OUTPUT_FILES/snapshot_all_'
-! write(filename,'(a,a,i6.6)') prname(1:len_trim(prname)),'reg_3_displ_',it
-! call write_VTK_data_cr_all(myrank,idoubling_inner_core, &
-! NSPEC_INNER_CORE,NGLOB_INNER_CORE, &
-! xstore_inner_core,ystore_inner_core,zstore_inner_core,ibool_inner_core, &
-! displ_inner_core,filename)
-!
-! endif
+ if( SNAPSHOT_INNER_CORE ) then
+ if( mod(it-MOVIE_START,NTSTEP_BETWEEN_FRAMES) == 0 &
+ .and. it >= MOVIE_START .and. it <= MOVIE_STOP) then
+ !output displacement
+ if( GPU_MODE ) then
+ call transfer_displ_cm_from_device(NDIM*NGLOB_CRUST_MANTLE,displ_crust_mantle,Mesh_pointer)
+ call transfer_displ_ic_from_device(NDIM*NGLOB_INNER_CORE,displ_inner_core,Mesh_pointer)
+ endif
+ ! VTK file output
+ ! displacement values
+ ! one file per process
+ !write(prname,'(a,i6.6,a)') trim(LOCAL_TMP_PATH)//'/'//'proc',myrank,'_'
+ !write(filename,'(a,a,i6.6)') prname(1:len_trim(prname)),'reg_3_displ_',it
+ !call write_VTK_data_cr(idoubling_inner_core,NSPEC_INNER_CORE,NGLOB_INNER_CORE, &
+ ! xstore_inner_core,ystore_inner_core,zstore_inner_core,ibool_inner_core, &
+ ! displ_inner_core,filename)
+ ! single file for all processes
+ ! crust mantle
+ !allocate(dummy_i(NSPEC_CRUST_MANTLE))
+ !dummy_i(:) = IFLAG_CRUST
+ !write(prname,'(a)') 'OUTPUT_FILES/snapshot_all_'
+ !write(filename,'(a,a,i6.6)') prname(1:len_trim(prname)),'reg_1_displ_',it
+ !call write_VTK_data_cr_all(myrank,dummy_i, &
+ ! NSPEC_CRUST_MANTLE,NGLOB_CRUST_MANTLE, &
+ ! xstore_crust_mantle,ystore_crust_mantle,zstore_crust_mantle,ibool_crust_mantle, &
+ ! displ_crust_mantle,filename)
+ !deallocate(dummy_i)
+
+ ! inner core
+ write(prname,'(a)') 'OUTPUT_FILES/snapshot_all_'
+ write(filename,'(a,a,i6.6)') prname(1:len_trim(prname)),'reg_3_displ_',it
+ call write_VTK_data_cr_all(myrank,idoubling_inner_core, &
+ NSPEC_INNER_CORE,NGLOB_INNER_CORE, &
+ xstore_inner_core,ystore_inner_core,zstore_inner_core,ibool_inner_core, &
+ displ_inner_core,filename)
+ endif
+ endif
+
end subroutine write_movie_output
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/write_movie_surface.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/write_movie_surface.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/write_movie_surface.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -25,48 +25,16 @@
!
!=====================================================================
- subroutine write_movie_surface(myrank,nmovie_points,scale_veloc,veloc_crust_mantle, &
- scale_displ,displ_crust_mantle, &
- xstore_crust_mantle,ystore_crust_mantle,zstore_crust_mantle, &
- store_val_x,store_val_y,store_val_z, &
- store_val_x_all,store_val_y_all,store_val_z_all, &
- store_val_ux,store_val_uy,store_val_uz, &
- store_val_ux_all,store_val_uy_all,store_val_uz_all, &
- ibelm_top_crust_mantle,ibool_crust_mantle,nspec_top, &
- NIT,it,OUTPUT_FILES,MOVIE_VOLUME_TYPE)
+ subroutine write_movie_surface()
+ use specfem_par
+ use specfem_par_crustmantle
+ use specfem_par_movie
implicit none
include 'mpif.h'
include "precision.h"
- include "constants.h"
- include "OUTPUT_FILES/values_from_mesher.h"
- integer myrank,nmovie_points
- double precision :: scale_veloc,scale_displ
-
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_CRUST_MANTLE) :: &
- veloc_crust_mantle,displ_crust_mantle
-
- real(kind=CUSTOM_REAL), dimension(NGLOB_CRUST_MANTLE) :: &
- xstore_crust_mantle,ystore_crust_mantle,zstore_crust_mantle
-
- real(kind=CUSTOM_REAL), dimension(nmovie_points) :: &
- store_val_x,store_val_y,store_val_z, &
- store_val_ux,store_val_uy,store_val_uz
-
- real(kind=CUSTOM_REAL), dimension(nmovie_points,0:NPROCTOT_VAL-1) :: &
- store_val_x_all,store_val_y_all,store_val_z_all, &
- store_val_ux_all,store_val_uy_all,store_val_uz_all
-
- integer, dimension(NSPEC2D_TOP_CM) :: ibelm_top_crust_mantle
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE) :: ibool_crust_mantle
-
- integer nspec_top,NIT,it
- character(len=150) OUTPUT_FILES
-
- integer MOVIE_VOLUME_TYPE
-
! local parameters
character(len=150) :: outputname
integer :: ipoin,ispec2D,ispec,i,j,k,ier,iglob
@@ -75,7 +43,7 @@
! get coordinates of surface mesh and surface displacement
ipoin = 0
- do ispec2D = 1, nspec_top ! NSPEC2D_TOP(IREGION_CRUST_MANTLE)
+ do ispec2D = 1, NSPEC_TOP ! NSPEC2D_TOP(IREGION_CRUST_MANTLE)
ispec = ibelm_top_crust_mantle(ispec2D)
! in case of global, NCHUNKS_VAL == 6 simulations, be aware that for
@@ -121,7 +89,10 @@
! save movie data to disk in home directory
if(myrank == 0) then
write(outputname,"('/moviedata',i6.6)") it
- open(unit=IOUT,file=trim(OUTPUT_FILES)//outputname,status='unknown',form='unformatted',action='write')
+ open(unit=IOUT,file=trim(OUTPUT_FILES)//outputname, &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening moviedata file')
+
write(IOUT) store_val_x_all
write(IOUT) store_val_y_all
write(IOUT) store_val_z_all
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/write_movie_volume.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/write_movie_volume.f90 2012-03-30 22:50:25 UTC (rev 19914)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SPECFEM3D_GLOBE_SUNFLOWER/src/specfem3D/write_movie_volume.f90 2012-04-02 06:04:51 UTC (rev 19915)
@@ -25,15 +25,12 @@
!
!=====================================================================
-! 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 count_points_movie_volume()
+
! this subroutine counts the number of points and elements within the movie volume
! in this processor slice, and returns arrays that keep track of them, both in global and local indexing schemes
- subroutine count_points_movie_volume()
-
use specfem_par
use specfem_par_crustmantle
use specfem_par_movie
@@ -95,12 +92,15 @@
end subroutine count_points_movie_volume
-! -----------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine write_movie_volume_mesh()
+
! writes meshfiles to merge with solver snapshots for 3D volume movies. Also computes and outputs
! the rotation matrix nu_3dmovie required to transfer to a geographic coordinate system
- subroutine write_movie_volume_mesh()
-
use specfem_par
use specfem_par_crustmantle
use specfem_par_movie
@@ -230,8 +230,11 @@
end subroutine write_movie_volume_mesh
-! ---------------------------------------------
+!
+!-------------------------------------------------------------------------------------------------
+!
+
subroutine write_movie_volume_strains(myrank,npoints_3dmovie, &
LOCAL_TMP_PATH,MOVIE_VOLUME_TYPE,MOVIE_COARSE, &
it,eps_trace_over_3_crust_mantle, &
@@ -363,7 +366,10 @@
end subroutine write_movie_volume_strains
-! ---------------------------------------------
+!
+!-------------------------------------------------------------------------------------------------
+!
+
subroutine write_movie_volume_vector(myrank,it,npoints_3dmovie,LOCAL_TMP_PATH,MOVIE_VOLUME_TYPE, &
MOVIE_COARSE,ibool_crust_mantle,vector_crust_mantle, &
scalingval,mask_3dmovie,nu_3dmovie)
@@ -453,7 +459,9 @@
end subroutine write_movie_volume_vector
-!--------------------
+!
+!-------------------------------------------------------------------------------------------------
+!
subroutine write_movie_volume_divcurl(myrank,it,eps_trace_over_3_crust_mantle,&
div_displ_outer_core, &
@@ -879,7 +887,9 @@
end subroutine write_movie_volume_divcurl
+!
!-------------------------------------------------------------------------------------------------
+!
! external mesh routine for saving vtk files for custom_real values on global points
@@ -1003,7 +1013,9 @@
end subroutine write_VTK_data_cr
+!
!-------------------------------------------------------------------------------------------------
+!
! external mesh routine for saving vtk files for custom_real values on global points
@@ -1048,14 +1060,25 @@
! master collect arrays
if( myrank == 0 ) then
allocate(store_val_x_all(nglob,0:NPROCTOT_VAL-1), &
- store_val_y_all(nglob,0:NPROCTOT_VAL-1), &
- store_val_z_all(nglob,0:NPROCTOT_VAL-1), &
- store_val_ux_all(nglob,0:NPROCTOT_VAL-1), &
- store_val_uy_all(nglob,0:NPROCTOT_VAL-1), &
- store_val_uz_all(nglob,0:NPROCTOT_VAL-1), &
- idoubling_all(nspec,0:NPROCTOT_VAL-1), &
- ibool_all(NGLLX,NGLLY,NGLLZ,nspec,0:NPROCTOT_VAL-1),stat=ier)
+ store_val_y_all(nglob,0:NPROCTOT_VAL-1), &
+ store_val_z_all(nglob,0:NPROCTOT_VAL-1), &
+ store_val_ux_all(nglob,0:NPROCTOT_VAL-1), &
+ store_val_uy_all(nglob,0:NPROCTOT_VAL-1), &
+ store_val_uz_all(nglob,0:NPROCTOT_VAL-1), &
+ idoubling_all(nspec,0:NPROCTOT_VAL-1), &
+ ibool_all(NGLLX,NGLLY,NGLLZ,nspec,0:NPROCTOT_VAL-1),stat=ier)
if( ier /= 0 ) call exit_mpi(myrank,'error allocating stores')
+ else
+ ! dummy arrays
+ allocate(store_val_x_all(1,1), &
+ store_val_y_all(1,1), &
+ store_val_z_all(1,1), &
+ store_val_ux_all(1,1), &
+ store_val_uy_all(1,1), &
+ store_val_uz_all(1,1), &
+ idoubling_all(1,1), &
+ ibool_all(1,1,1,1,1),stat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error allocating dummy stores')
endif
! gather info on master proc
@@ -1181,10 +1204,8 @@
endif
- if( myrank == 0 ) then
- deallocate(store_val_x_all,store_val_y_all,store_val_z_all, &
+ deallocate(store_val_x_all,store_val_y_all,store_val_z_all, &
store_val_ux_all,store_val_uy_all,store_val_uz_all, &
ibool_all)
- endif
end subroutine write_VTK_data_cr_all
More information about the CIG-COMMITS
mailing list