[cig-commits] r12581 - in seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta: . DATA src
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Thu Aug 7 07:32:48 PDT 2008
Author: dkomati1
Date: 2008-08-07 07:32:47 -0700 (Thu, 07 Aug 2008)
New Revision: 12581
Added:
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_main.f90
Removed:
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_name_database.f90
Modified:
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file_1second_Ranger_elastic
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file_5seconds_Earth_Simulator_elastic
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file_ori_v2
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/Makefile
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/attenuation_model.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_meshfem1.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_meshfem2.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_specfem1.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_specfem2.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_chunk_buffers.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_header_file.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_regions_mesh.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_mesher.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/get_MPI_1D_buffers.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/get_MPI_cutplanes_eta.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/get_MPI_cutplanes_xi.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/locate_receivers.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/main_program.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/read_compute_parameters.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.f90
Log:
the merged version with the mesher called as a new subroutine now compiles fine
(but does not work yet).
Got rid of create_name_database.f90 and of all instances of "prname" and "LOCAL_PATH".
Also suppressed "LOCAL_PATH" in the Par_file.
Also removed several useless calls to MPI_BARRIER().
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file 2008-08-07 14:32:47 UTC (rev 12581)
@@ -78,9 +78,6 @@
NUMBER_OF_RUNS = 1
NUMBER_OF_THIS_RUN = 1
-# path to store the local database files on each node
-LOCAL_PATH = not_used_any_more_ignored
-
# interval at which we output time step info and max of norm of displacement
NTSTEP_BETWEEN_OUTPUT_INFO = 1000
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file_1second_Ranger_elastic
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file_1second_Ranger_elastic 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file_1second_Ranger_elastic 2008-08-07 14:32:47 UTC (rev 12581)
@@ -78,9 +78,6 @@
NUMBER_OF_RUNS = 1
NUMBER_OF_THIS_RUN = 1
-# path to store the local database files on each node
-LOCAL_PATH = not_used_any_more_ignored
-
# interval at which we output time step info and max of norm of displacement
NTSTEP_BETWEEN_OUTPUT_INFO = 1000
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file_5seconds_Earth_Simulator_elastic
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file_5seconds_Earth_Simulator_elastic 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file_5seconds_Earth_Simulator_elastic 2008-08-07 14:32:47 UTC (rev 12581)
@@ -78,9 +78,6 @@
NUMBER_OF_RUNS = 1
NUMBER_OF_THIS_RUN = 1
-# path to store the local database files on each node
-LOCAL_PATH = not_used_any_more_ignored
-
# interval at which we output time step info and max of norm of displacement
NTSTEP_BETWEEN_OUTPUT_INFO = 1000
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file_ori_v2
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file_ori_v2 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/DATA/Par_file_ori_v2 2008-08-07 14:32:47 UTC (rev 12581)
@@ -78,9 +78,6 @@
NUMBER_OF_RUNS = 1
NUMBER_OF_THIS_RUN = 1
-# path to store the local database files on each node
-LOCAL_PATH = not_used_any_more_ignored
-
# interval at which we output time step info and max of norm of displacement
NTSTEP_BETWEEN_OUTPUT_INFO = 1000
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/Makefile
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/Makefile 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/Makefile 2008-08-07 14:32:47 UTC (rev 12581)
@@ -32,7 +32,8 @@
#
FC = ifort
MPIFC = mpif90
-FLAGS_NO_CHECK = -O1 -vec-report0 -e95 -implicitnone -warn truncated_source -warn argument_checking -warn unused -warn declarations -std95 -check nobounds -align sequence -assume byterecl -ftrapuv -fpe0 -ftz -traceback
+#FLAGS_NO_CHECK = -O1 -vec-report0 -e95 -implicitnone -warn truncated_source -warn argument_checking -warn unused -warn declarations -std95 -check nobounds -align sequence -assume byterecl -ftrapuv -fpe0 -ftz -traceback
+FLAGS_NO_CHECK = -O1 -vec-report0 -e95 -implicitnone -warn truncated_source -warn argument_checking -warn declarations -std95 -check nobounds -align sequence -assume byterecl -ftrapuv -fpe0 -ftz -traceback
#FLAGS_NO_CHECK = -O3 -xP -vec-report0 -e95 -implicitnone -warn truncated_source -warn argument_checking -warn unused -warn declarations -std95 -check nobounds -align sequence -assume byterecl -fpe3 -ftz
#
@@ -98,7 +99,6 @@
$O/create_central_cube_buffers.o \
$O/create_chunk_buffers.o \
$O/create_header_file.o \
- $O/create_name_database.o \
$O/create_regions_mesh.o \
$O/crustal_model.o \
$O/define_derivation_matrices.o \
@@ -444,9 +444,6 @@
$O/create_regions_mesh.o: $(SPECINC)/constants.h $S/create_regions_mesh.f90
${MPIFCCOMPILE_CHECK} -c -o $O/create_regions_mesh.o ${FCFLAGS_f90} $S/create_regions_mesh.f90
-$O/create_name_database.o: $(SPECINC)/constants.h $S/create_name_database.f90
- ${FCCOMPILE_CHECK} -c -o $O/create_name_database.o ${FCFLAGS_f90} $S/create_name_database.f90
-
$O/define_derivation_matrices.o: $(SPECINC)/constants.h $S/define_derivation_matrices.f90
${FCCOMPILE_CHECK} -c -o $O/define_derivation_matrices.o ${FCFLAGS_f90} $S/define_derivation_matrices.f90
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/attenuation_model.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/attenuation_model.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/attenuation_model.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -254,7 +254,7 @@
end subroutine attenuation_model_setup
-subroutine attenuation_save_arrays(prname, iregion_code, AM_V)
+subroutine attenuation_save_arrays(iregion_code, AM_V)
implicit none
@@ -284,15 +284,16 @@
! attenuation_model_variables
integer iregion_code
- character(len=150) prname
integer ier
integer myrank
integer, save :: first_time_called = 1
+ stop 'DK DK should do this in MPI instead of writing to a local file'
+
call MPI_COMM_RANK(MPI_COMM_WORLD, myrank, ier)
if(myrank == 0 .AND. iregion_code == IREGION_CRUST_MANTLE .AND. first_time_called == 1) then
first_time_called = 0
- open(unit=27,file=prname(1:len_trim(prname))//'1D_Q.bin',status='unknown',form='unformatted',action='write')
+ open(unit=27,file='OUTPUT_FILES/1D_Q.bin',status='unknown',form='unformatted',action='write')
write(27) AM_V%QT_c_source
write(27) AM_V%Qtau_s
write(27) AM_V%Qn
@@ -611,7 +612,7 @@
!---
!---
-subroutine get_attenuation_model_1D(myrank, prname, iregion_code, tau_s, one_minus_sum_beta, &
+subroutine get_attenuation_model_1D(myrank, iregion_code, tau_s, one_minus_sum_beta, &
factor_common, scale_factor, vn,vx,vy,vz, AM_V)
implicit none
@@ -642,7 +643,6 @@
! attenuation_model_variables
integer myrank, iregion_code
- character(len=150) prname
integer vn, vx,vy,vz
double precision, dimension(N_SLS) :: tau_s
double precision, dimension(vx,vy,vz,vn) :: scale_factor, one_minus_sum_beta
@@ -655,9 +655,11 @@
integer, save :: first_time_called = 1
+ stop 'DK DK should do this in MPI instead of writing to a file'
+
if(myrank == 0 .AND. iregion_code == IREGION_CRUST_MANTLE .AND. first_time_called == 1) then
first_time_called = 0
- open(unit=27, file=prname(1:len_trim(prname))//'1D_Q.bin', status='unknown', form='unformatted',action='read')
+ open(unit=27, file='OUTPUT_FILES/1D_Q.bin', status='unknown', form='unformatted',action='read')
read(27) AM_V%QT_c_source
read(27) tau_s
read(27) AM_V%Qn
@@ -766,8 +768,6 @@
deallocate(Qfctmp)
deallocate(Qfc2tmp)
- call MPI_BARRIER(MPI_COMM_WORLD, ier)
-
end subroutine get_attenuation_model_1D
subroutine set_attenuation_regions_1D(RICB, RCMB, R670, R220, R80, AM_V)
@@ -933,14 +933,13 @@
end subroutine get_attenuation_index
-subroutine get_attenuation_model_3D(myrank, prname, one_minus_sum_beta, factor_common, scale_factor, tau_s, vnspec)
+subroutine get_attenuation_model_3D(myrank, one_minus_sum_beta, factor_common, scale_factor, tau_s, vnspec)
implicit none
include 'constants.h'
integer myrank, vnspec
- character(len=150) prname
double precision, dimension(NGLLX,NGLLY,NGLLZ,vnspec) :: one_minus_sum_beta, scale_factor
double precision, dimension(N_SLS,NGLLX,NGLLY,NGLLZ,vnspec) :: factor_common
double precision, dimension(N_SLS) :: tau_s
@@ -953,7 +952,9 @@
! All of the following reads use the output parameters as their temporary arrays
! use the filename to determine the actual contents of the read
- open(unit=27, file=prname(1:len_trim(prname))//'attenuation3D.bin',status='old',action='read',form='unformatted')
+ stop 'DK DK should do this in MPI instead of writing to a disk file'
+
+ open(unit=27, file='OUTPUT_FILES/attenuation3D.bin',status='old',action='read',form='unformatted')
read(27) tau_s
read(27) factor_common
read(27) scale_factor
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_meshfem1.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_meshfem1.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_meshfem1.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -1,34 +1,5 @@
!! DK DK created this for merged version
- call meshfem3D( &
-!! DK DK to do later, for attenuation only; not done yet by lack of time
- omsb_crust_mantle_dble,factor_scale_crust_mantle_dble, omsb_inner_core_dble,factor_scale_inner_core_dble, &
- one_minus_sum_beta_crust_mantle,factor_scale_crust_mantle, one_minus_sum_beta_inner_core,factor_scale_inner_core, &
- factor_common_crust_mantle,factor_common_inner_core,factor_common_crust_mantle_dble, factor_common_inner_core_dble, &
-!! DK DK already computed
- myrank,sizeprocs,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,ibathy_topo,NSOURCES,npoin2D_max_all,NDIM_smaller_buffers,nrec, &
- NTSTEP_BETWEEN_OUTPUT_SEISMOS,ibool_crust_mantle, ibool_outer_core, ibool_inner_core, idoubling_crust_mantle,idoubling_inner_core, &
-ibelm_bottom_crust_mantle, ibelm_bottom_outer_core, ibelm_top_outer_core, &
-ibelm_xmin_inner_core,ibelm_xmax_inner_core,ibelm_ymin_inner_core,ibelm_ymax_inner_core,ibelm_bottom_inner_core, &
-ibelm_top_inner_core,iboolleft_xi_crust_mantle,iboolright_xi_crust_mantle, iboolleft_eta_crust_mantle, &
-iboolright_eta_crust_mantle,iboolleft_xi_outer_core,iboolright_xi_outer_core,iboolleft_eta_outer_core,iboolright_eta_outer_core, &
- iboolleft_xi_inner_core,iboolright_xi_inner_core, iboolleft_eta_inner_core,iboolright_eta_inner_core,&
- jacobian2D_bottom_outer_core,jacobian2D_top_outer_core, &
- normal_bottom_outer_core, normal_top_outer_core,kappavstore_crust_mantle,muvstore_crust_mantle, &
- kappahstore_crust_mantle,muhstore_crust_mantle,eta_anisostore_crust_mantle,kappavstore_inner_core,muvstore_inner_core, &
- rmass_crust_mantle, rmass_outer_core, rmass_inner_core, &
- nspec2D_xmin_inner_core,nspec2D_xmax_inner_core,nspec2D_ymin_inner_core,nspec2D_ymax_inner_core, &
-iprocfrom_faces,iprocto_faces,imsg_type,iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
- iboolfaces_crust_mantle,iboolfaces_outer_core,iboolfaces_inner_core, &
- iboolcorner_crust_mantle,iboolcorner_outer_core,iboolcorner_inner_core, &
- npoin2D_faces_crust_mantle,npoin2D_xi_crust_mantle,npoin2D_eta_crust_mantle, &
- npoin2D_faces_outer_core,npoin2D_xi_outer_core,npoin2D_eta_outer_core, &
- npoin2D_faces_inner_core,npoin2D_xi_inner_core,npoin2D_eta_inner_core, &
- xelm_store_crust_mantle,yelm_store_crust_mantle,zelm_store_crust_mantle, &
- xelm_store_outer_core,yelm_store_outer_core,zelm_store_outer_core, &
- xelm_store_inner_core,yelm_store_inner_core,zelm_store_inner_core, &
-!! DK DK do not need to be initialized
- buffer_send_chunkcorners_scalar,buffer_recv_chunkcorners_scalar, &
- buffer_send_chunkcorners_vector,buffer_recv_chunkcorners_vector)
+ call meshfem3D()
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_meshfem2.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_meshfem2.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_meshfem2.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -1,34 +1,5 @@
!! DK DK created this for merged version
- subroutine meshfem3D( &
-!! DK DK to do later, for attenuation only; not done yet by lack of time
- omsb_crust_mantle_dble,factor_scale_crust_mantle_dble, omsb_inner_core_dble,factor_scale_inner_core_dble, &
- one_minus_sum_beta_crust_mantle,factor_scale_crust_mantle, one_minus_sum_beta_inner_core,factor_scale_inner_core, &
- factor_common_crust_mantle,factor_common_inner_core,factor_common_crust_mantle_dble, factor_common_inner_core_dble, &
-!! DK DK already computed
- myrank,sizeprocs,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,ibathy_topo,NSOURCES,npoin2D_max_all,NDIM_smaller_buffers,nrec, &
- NTSTEP_BETWEEN_OUTPUT_SEISMOS,ibool_crust_mantle, ibool_outer_core, ibool_inner_core, idoubling_crust_mantle,idoubling_inner_core, &
-ibelm_bottom_crust_mantle, ibelm_bottom_outer_core, ibelm_top_outer_core, &
-ibelm_xmin_inner_core,ibelm_xmax_inner_core,ibelm_ymin_inner_core,ibelm_ymax_inner_core,ibelm_bottom_inner_core, &
-ibelm_top_inner_core,iboolleft_xi_crust_mantle,iboolright_xi_crust_mantle, iboolleft_eta_crust_mantle, &
-iboolright_eta_crust_mantle,iboolleft_xi_outer_core,iboolright_xi_outer_core,iboolleft_eta_outer_core,iboolright_eta_outer_core, &
- iboolleft_xi_inner_core,iboolright_xi_inner_core, iboolleft_eta_inner_core,iboolright_eta_inner_core,&
- jacobian2D_bottom_outer_core,jacobian2D_top_outer_core, &
- normal_bottom_outer_core, normal_top_outer_core,kappavstore_crust_mantle,muvstore_crust_mantle, &
- kappahstore_crust_mantle,muhstore_crust_mantle,eta_anisostore_crust_mantle,kappavstore_inner_core,muvstore_inner_core, &
- rmass_crust_mantle, rmass_outer_core, rmass_inner_core, &
- nspec2D_xmin_inner_core,nspec2D_xmax_inner_core,nspec2D_ymin_inner_core,nspec2D_ymax_inner_core, &
-iprocfrom_faces,iprocto_faces,imsg_type,iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
- iboolfaces_crust_mantle,iboolfaces_outer_core,iboolfaces_inner_core, &
- iboolcorner_crust_mantle,iboolcorner_outer_core,iboolcorner_inner_core, &
- npoin2D_faces_crust_mantle,npoin2D_xi_crust_mantle,npoin2D_eta_crust_mantle, &
- npoin2D_faces_outer_core,npoin2D_xi_outer_core,npoin2D_eta_outer_core, &
- npoin2D_faces_inner_core,npoin2D_xi_inner_core,npoin2D_eta_inner_core, &
- xelm_store_crust_mantle,yelm_store_crust_mantle,zelm_store_crust_mantle, &
- xelm_store_outer_core,yelm_store_outer_core,zelm_store_outer_core, &
- xelm_store_inner_core,yelm_store_inner_core,zelm_store_inner_core, &
-!! DK DK do not need to be initialized
- buffer_send_chunkcorners_scalar,buffer_recv_chunkcorners_scalar, &
- buffer_send_chunkcorners_vector,buffer_recv_chunkcorners_vector)
+ subroutine meshfem3D()
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_specfem1.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_specfem1.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_specfem1.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -27,8 +27,5 @@
npoin2D_faces_inner_core,npoin2D_xi_inner_core,npoin2D_eta_inner_core, &
xelm_store_crust_mantle,yelm_store_crust_mantle,zelm_store_crust_mantle, &
xelm_store_outer_core,yelm_store_outer_core,zelm_store_outer_core, &
- xelm_store_inner_core,yelm_store_inner_core,zelm_store_inner_core, &
-!! DK DK do not need to be initialized
- buffer_send_chunkcorners_scalar,buffer_recv_chunkcorners_scalar, &
- buffer_send_chunkcorners_vector,buffer_recv_chunkcorners_vector)
+ xelm_store_inner_core,yelm_store_inner_core,zelm_store_inner_core)
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_specfem2.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_specfem2.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call_specfem2.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -27,8 +27,5 @@
npoin2D_faces_inner_core,npoin2D_xi_inner_core,npoin2D_eta_inner_core, &
xelm_store_crust_mantle,yelm_store_crust_mantle,zelm_store_crust_mantle, &
xelm_store_outer_core,yelm_store_outer_core,zelm_store_outer_core, &
- xelm_store_inner_core,yelm_store_inner_core,zelm_store_inner_core, &
-!! DK DK do not need to be initialized
- buffer_send_chunkcorners_scalar,buffer_recv_chunkcorners_scalar, &
- buffer_send_chunkcorners_vector,buffer_recv_chunkcorners_vector)
+ xelm_store_inner_core,yelm_store_inner_core,zelm_store_inner_core)
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_chunk_buffers.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_chunk_buffers.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_chunk_buffers.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -738,9 +738,6 @@
!---- check that number of points detected is the same for sender and receiver
!
-! synchronize all the processes to make sure all the buffers are ready
- call MPI_BARRIER(MPI_COMM_WORLD,ier)
-
! gather information about all the messages on all processes
do imsg = 1,NUMMSGS_FACES
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_header_file.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_header_file.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_header_file.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -60,7 +60,7 @@
ROTATE_SEISMOGRAMS_RT,HONOR_1D_SPHERICAL_MOHO,WRITE_SEISMOGRAMS_BY_MASTER,&
SAVE_ALL_SEISMOS_IN_ONE_FILE,USE_BINARY_FOR_LARGE_FILE
- character(len=150) LOCAL_PATH,MODEL
+ character(len=150) MODEL
! parameters deduced from parameters read from file
integer NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube
@@ -128,7 +128,7 @@
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,MODEL,SIMULATION_TYPE,SAVE_FORWARD, &
+ INCLUDE_CENTRAL_CUBE,INFLATE_CENTRAL_CUBE,MODEL,SIMULATION_TYPE,SAVE_FORWARD, &
NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
NSPEC, &
NSPEC2D_XI, &
Deleted: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_name_database.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_name_database.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_name_database.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -1,46 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D G l o b e V e r s i o n 4 . 1
-! --------------------------------------------------
-!
-! Main authors: Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory, California Institute of Technology, USA
-! and University of Pau / CNRS / INRIA, France
-! (c) California Institute of Technology and University of Pau / CNRS / INRIA
-! August 2008
-!
-! This program is free software; you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation; either version 2 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along
-! with this program; if not, write to the Free Software Foundation, Inc.,
-! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-!
-!=====================================================================
-
- subroutine create_name_database(prname,iproc,iregion_code,LOCAL_PATH)
-
-! create the name of the database for the mesher and the solver
-
- implicit none
-
- integer iproc,iregion_code
-
-! name of the database file
- character(len=150) prname,procname,LOCAL_PATH
-
-! create the name for the database of the current slide and region
- write(procname,"('/proc',i6.6,'_reg',i1,'_')") iproc,iregion_code
-
-! create full name with path
- prname = trim(LOCAL_PATH) // procname
-
- end subroutine create_name_database
-
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_regions_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_regions_mesh.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_regions_mesh.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -34,7 +34,7 @@
ELLIPTICITY,TOPOGRAPHY,TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE, &
ANISOTROPIC_INNER_CORE,ISOTROPIC_3D_MANTLE,CRUSTAL,ONE_CRUST, &
NPROC_XI,NPROC_ETA,NSPEC2D_XI_FACE,NSPEC2D_ETA_FACE,NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER, &
- myrank,LOCAL_PATH,OCEANS,ibathy_topo,rotation_matrix,ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD,&
+ myrank,OCEANS,ibathy_topo,rotation_matrix,ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD,&
ATTENUATION,ATTENUATION_3D, &
NCHUNKS,INCLUDE_CENTRAL_CUBE,ABSORBING_CONDITIONS,REFERENCE_1D_MODEL,THREE_D_MODEL, &
R_CENTRAL_CUBE,RICB,RHO_OCEANS,RCMB,R670,RMOHO,RTOPDDOUBLEPRIME,R600,R220,R771,R400,R120,R80,RMIDDLE_CRUST,ROCEAN, &
@@ -383,7 +383,7 @@
double precision R_CENTRAL_CUBE,RICB,RHO_OCEANS,RCMB,R670,RMOHO, &
RTOPDDOUBLEPRIME,R600,R220,R771,R400,R120,R80,RMIDDLE_CRUST,ROCEAN
- character(len=150) LOCAL_PATH,errmsg
+ character(len=150) errmsg
! use integer array to store values
integer ibathy_topo(NX_BATHY,NY_BATHY)
@@ -496,9 +496,6 @@
integer, dimension(:,:), allocatable :: nimin,nimax,njmin,njmax,nkmin_xi,nkmin_eta
real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: rho_vp,rho_vs
-! name of the database file
- character(len=150) prname
-
! number of elements on the boundaries
integer nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax
@@ -593,9 +590,6 @@
real(kind=CUSTOM_REAL) :: normal_bottom(NDIM,NGLLX,NGLLY,NSPEC2D_BOTTOM)
real(kind=CUSTOM_REAL) :: normal_top(NDIM,NGLLX,NGLLY,NSPEC2D_TOP)
-! create the name for the database of the current slide and region
- call create_name_database(prname,myrank,iregion_code,LOCAL_PATH)
-
! Attenuation
if(ATTENUATION .and. ATTENUATION_3D) then
T_c_source = AM_V%QT_c_source
@@ -1979,33 +1973,6 @@
endif
-! save the binary files
-!! DK DK MERGED UGLY this is the only thing we are going to have to save
-! call save_arrays_solver(rho_vp,rho_vs,nspec_stacey, &
-! prname,iregion_code,xixstore,xiystore,xizstore, &
-! etaxstore,etaystore,etazstore, &
-! gammaxstore,gammaystore,gammazstore, &
-! xstore,ystore,zstore, rhostore, &
-! kappavstore,kappahstore,muvstore,muhstore,eta_anisostore, &
-! nspec_ani, &
-! c11store,c12store,c13store,c14store,c15store,c16store,c22store, &
-! c23store,c24store,c25store,c26store,c33store,c34store,c35store, &
-! c36store,c44store,c45store,c46store,c55store,c56store,c66store, &
-! ibool,idoubling,rmass,rmass_ocean_load,nglob_oceans, &
-! ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
-! nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
-! normal_xmin,normal_xmax,normal_ymin,normal_ymax,normal_bottom,normal_top, &
-! jacobian2D_xmin,jacobian2D_xmax, &
-! jacobian2D_ymin,jacobian2D_ymax, &
-! jacobian2D_bottom,jacobian2D_top, &
-! nspec,nglob, &
-! NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
-! TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE,ANISOTROPIC_INNER_CORE,OCEANS, &
-! tau_s,tau_e_store,Qmu_store,T_c_source, &
-! ATTENUATION,ATTENUATION_3D, &
-! size(tau_e_store,2),size(tau_e_store,3),size(tau_e_store,4),size(tau_e_store,5),&
-! NEX_PER_PROC_XI,NEX_PER_PROC_ETA,NEX_XI,ichunk,NCHUNKS,ABSORBING_CONDITIONS,AM_V)
-
! boundary mesh
if (SAVE_BOUNDARY_MESH .and. iregion_code == IREGION_CRUST_MANTLE) then
! first check the number of surface elements are the same for Moho, 400, 670
@@ -2019,7 +1986,8 @@
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',action='write')
+ stop 'DK DK should do this in MPI instead of writing to a disk file'
+ open(unit=27,file='OUTPUT_FILES/boundary_disc.bin',status='unknown',form='unformatted',action='write')
write(27) NSPEC2D_MOHO, NSPEC2D_400, NSPEC2D_670
write(27) ibelm_moho_top
write(27) ibelm_moho_bot
Added: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_main.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_main.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_main.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -0,0 +1,153 @@
+
+!! DK DK added this for merged version
+!! DK DK stored in single precision for merged version, check if it precise enough (probably yes)
+ real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: &
+ xelm_store_crust_mantle,yelm_store_crust_mantle,zelm_store_crust_mantle, &
+ xelm_store_outer_core,yelm_store_outer_core,zelm_store_outer_core, &
+ xelm_store_inner_core,yelm_store_inner_core,zelm_store_inner_core
+
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+
+ integer npoin2D_faces_crust_mantle(NUMFACES_SHARED)
+ integer npoin2D_faces_outer_core(NUMFACES_SHARED)
+ integer npoin2D_faces_inner_core(NUMFACES_SHARED)
+
+ integer, dimension(NB_SQUARE_EDGES_ONEDIR) :: npoin2D_xi_crust_mantle,npoin2D_eta_crust_mantle, &
+ npoin2D_xi_outer_core,npoin2D_eta_outer_core, &
+ npoin2D_xi_inner_core,npoin2D_eta_inner_core
+
+! number of elements on the boundaries
+ integer :: nspec2D_xmin_crust_mantle,nspec2D_xmax_crust_mantle,nspec2D_ymin_crust_mantle,nspec2D_ymax_crust_mantle
+ integer :: nspec2D_xmin_outer_core,nspec2D_xmax_outer_core,nspec2D_ymin_outer_core,nspec2D_ymax_outer_core
+ integer :: nspec2D_xmin_inner_core,nspec2D_xmax_inner_core,nspec2D_ymin_inner_core,nspec2D_ymax_inner_core
+
+ real(kind=CUSTOM_REAL), dimension(NGLOB_CRUST_MANTLE) :: rmass_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NGLOB_OUTER_CORE) :: rmass_outer_core
+ real(kind=CUSTOM_REAL), dimension(NGLOB_INNER_CORE) :: rmass_inner_core
+
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPECMAX_ISO_MANTLE) :: kappavstore_crust_mantle,muvstore_crust_mantle
+
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPECMAX_TISO_MANTLE) :: &
+ kappahstore_crust_mantle,muhstore_crust_mantle,eta_anisostore_crust_mantle
+
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_INNER_CORE) :: kappavstore_inner_core,muvstore_inner_core
+
+!! DK DK added this for the merged version
+!! DK DK these arrays are useless in the solver and will therefore be allocated with a dummy size of 1
+ real(kind=CUSTOM_REAL), dimension(1,1,1,1) :: kappahstore_inner_core,muhstore_inner_core,eta_anisostore_inner_core
+ real(kind=CUSTOM_REAL), dimension(1,1,1,1) :: kappavstore_outer_core,muvstore_outer_core
+ real(kind=CUSTOM_REAL), dimension(1,1,1,1) :: kappahstore_outer_core,muhstore_outer_core,eta_anisostore_outer_core
+
+! 2-D jacobians and normals
+ real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_IC) :: jacobian2D_xmin_inner_core,jacobian2D_xmax_inner_core
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_IC) :: jacobian2D_ymin_inner_core,jacobian2D_ymax_inner_core
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_BOTTOM_IC) :: jacobian2D_bottom_inner_core
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_TOP_IC) :: jacobian2D_top_inner_core
+
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_IC) :: normal_xmin_inner_core,normal_xmax_inner_core
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_IC) :: normal_ymin_inner_core,normal_ymax_inner_core
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_BOTTOM_IC) :: normal_bottom_inner_core
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_TOP_IC) :: normal_top_inner_core
+
+ integer, dimension(NSPEC2DMAX_XMIN_XMAX_CM) :: ibelm_xmin_crust_mantle,ibelm_xmax_crust_mantle
+ integer, dimension(NSPEC2DMAX_YMIN_YMAX_CM) :: ibelm_ymin_crust_mantle,ibelm_ymax_crust_mantle
+ integer, dimension(NSPEC2D_BOTTOM_CM) :: ibelm_bottom_crust_mantle
+ integer, dimension(NSPEC2D_TOP_CM) :: ibelm_top_crust_mantle
+
+ real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_CM) :: &
+ jacobian2D_xmin_crust_mantle,jacobian2D_xmax_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_CM) :: &
+ jacobian2D_ymin_crust_mantle,jacobian2D_ymax_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_BOTTOM_CM) :: jacobian2D_bottom_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_TOP_CM) :: jacobian2D_top_crust_mantle
+
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_CM) :: normal_xmin_crust_mantle,normal_xmax_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2DMAX_YMIN_YMAX_CM) :: normal_ymin_crust_mantle,normal_ymax_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_BOTTOM_CM) :: normal_bottom_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_TOP_CM) :: normal_top_crust_mantle
+
+ integer, dimension(NSPEC2DMAX_XMIN_XMAX_OC) :: ibelm_xmin_outer_core,ibelm_xmax_outer_core
+ integer, dimension(NSPEC2DMAX_YMIN_YMAX_OC) :: ibelm_ymin_outer_core,ibelm_ymax_outer_core
+ integer, dimension(NSPEC2D_BOTTOM_OC) :: ibelm_bottom_outer_core
+ integer, dimension(NSPEC2D_TOP_OC) :: ibelm_top_outer_core
+
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_OC) :: normal_xmin_outer_core,normal_xmax_outer_core
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_OC) :: normal_ymin_outer_core,normal_ymax_outer_core
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_BOTTOM_OC) :: normal_bottom_outer_core
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_TOP_OC) :: normal_top_outer_core
+
+ real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_OC) :: jacobian2D_xmin_outer_core,jacobian2D_xmax_outer_core
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_OC) :: jacobian2D_ymin_outer_core,jacobian2D_ymax_outer_core
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_BOTTOM_OC) :: jacobian2D_bottom_outer_core
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_TOP_OC) :: jacobian2D_top_outer_core
+
+ integer, dimension(NSPEC2DMAX_XMIN_XMAX_IC) :: ibelm_xmin_inner_core,ibelm_xmax_inner_core
+ integer, dimension(NSPEC2DMAX_YMIN_YMAX_IC) :: ibelm_ymin_inner_core,ibelm_ymax_inner_core
+ integer, dimension(NSPEC2D_BOTTOM_IC) :: ibelm_bottom_inner_core
+ integer, dimension(NSPEC2D_TOP_IC) :: ibelm_top_inner_core
+
+ integer, dimension(NGLOB2DMAX_XY_VAL_CM,NUMFACES_SHARED) :: iboolfaces_crust_mantle
+ integer, dimension(NGLOB2DMAX_XY_VAL_OC,NUMFACES_SHARED) :: iboolfaces_outer_core
+ integer, dimension(NGLOB2DMAX_XY_VAL_IC,NUMFACES_SHARED) :: iboolfaces_inner_core
+
+ integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE) :: ibool_crust_mantle
+
+ integer, dimension(NSPEC_CRUST_MANTLE) :: idoubling_crust_mantle
+
+!! DK DK this array is useless in the solver and is therefore allocated with a dummy size of 1
+ integer, dimension(1) :: idoubling_outer_core
+
+ integer, dimension(NSPEC_INNER_CORE) :: idoubling_inner_core
+
+ integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_OUTER_CORE) :: ibool_outer_core
+
+ integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_INNER_CORE) :: ibool_inner_core
+
+ integer, dimension(NGLOB1D_RADIAL_CM,NUMCORNERS_SHARED) :: iboolcorner_crust_mantle
+ integer, dimension(NGLOB1D_RADIAL_OC,NUMCORNERS_SHARED) :: iboolcorner_outer_core
+ integer, dimension(NGLOB1D_RADIAL_IC,NUMCORNERS_SHARED) :: iboolcorner_inner_core
+
+ integer, dimension(NGLOB2DMAX_XMIN_XMAX_CM) :: iboolleft_xi_crust_mantle,iboolright_xi_crust_mantle
+ integer, dimension(NGLOB2DMAX_YMIN_YMAX_CM) :: iboolleft_eta_crust_mantle,iboolright_eta_crust_mantle
+ integer, dimension(NGLOB2DMAX_XMIN_XMAX_OC) :: iboolleft_xi_outer_core,iboolright_xi_outer_core
+ integer, dimension(NGLOB2DMAX_YMIN_YMAX_OC) :: iboolleft_eta_outer_core,iboolright_eta_outer_core
+ integer, dimension(NGLOB2DMAX_XMIN_XMAX_IC) :: iboolleft_xi_inner_core,iboolright_xi_inner_core
+ integer, dimension(NGLOB2DMAX_YMIN_YMAX_IC) :: iboolleft_eta_inner_core,iboolright_eta_inner_core
+
+ 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
+
+ real(kind=CUSTOM_REAL), dimension(ATT1,ATT2,ATT3,ATT4) :: one_minus_sum_beta_crust_mantle, factor_scale_crust_mantle
+
+ real(kind=CUSTOM_REAL), dimension(ATT1,ATT2,ATT3,ATT5) :: one_minus_sum_beta_inner_core, factor_scale_inner_core
+
+ real(kind=CUSTOM_REAL), dimension(N_SLS,ATT1,ATT2,ATT3,ATT4) :: factor_common_crust_mantle
+
+ real(kind=CUSTOM_REAL), dimension(N_SLS,ATT1,ATT2,ATT3,ATT5) :: factor_common_inner_core
+
+ 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
+
+ integer :: npoin2D_max_all,NDIM_smaller_buffers
+
+! receiver information
+ integer :: nrec,ios
+ character(len=150) :: STATIONS,rec_filename,dummystring
+
+!! DK DK added this for the merged version
+!---- arrays to assemble between chunks
+
+! communication pattern for faces between chunks
+ integer, dimension(NUMMSGS_FACES_VAL) :: imsg_type,iprocfrom_faces,iprocto_faces
+
+! communication pattern for corners between chunks
+ integer, dimension(NCORNERSCHUNKS_VAL) :: iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners
+
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_mesher.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_mesher.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_mesher.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -113,11 +113,6 @@
integer, dimension(NGLOB1D_RADIAL_OC,NUMCORNERS_SHARED) :: iboolcorner_outer_core
integer, dimension(NGLOB1D_RADIAL_IC,NUMCORNERS_SHARED) :: iboolcorner_inner_core
- real(kind=CUSTOM_REAL), dimension(NGLOB1D_RADIAL_CM) :: buffer_send_chunkcorners_scalar,buffer_recv_chunkcorners_scalar
-
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB1D_RADIAL_CM + NGLOB1D_RADIAL_IC) :: &
- buffer_send_chunkcorners_vector,buffer_recv_chunkcorners_vector
-
integer, dimension(NGLOB2DMAX_XMIN_XMAX_CM) :: iboolleft_xi_crust_mantle,iboolright_xi_crust_mantle
integer, dimension(NGLOB2DMAX_YMIN_YMAX_CM) :: iboolleft_eta_crust_mantle,iboolright_eta_crust_mantle
integer, dimension(NGLOB2DMAX_XMIN_XMAX_OC) :: iboolleft_xi_outer_core,iboolright_xi_outer_core
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/get_MPI_1D_buffers.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/get_MPI_1D_buffers.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/get_MPI_1D_buffers.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -88,7 +88,6 @@
! determine if the element falls on the left MPI cut plane
! global point number and coordinates left MPI 1D buffer
-!! DK DK suppressed merged open(unit=10,file=prname(1:len_trim(prname))//'ibool1D_leftxi_lefteta.txt',status='unknown')
! erase the logical mask used to mark points already found
mask_ibool(:) = .false.
@@ -150,7 +149,6 @@
! determine if the element falls on the right MPI cut plane
! global point number and coordinates right MPI 1D buffer
-!! DK DK suppressed merged open(unit=10,file=prname(1:len_trim(prname))//'ibool1D_rightxi_lefteta.txt',status='unknown')
! erase the logical mask used to mark points already found
mask_ibool(:) = .false.
@@ -215,7 +213,6 @@
! determine if the element falls on the left MPI cut plane
! global point number and coordinates left MPI 1D buffer
-!! DK DK suppressed merged open(unit=10,file=prname(1:len_trim(prname))//'ibool1D_leftxi_righteta.txt',status='unknown')
! erase the logical mask used to mark points already found
mask_ibool(:) = .false.
@@ -282,7 +279,6 @@
! determine if the element falls on the right MPI cut plane
! global point number and coordinates right MPI 1D buffer
-!! DK DK suppressed merged open(unit=10,file=prname(1:len_trim(prname))//'ibool1D_rightxi_righteta.txt',status='unknown')
! erase the logical mask used to mark points already found
mask_ibool(:) = .false.
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/get_MPI_cutplanes_eta.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/get_MPI_cutplanes_eta.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/get_MPI_cutplanes_eta.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -71,7 +71,6 @@
!
! global point number and coordinates left MPI cut-plane
-!! DK DK suppressed merged open(unit=10,file=prname(1:len_trim(prname))//'iboolleft_eta.txt',status='unknown')
! erase the logical mask used to mark points already found
mask_ibool(:) = .false.
@@ -126,7 +125,6 @@
nspec2Dtheor = NSPEC2D_XI_FACE(iregion,2)
! global point number and coordinates right MPI cut-plane
-!! DK DK suppressed merged open(unit=10,file=prname(1:len_trim(prname))//'iboolright_eta.txt',status='unknown')
! erase the logical mask used to mark points already found
mask_ibool(:) = .false.
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/get_MPI_cutplanes_xi.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/get_MPI_cutplanes_xi.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/get_MPI_cutplanes_xi.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -72,7 +72,6 @@
!
! global point number and coordinates left MPI cut-plane
-!! DK DK suppressed merged open(unit=10,file=prname(1:len_trim(prname))//'iboolleft_xi.txt',status='unknown')
! erase the logical mask used to mark points already found
mask_ibool(:) = .false.
@@ -127,7 +126,6 @@
nspec2Dtheor = NSPEC2D_ETA_FACE(iregion,2)
! global point number and coordinates right MPI cut-plane
-!! DK DK suppressed merged open(unit=10,file=prname(1:len_trim(prname))//'iboolright_xi.txt',status='unknown')
! erase the logical mask used to mark points already found
mask_ibool(:) = .false.
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/locate_receivers.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/locate_receivers.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/locate_receivers.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -616,7 +616,6 @@
! main process broadcasts the results to all the slices
call MPI_BCAST(nrec,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BARRIER(MPI_COMM_WORLD,ier)
call MPI_BCAST(islice_selected_rec,nrec,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
call MPI_BCAST(ispec_selected_rec,nrec,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/main_program.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/main_program.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/main_program.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -531,7 +531,7 @@
ROTATE_SEISMOGRAMS_RT,HONOR_1D_SPHERICAL_MOHO,WRITE_SEISMOGRAMS_BY_MASTER,&
SAVE_ALL_SEISMOS_IN_ONE_FILE,USE_BINARY_FOR_LARGE_FILE
- character(len=150) OUTPUT_FILES,LOCAL_PATH,MODEL
+ character(len=150) OUTPUT_FILES,MODEL
! parameters deduced from parameters read from file
integer NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube
@@ -632,1285 +632,18 @@
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')
+! YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY
-! 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',action='write')
-
-! 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
-! read the parameter file and compute 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,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,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.)
-
- if(err_occurred() /= 0) then
- call exit_MPI(myrank,'an error occurred while reading the parameter file')
- endif
-
-! count the total number of sources in the CMTSOLUTION file
- call count_number_of_sources(NSOURCES)
-
- bcast_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,RMOHO_FICTITIOUS_IN_MESHER, &
- 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,REFERENCE_1D_MODEL,THREE_D_MODEL,NPROC,NPROCTOT, &
- NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube,&
- MOVIE_VOLUME_TYPE,MOVIE_START,MOVIE_STOP/)
-
- bcast_logical = (/TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE,ANISOTROPIC_INNER_CORE, &
- CRUSTAL,ELLIPTICITY,GRAVITY,ONE_CRUST,ROTATION,ISOTROPIC_3D_MANTLE, &
- TOPOGRAPHY,OCEANS,MOVIE_SURFACE,MOVIE_VOLUME,ATTENUATION_3D, &
- RECEIVERS_CAN_BE_BURIED,PRINT_SOURCE_TIME_FUNCTION, &
- SAVE_MESH_FILES,ATTENUATION, &
- ABSORBING_CONDITIONS,INCLUDE_CENTRAL_CUBE,INFLATE_CENTRAL_CUBE,SAVE_FORWARD,CASE_3D,&
- CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA,SAVE_ALL_SEISMOS_IN_ONE_FILE/)
-
- bcast_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/)
-
- endif
-
-! broadcast the information read on the master to the nodes
- call MPI_BCAST(bcast_integer,38,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
-
- call MPI_BCAST(bcast_double_precision,30,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
-
- call MPI_BCAST(bcast_logical,25,MPI_LOGICAL,0,MPI_COMM_WORLD,ier)
-
- call MPI_BCAST(LOCAL_PATH,150,MPI_CHARACTER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(MODEL,150,MPI_CHARACTER,0,MPI_COMM_WORLD,ier)
-
- call MPI_BCAST(ner,MAX_NUMBER_OF_MESH_LAYERS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(ratio_sampling_array,MAX_NUMBER_OF_MESH_LAYERS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(doubling_index,MAX_NUMBER_OF_MESH_LAYERS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
-
- call MPI_BCAST(r_bottom,MAX_NUMBER_OF_MESH_LAYERS,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(r_top,MAX_NUMBER_OF_MESH_LAYERS,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(rmins,MAX_NUMBER_OF_MESH_LAYERS,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(rmaxs,MAX_NUMBER_OF_MESH_LAYERS,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(rmaxs,MAX_NUMBER_OF_MESH_LAYERS,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
-
- call MPI_BCAST(this_region_has_a_doubling,MAX_NUMBER_OF_MESH_LAYERS,MPI_LOGICAL,0,MPI_COMM_WORLD,ier)
-
- call MPI_BCAST(NSPEC,MAX_NUM_REGIONS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(NSPEC2D_XI,MAX_NUM_REGIONS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(NSPEC2D_ETA,MAX_NUM_REGIONS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(NSPEC2DMAX_XMIN_XMAX,MAX_NUM_REGIONS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(NSPEC2DMAX_YMIN_YMAX,MAX_NUM_REGIONS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(NSPEC2D_BOTTOM,MAX_NUM_REGIONS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(NSPEC2D_TOP,MAX_NUM_REGIONS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(NSPEC1D_RADIAL,MAX_NUM_REGIONS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(NGLOB1D_RADIAL,MAX_NUM_REGIONS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(NGLOB2DMAX_XMIN_XMAX,MAX_NUM_REGIONS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(NGLOB2DMAX_YMIN_YMAX,MAX_NUM_REGIONS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(NGLOB,MAX_NUM_REGIONS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
-
- call MPI_BCAST(DIFF_NSPEC1D_RADIAL,NB_SQUARE_CORNERS*NB_CUT_CASE,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(DIFF_NSPEC2D_ETA,NB_SQUARE_EDGES_ONEDIR*NB_CUT_CASE,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(DIFF_NSPEC2D_XI,NB_SQUARE_EDGES_ONEDIR*NB_CUT_CASE,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
-
- if (myrank /=0) then
-
- MIN_ATTENUATION_PERIOD = bcast_integer(1)
- MAX_ATTENUATION_PERIOD = bcast_integer(2)
- NER_CRUST = bcast_integer(3)
- NER_80_MOHO = bcast_integer(4)
- NER_220_80 = bcast_integer(5)
- NER_400_220 = bcast_integer(6)
- NER_600_400 = bcast_integer(7)
- NER_670_600 = bcast_integer(8)
- NER_771_670 = bcast_integer(9)
- NER_TOPDDOUBLEPRIME_771 = bcast_integer(10)
- NER_CMB_TOPDDOUBLEPRIME = bcast_integer(11)
- NER_OUTER_CORE = bcast_integer(12)
- NER_TOP_CENTRAL_CUBE_ICB = bcast_integer(13)
- NEX_XI = bcast_integer(14)
- NEX_ETA = bcast_integer(15)
- RMOHO_FICTITIOUS_IN_MESHER = bcast_integer(16)
- NPROC_XI = bcast_integer(17)
- NPROC_ETA = bcast_integer(18)
- NTSTEP_BETWEEN_OUTPUT_SEISMOS = bcast_integer(19)
- NTSTEP_BETWEEN_READ_ADJSRC = bcast_integer(20)
- NSTEP = bcast_integer(21)
- NSOURCES = bcast_integer(22)
- NTSTEP_BETWEEN_FRAMES = bcast_integer(23)
- NTSTEP_BETWEEN_OUTPUT_INFO = bcast_integer(24)
- NUMBER_OF_RUNS = bcast_integer(25)
- NUMBER_OF_THIS_RUN = bcast_integer(26)
- NCHUNKS = bcast_integer(27)
- SIMULATION_TYPE = bcast_integer(28)
- REFERENCE_1D_MODEL = bcast_integer(29)
- THREE_D_MODEL = bcast_integer(30)
- NPROC = bcast_integer(31)
- NPROCTOT = bcast_integer(32)
- NEX_PER_PROC_XI = bcast_integer(33)
- NEX_PER_PROC_ETA = bcast_integer(34)
- ratio_divide_central_cube = bcast_integer(35)
- MOVIE_VOLUME_TYPE = bcast_integer(36)
- MOVIE_START = bcast_integer(37)
- MOVIE_STOP = bcast_integer(38)
-
- TRANSVERSE_ISOTROPY = bcast_logical(1)
- ANISOTROPIC_3D_MANTLE = bcast_logical(2)
- ANISOTROPIC_INNER_CORE = bcast_logical(3)
- CRUSTAL = bcast_logical(4)
- ELLIPTICITY = bcast_logical(5)
- GRAVITY = bcast_logical(6)
- ONE_CRUST = bcast_logical(7)
- ROTATION = bcast_logical(8)
- ISOTROPIC_3D_MANTLE = bcast_logical(9)
- TOPOGRAPHY = bcast_logical(10)
- OCEANS = bcast_logical(11)
- MOVIE_SURFACE = bcast_logical(12)
- MOVIE_VOLUME = bcast_logical(13)
- ATTENUATION_3D = bcast_logical(14)
- RECEIVERS_CAN_BE_BURIED = bcast_logical(15)
- PRINT_SOURCE_TIME_FUNCTION = bcast_logical(16)
- SAVE_MESH_FILES = bcast_logical(17)
- ATTENUATION = bcast_logical(18)
- ABSORBING_CONDITIONS = bcast_logical(19)
- INCLUDE_CENTRAL_CUBE = bcast_logical(20)
- INFLATE_CENTRAL_CUBE = bcast_logical(21)
- SAVE_FORWARD = bcast_logical(22)
- CASE_3D = bcast_logical(23)
- CUT_SUPERBRICK_XI = bcast_logical(24)
- CUT_SUPERBRICK_ETA = bcast_logical(25)
- SAVE_ALL_SEISMOS_IN_ONE_FILE = bcast_logical(26)
-
- DT = bcast_double_precision(1)
- ANGULAR_WIDTH_XI_IN_DEGREES = bcast_double_precision(2)
- ANGULAR_WIDTH_ETA_IN_DEGREES = bcast_double_precision(3)
- CENTER_LONGITUDE_IN_DEGREES = bcast_double_precision(4)
- CENTER_LATITUDE_IN_DEGREES = bcast_double_precision(5)
- GAMMA_ROTATION_AZIMUTH = bcast_double_precision(6)
- ROCEAN = bcast_double_precision(7)
- RMIDDLE_CRUST = bcast_double_precision(8)
- RMOHO = bcast_double_precision(9)
- R80 = bcast_double_precision(10)
- R120 = bcast_double_precision(11)
- R220 = bcast_double_precision(12)
- R400 = bcast_double_precision(13)
- R600 = bcast_double_precision(14)
- R670 = bcast_double_precision(15)
- R771 = bcast_double_precision(16)
- RTOPDDOUBLEPRIME = bcast_double_precision(17)
- RCMB = bcast_double_precision(18)
- RICB = bcast_double_precision(19)
- R_CENTRAL_CUBE = bcast_double_precision(20)
- RHO_TOP_OC = bcast_double_precision(21)
- RHO_BOTTOM_OC = bcast_double_precision(22)
- RHO_OCEANS = bcast_double_precision(23)
- HDUR_MOVIE = bcast_double_precision(24)
- MOVIE_TOP = bcast_double_precision(25)
- MOVIE_BOTTOM = bcast_double_precision(26)
- MOVIE_WEST = bcast_double_precision(27)
- MOVIE_EAST = bcast_double_precision(28)
- MOVIE_NORTH = bcast_double_precision(29)
- MOVIE_SOUTH = bcast_double_precision(30)
-
- endif
-
-! check that the code is running with the requested number of processes
- if(sizeprocs /= NPROCTOT) call exit_MPI(myrank,'wrong number of MPI processes')
-
-! dynamic allocation of mesh arrays
- allocate(addressing(NCHUNKS,0:NPROC_XI-1,0:NPROC_ETA-1),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(ichunk_slice(0:NPROCTOT-1),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(iproc_xi_slice(0:NPROCTOT-1),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(iproc_eta_slice(0:NPROCTOT-1),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- 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
-!! DK DK suppressed this for merged
-!! DK DK suppressed this for merged open(unit=IOUT,file=trim(OUTPUT_FILES)//'/addressing.txt',status='unknown')
- 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
-!! DK DK suppressed this for merged
-!! DK DK suppressed this for merged if(myrank == 0) write(IOUT,*) iprocnum,ichunk,iproc_xi,iproc_eta
- enddo
- enddo
- enddo
-!! DK DK suppressed this for merged
-!! DK DK suppressed this for merged if(myrank == 0) close(IOUT)
-
-! this for the different counters (which are now different if the superbrick is cut in the outer core)
- 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
-
- if(myrank == 0) then
- write(IMAIN,*) 'This is process ',myrank
- write(IMAIN,*) 'There are ',sizeprocs,' MPI processes'
- write(IMAIN,*) 'Processes are numbered from 0 to ',sizeprocs-1
- write(IMAIN,*)
- write(IMAIN,*) 'There 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,*)
- endif
-
- if(myrank == 0) then
-
- 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(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,*)
-
- endif
- if(ELLIPTICITY) call make_ellipticity(nspl,rspl,espl,espl2,ONE_CRUST)
-
- if(ISOTROPIC_3D_MANTLE) then
- if(THREE_D_MODEL /= 0) call read_smooth_moho
- if(THREE_D_MODEL == THREE_D_MODEL_S20RTS) then
-! the variables read are declared and stored in structure D3MM_V
- if(myrank == 0) call read_mantle_model(D3MM_V)
-! broadcast the information read on the master to the nodes
- call MPI_BCAST(D3MM_V%dvs_a,(NK+1)*(NS+1)*(NS+1),MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(D3MM_V%dvs_b,(NK+1)*(NS+1)*(NS+1),MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(D3MM_V%dvp_a,(NK+1)*(NS+1)*(NS+1),MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(D3MM_V%dvp_b,(NK+1)*(NS+1)*(NS+1),MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(D3MM_V%spknt,NK+1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(D3MM_V%qq0,(NK+1)*(NK+1),MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(D3MM_V%qq,3*(NK+1)*(NK+1),MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- elseif(THREE_D_MODEL == THREE_D_MODEL_SEA99_JP3D) then
-! the variables read are declared and stored in structure SEA99M_V and JP3DM_V
- if(myrank == 0) then
- call read_sea99_s_model(SEA99M_V)
- call read_iso3d_dpzhao_model(JP3DM_V)
- endif
-! broadcast the information read on the master to the nodes
-! SEA99M_V
- call MPI_BCAST(SEA99M_V%sea99_ndep,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%sea99_nlat,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%sea99_nlon,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%sea99_ddeg,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%alatmin,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%alatmax,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%alonmin,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%alonmax,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%sea99_vs,100*100*100,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%sea99_depth,100,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
-! JP3DM_V
- call MPI_BCAST(JP3DM_V%NPA,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%NRA,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%NHA,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%NPB,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%NRB,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%NHB,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PNA,MPA,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RNA,MRA,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HNA,MHA,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PNB,MPB,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RNB,MRB,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HNB,MHB,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%VELAP,MPA*MRA*MHA,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%VELBP,MPB*MRB*MHB,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PN,51,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RRN,63,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%DEPA,51*63,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%DEPB,51*63,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%DEPC,51*63,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IPLOCA,MKA,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IRLOCA,MKA,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IHLOCA,MKA,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IPLOCB,MKB,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IRLOCB,MKB,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IHLOCB,MKB,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PLA,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RLA,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HLA,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PLB,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RLB,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HLB,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IP,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%JP,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%KP,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IP1,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%JP1,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%KP1,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%WV,8,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%P,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%R,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%H,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PF,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RF,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HF,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PF1,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RF1,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HF1,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PD,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RD,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HD,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%VP,29,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%VS,29,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RA,29,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%DEPJ,29,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- elseif(THREE_D_MODEL == THREE_D_MODEL_SEA99) then
-! the variables read are declared and stored in structure SEA99M_V
- if(myrank == 0) call read_sea99_s_model(SEA99M_V)
-! broadcast the information read on the master to the nodes
-! SEA99M_V
- call MPI_BCAST(SEA99M_V%sea99_ndep,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%sea99_nlat,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%sea99_nlon,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%sea99_ddeg,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%alatmin,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%alatmax,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%alonmin,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%alonmax,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%sea99_vs,100*100*100,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(SEA99M_V%sea99_depth,100,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- elseif(THREE_D_MODEL == THREE_D_MODEL_JP3D) then
-! the variables read are declared and stored in structure JP3DM_V
- if(myrank == 0) call read_iso3d_dpzhao_model(JP3DM_V)
-! JP3DM_V
- call MPI_BCAST(JP3DM_V%NPA,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%NRA,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%NHA,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%NPB,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%NRB,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%NHB,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PNA,MPA,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RNA,MRA,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HNA,MHA,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PNB,MPB,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RNB,MRB,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HNB,MHB,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%VELAP,MPA*MRA*MHA,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%VELBP,MPB*MRB*MHB,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PN,51,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RRN,63,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%DEPA,51*63,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%DEPB,51*63,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%DEPC,51*63,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IPLOCA,MKA,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IRLOCA,MKA,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IHLOCA,MKA,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IPLOCB,MKB,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IRLOCB,MKB,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IHLOCB,MKB,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PLA,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RLA,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HLA,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PLB,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RLB,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HLB,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IP,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%JP,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%KP,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%IP1,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%JP1,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%KP1,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%WV,8,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%P,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%R,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%H,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PF,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RF,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HF,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PF1,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RF1,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HF1,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%PD,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RD,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%HD,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%VP,29,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%VS,29,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%RA,29,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(JP3DM_V%DEPJ,29,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- elseif(THREE_D_MODEL == THREE_D_MODEL_S362ANI .or. THREE_D_MODEL == THREE_D_MODEL_S362WMANI &
- .or. THREE_D_MODEL == THREE_D_MODEL_S362ANI_PREM .or. THREE_D_MODEL == THREE_D_MODEL_S29EA) then
- if(myrank == 0) call read_model_s362ani(THREE_D_MODEL,THREE_D_MODEL_S362ANI,THREE_D_MODEL_S362WMANI, &
- THREE_D_MODEL_S362ANI_PREM,THREE_D_MODEL_S29EA, &
- numker,numhpa,ihpa,lmxhpa,itypehpa,ihpakern,numcoe,ivarkern,itpspl, &
- xlaspl,xlospl,radspl,coe,hsplfl,dskker,kerstr,varstr,refmdl)
- call MPI_BCAST(numker,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(numhpa,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(ihpa,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(lmxhpa,maxhpa,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(itypehpa,maxhpa,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(ihpakern,maxker,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(numcoe,maxhpa,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(ivarkern,maxker,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(itpspl,maxcoe*maxhpa,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
-
- call MPI_BCAST(xlaspl,maxcoe*maxhpa,MPI_REAL,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(xlospl,maxcoe*maxhpa,MPI_REAL,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(radspl,maxcoe*maxhpa,MPI_REAL,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(coe,maxcoe*maxker,MPI_REAL,0,MPI_COMM_WORLD,ier)
-
- call MPI_BCAST(hsplfl,80*maxhpa,MPI_CHARACTER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(dskker,40*maxker,MPI_CHARACTER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(kerstr,80,MPI_CHARACTER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(refmdl,80,MPI_CHARACTER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(varstr,40*maxker,MPI_CHARACTER,0,MPI_COMM_WORLD,ier)
-
- else
- call exit_MPI(myrank,'3D model not defined')
- endif
- endif
-
- if(ANISOTROPIC_3D_MANTLE) then
-! the variables read are declared and stored in structure AMM_V
- if(myrank == 0) call read_aniso_mantle_model(AMM_V)
-! broadcast the information read on the master to the nodes
- call MPI_BCAST(AMM_V%npar1,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(AMM_V%beta,14*34*37*73,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(AMM_V%pro,47,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- endif
-
- if(CRUSTAL) then
-! the variables read are declared and stored in structure CM_V
- if(myrank == 0) call read_crustal_model(CM_V)
-! broadcast the information read on the master to the nodes
- call MPI_BCAST(CM_V%thlr,NKEYS_CRUST*NLAYERS_CRUST,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(CM_V%velocp,NKEYS_CRUST*NLAYERS_CRUST,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(CM_V%velocs,NKEYS_CRUST*NLAYERS_CRUST,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(CM_V%dens,NKEYS_CRUST*NLAYERS_CRUST,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(CM_V%abbreviation,NCAP_CRUST*NCAP_CRUST,MPI_CHARACTER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(CM_V%code,2*NKEYS_CRUST,MPI_CHARACTER,0,MPI_COMM_WORLD,ier)
- endif
-
- if(ANISOTROPIC_INNER_CORE) then
- if(myrank == 0) call read_aniso_inner_core_model
-! one should add an MPI_BCAST here if one adds a read_aniso_inner_core_model subroutine
- endif
-
- if(ATTENUATION .and. ATTENUATION_3D) then
- if(myrank == 0) call read_attenuation_model(MIN_ATTENUATION_PERIOD, MAX_ATTENUATION_PERIOD, AM_V)
-
- call MPI_BCAST(AM_V%min_period, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ier)
- call MPI_BCAST(AM_V%max_period, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ier)
- call MPI_BCAST(AM_V%QT_c_source, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ier)
- call MPI_BCAST(AM_V%Qtau_s(1), 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ier)
- call MPI_BCAST(AM_V%Qtau_s(2), 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ier)
- call MPI_BCAST(AM_V%Qtau_s(3), 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ier)
- endif
-
- if(ATTENUATION .and. .not. ATTENUATION_3D) then
- if(myrank == 0) call read_attenuation_model(MIN_ATTENUATION_PERIOD, MAX_ATTENUATION_PERIOD, AM_V)
-
- call MPI_BCAST(AM_V%min_period, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ier)
- call MPI_BCAST(AM_V%max_period, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ier)
-
- call attenuation_model_setup(REFERENCE_1D_MODEL, RICB, RCMB, R670, R220, R80,AM_V,M1066a_V,Mak135_V,Mref_V,SEA1DM_V,AM_S,AS_V)
- endif
-
-! read topography and bathymetry file
- if(TOPOGRAPHY .or. OCEANS) then
- if(myrank == 0) call read_topo_bathy_file(ibathy_topo)
-! broadcast the information read on the master to the nodes
- call MPI_BCAST(ibathy_topo,NX_BATHY*NY_BATHY,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- endif
-
-! get addressing for this process
- ichunk = ichunk_slice(myrank)
- iproc_xi = iproc_xi_slice(myrank)
- iproc_eta = iproc_eta_slice(myrank)
-
- if(myrank == 0) then
- 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'
- endif
-
-! 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)
-
-! 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
-!----
-
!! DK DK for the merged version
- include 'allocate_before.f90'
+!!!!!!!! DK DK mesher inserted here
+!!!!!!!! DK DK mesher inserted here
+!!!!!!!! DK DK mesher inserted here
+ include 'call_meshfem1.f90'
-!! DK DK for the merged version
- allocate(ibool1D_leftxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(ibool1D_rightxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(ibool1D_leftxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(ibool1D_rightxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- allocate(xread1D_leftxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(xread1D_rightxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(xread1D_leftxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(xread1D_rightxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- allocate(yread1D_leftxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(yread1D_rightxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(yread1D_leftxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(yread1D_rightxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- allocate(zread1D_leftxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(zread1D_rightxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(zread1D_leftxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(zread1D_rightxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
-! 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(xstore(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(ystore(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
- allocate(zstore(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)),STAT=ier)
- if (ier /= 0) then
- print *,"ABORTING can not allocate in meshfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
-! create all the regions of the mesh
-! perform two passes in this part to be able to save memory
- do ipass = 1,2
-
-!! DK DK for merged version
- if(iregion_code == IREGION_CRUST_MANTLE) then
-! crust_mantle
- call create_regions_mesh(iregion_code,ibool_crust_mantle,idoubling_crust_mantle, &
- xstore,ystore,zstore,rmins,rmaxs,iproc_xi,iproc_eta,ichunk,NSPEC(iregion_code),nspec_aniso, &
- volume_local,area_local_bottom,area_local_top,nspl,rspl,espl,espl2,nglob(iregion_code),npointot, &
- 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),ELLIPTICITY,TOPOGRAPHY,TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE, &
- ANISOTROPIC_INNER_CORE,ISOTROPIC_3D_MANTLE,CRUSTAL,ONE_CRUST, &
- NPROC_XI,NPROC_ETA,NSPEC2D_XI_FACE,NSPEC2D_ETA_FACE,NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER, &
- myrank,LOCAL_PATH,OCEANS,ibathy_topo,rotation_matrix,ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD, &
- ATTENUATION,ATTENUATION_3D,NCHUNKS,INCLUDE_CENTRAL_CUBE,ABSORBING_CONDITIONS,REFERENCE_1D_MODEL,THREE_D_MODEL, &
- R_CENTRAL_CUBE,RICB,RHO_OCEANS,RCMB,R670,RMOHO,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,CASE_3D, &
- AMM_V,AM_V,M1066a_V,Mak135_V,Mref_V,SEA1DM_V,D3MM_V,JP3DM_V,SEA99M_V,CM_V, AM_S, AS_V, &
- numker,numhpa,numcof,ihpa,lmax,nylm,lmxhpa,itypehpa,ihpakern,numcoe,ivarkern, &
- nconpt,iver,iconpt,conpt,xlaspl,xlospl,radspl, &
- coe,vercof,vercofd,ylmcof,wk1,wk2,wk3,kerstr,varstr,ipass,ratio_divide_central_cube,HONOR_1D_SPHERICAL_MOHO,&
- CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA,mod(iproc_xi_slice(myrank),2),mod(iproc_eta_slice(myrank),2), &
- iboolleft_xi_crust_mantle,iboolright_xi_crust_mantle,iboolleft_eta_crust_mantle,iboolright_eta_crust_mantle, &
- NGLOB2DMAX_XMIN_XMAX_CM,NGLOB2DMAX_YMIN_YMAX_CM, &
- ibool1D_leftxi_lefteta,ibool1D_rightxi_lefteta, &
- ibool1D_leftxi_righteta,ibool1D_rightxi_righteta,maxval(NGLOB1D_RADIAL_CORNER(iregion_code,:)), &
- nspec2D_xmin_crust_mantle,nspec2D_xmax_crust_mantle,nspec2D_ymin_crust_mantle,nspec2D_ymax_crust_mantle, &
- ibelm_xmin_crust_mantle,ibelm_xmax_crust_mantle,ibelm_ymin_crust_mantle,ibelm_ymax_crust_mantle, &
- ibelm_bottom_crust_mantle, ibelm_top_crust_mantle, &
- xread1D_leftxi_lefteta, xread1D_rightxi_lefteta, xread1D_leftxi_righteta, xread1D_rightxi_righteta, &
- yread1D_leftxi_lefteta, yread1D_rightxi_lefteta, yread1D_leftxi_righteta, yread1D_rightxi_righteta, &
- zread1D_leftxi_lefteta, zread1D_rightxi_lefteta, zread1D_leftxi_righteta, zread1D_rightxi_righteta, &
- jacobian2D_xmin_crust_mantle,jacobian2D_xmax_crust_mantle, &
- jacobian2D_ymin_crust_mantle,jacobian2D_ymax_crust_mantle,jacobian2D_bottom_crust_mantle,jacobian2D_top_crust_mantle, &
- normal_xmin_crust_mantle,normal_xmax_crust_mantle,normal_ymin_crust_mantle, &
- normal_ymax_crust_mantle,normal_bottom_crust_mantle,normal_top_crust_mantle, &
- kappavstore_crust_mantle,kappahstore_crust_mantle,muvstore_crust_mantle,muhstore_crust_mantle,eta_anisostore_crust_mantle, &
- rmass_crust_mantle,xelm_store_crust_mantle,yelm_store_crust_mantle,zelm_store_crust_mantle, &
-!! DK DK this will have to change to fully support David's code to cut the superbrick
- npoin2D_xi_crust_mantle(1),npoin2D_eta_crust_mantle(1))
-
- else if(iregion_code == IREGION_OUTER_CORE) then
-! outer_core
- call create_regions_mesh(iregion_code,ibool_outer_core,idoubling_outer_core, &
- xstore,ystore,zstore,rmins,rmaxs,iproc_xi,iproc_eta,ichunk,NSPEC(iregion_code),nspec_aniso, &
- volume_local,area_local_bottom,area_local_top,nspl,rspl,espl,espl2,nglob(iregion_code),npointot, &
- 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), &
- ELLIPTICITY,TOPOGRAPHY,TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE, &
- ANISOTROPIC_INNER_CORE,ISOTROPIC_3D_MANTLE,CRUSTAL,ONE_CRUST, &
- NPROC_XI,NPROC_ETA,NSPEC2D_XI_FACE,NSPEC2D_ETA_FACE,NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER, &
- myrank,LOCAL_PATH,OCEANS,ibathy_topo,rotation_matrix,ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD, &
- ATTENUATION,ATTENUATION_3D,NCHUNKS,INCLUDE_CENTRAL_CUBE,ABSORBING_CONDITIONS,REFERENCE_1D_MODEL,THREE_D_MODEL, &
- R_CENTRAL_CUBE,RICB,RHO_OCEANS,RCMB,R670,RMOHO,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,CASE_3D, &
- AMM_V,AM_V,M1066a_V,Mak135_V,Mref_V,SEA1DM_V,D3MM_V,JP3DM_V,SEA99M_V,CM_V, AM_S, AS_V, &
- numker,numhpa,numcof,ihpa,lmax,nylm,lmxhpa,itypehpa,ihpakern,numcoe,ivarkern, &
- nconpt,iver,iconpt,conpt,xlaspl,xlospl,radspl, &
- coe,vercof,vercofd,ylmcof,wk1,wk2,wk3,kerstr,varstr,ipass,ratio_divide_central_cube,HONOR_1D_SPHERICAL_MOHO,&
- CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA,mod(iproc_xi_slice(myrank),2),mod(iproc_eta_slice(myrank),2), &
- iboolleft_xi_outer_core,iboolright_xi_outer_core,iboolleft_eta_outer_core,iboolright_eta_outer_core, &
- NGLOB2DMAX_XMIN_XMAX_OC,NGLOB2DMAX_YMIN_YMAX_OC, &
- ibool1D_leftxi_lefteta,ibool1D_rightxi_lefteta, &
- ibool1D_leftxi_righteta,ibool1D_rightxi_righteta,maxval(NGLOB1D_RADIAL_CORNER(iregion_code,:)), &
- nspec2D_xmin_outer_core,nspec2D_xmax_outer_core,nspec2D_ymin_outer_core,nspec2D_ymax_outer_core, &
- ibelm_xmin_outer_core,ibelm_xmax_outer_core,ibelm_ymin_outer_core,ibelm_ymax_outer_core, &
- ibelm_bottom_outer_core, ibelm_top_outer_core, &
- xread1D_leftxi_lefteta, xread1D_rightxi_lefteta, xread1D_leftxi_righteta, xread1D_rightxi_righteta, &
- yread1D_leftxi_lefteta, yread1D_rightxi_lefteta, yread1D_leftxi_righteta, yread1D_rightxi_righteta, &
- zread1D_leftxi_lefteta, zread1D_rightxi_lefteta, zread1D_leftxi_righteta, zread1D_rightxi_righteta, &
- jacobian2D_xmin_outer_core,jacobian2D_xmax_outer_core, &
- jacobian2D_ymin_outer_core,jacobian2D_ymax_outer_core,jacobian2D_bottom_outer_core,jacobian2D_top_outer_core, &
- normal_xmin_outer_core,normal_xmax_outer_core,normal_ymin_outer_core, &
- normal_ymax_outer_core,normal_bottom_outer_core,normal_top_outer_core, &
- kappavstore_outer_core,kappahstore_outer_core,muvstore_outer_core,muhstore_outer_core,eta_anisostore_outer_core, &
- rmass_outer_core,xelm_store_outer_core,yelm_store_outer_core,zelm_store_outer_core, &
-!! DK DK this will have to change to fully support David's code to cut the superbrick
- npoin2D_xi_outer_core(1),npoin2D_eta_outer_core(1))
-
- else if(iregion_code == IREGION_INNER_CORE) then
-! inner_core
- call create_regions_mesh(iregion_code,ibool_inner_core,idoubling_inner_core, &
- xstore,ystore,zstore,rmins,rmaxs,iproc_xi,iproc_eta,ichunk,NSPEC(iregion_code),nspec_aniso, &
- volume_local,area_local_bottom,area_local_top,nspl,rspl,espl,espl2,nglob(iregion_code),npointot, &
- 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), &
- ELLIPTICITY,TOPOGRAPHY,TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE, &
- ANISOTROPIC_INNER_CORE,ISOTROPIC_3D_MANTLE,CRUSTAL,ONE_CRUST, &
- NPROC_XI,NPROC_ETA,NSPEC2D_XI_FACE,NSPEC2D_ETA_FACE,NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER, &
- myrank,LOCAL_PATH,OCEANS,ibathy_topo,rotation_matrix,ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD, &
- ATTENUATION,ATTENUATION_3D,NCHUNKS,INCLUDE_CENTRAL_CUBE,ABSORBING_CONDITIONS,REFERENCE_1D_MODEL,THREE_D_MODEL, &
- R_CENTRAL_CUBE,RICB,RHO_OCEANS,RCMB,R670,RMOHO,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,CASE_3D, &
- AMM_V,AM_V,M1066a_V,Mak135_V,Mref_V,SEA1DM_V,D3MM_V,JP3DM_V,SEA99M_V,CM_V, AM_S, AS_V, &
- numker,numhpa,numcof,ihpa,lmax,nylm,lmxhpa,itypehpa,ihpakern,numcoe,ivarkern, &
- nconpt,iver,iconpt,conpt,xlaspl,xlospl,radspl, &
- coe,vercof,vercofd,ylmcof,wk1,wk2,wk3,kerstr,varstr,ipass,ratio_divide_central_cube,HONOR_1D_SPHERICAL_MOHO,&
- CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA,mod(iproc_xi_slice(myrank),2),mod(iproc_eta_slice(myrank),2), &
- iboolleft_xi_inner_core,iboolright_xi_inner_core,iboolleft_eta_inner_core,iboolright_eta_inner_core, &
- NGLOB2DMAX_XMIN_XMAX_IC,NGLOB2DMAX_YMIN_YMAX_IC,ibool1D_leftxi_lefteta,ibool1D_rightxi_lefteta, &
- ibool1D_leftxi_righteta,ibool1D_rightxi_righteta,maxval(NGLOB1D_RADIAL_CORNER(iregion_code,:)), &
- nspec2D_xmin_inner_core,nspec2D_xmax_inner_core,nspec2D_ymin_inner_core,nspec2D_ymax_inner_core, &
- ibelm_xmin_inner_core,ibelm_xmax_inner_core,ibelm_ymin_inner_core,ibelm_ymax_inner_core, &
- ibelm_bottom_inner_core, ibelm_top_inner_core, &
- xread1D_leftxi_lefteta, xread1D_rightxi_lefteta, xread1D_leftxi_righteta, xread1D_rightxi_righteta, &
- yread1D_leftxi_lefteta, yread1D_rightxi_lefteta, yread1D_leftxi_righteta, yread1D_rightxi_righteta, &
- zread1D_leftxi_lefteta, zread1D_rightxi_lefteta, zread1D_leftxi_righteta, zread1D_rightxi_righteta, &
- jacobian2D_xmin_inner_core,jacobian2D_xmax_inner_core, &
- jacobian2D_ymin_inner_core,jacobian2D_ymax_inner_core,jacobian2D_bottom_inner_core,jacobian2D_top_inner_core, &
- normal_xmin_inner_core,normal_xmax_inner_core,normal_ymin_inner_core, &
- normal_ymax_inner_core,normal_bottom_inner_core,normal_top_inner_core, &
- kappavstore_inner_core,kappahstore_inner_core,muvstore_inner_core,muhstore_inner_core,eta_anisostore_inner_core, &
- rmass_inner_core,xelm_store_inner_core,yelm_store_inner_core,zelm_store_inner_core, &
-!! DK DK this will have to change to fully support David's code to cut the superbrick
- npoin2D_xi_inner_core(1),npoin2D_eta_inner_core(1))
-
- else
- stop 'DK DK incorrect region in merged code'
- endif
-
- enddo ! of loop on ipass = 1,2
-
-! store number of anisotropic elements found in the mantle
- if(nspec_aniso /= 0 .and. iregion_code /= IREGION_CRUST_MANTLE) &
- call exit_MPI(myrank,'found anisotropic elements outside of the mantle')
-
- if(iregion_code == IREGION_CRUST_MANTLE .and. nspec_aniso == 0) &
- call exit_MPI(myrank,'found no anisotropic elements in the mantle')
-
-! 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,*) ' exact 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
-
-!! $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
-
- ! create chunk buffers if more than one chunk
- if(NCHUNKS > 1) then
-
-!! DK DK added this for merged version
- if(iregion_code == IREGION_CRUST_MANTLE) then
-! crust_mantle
- call create_chunk_buffers(iregion_code,NSPEC(iregion_code),ibool_crust_mantle,idoubling_crust_mantle,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,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS, &
- ibool1D_leftxi_lefteta,ibool1D_rightxi_lefteta, &
- ibool1D_leftxi_righteta,ibool1D_rightxi_righteta, &
- nspec2D_xmin_crust_mantle,nspec2D_xmax_crust_mantle,nspec2D_ymin_crust_mantle,nspec2D_ymax_crust_mantle, &
- ibelm_xmin_crust_mantle,ibelm_xmax_crust_mantle,ibelm_ymin_crust_mantle,ibelm_ymax_crust_mantle, &
- xread1D_leftxi_lefteta, xread1D_rightxi_lefteta, xread1D_leftxi_righteta, xread1D_rightxi_righteta, &
- yread1D_leftxi_lefteta, yread1D_rightxi_lefteta, yread1D_leftxi_righteta, yread1D_rightxi_righteta, &
- zread1D_leftxi_lefteta, zread1D_rightxi_lefteta, zread1D_leftxi_righteta, zread1D_rightxi_righteta, &
- iprocfrom_faces,iprocto_faces,imsg_type,iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
- iboolfaces_crust_mantle,npoin2D_faces_crust_mantle,iboolcorner_crust_mantle,NGLOB1D_RADIAL(IREGION_CRUST_MANTLE), &
- NGLOB2DMAX_XY_VAL_CM)
-
- else if(iregion_code == IREGION_OUTER_CORE) then
-! outer_core
- call create_chunk_buffers(iregion_code,NSPEC(iregion_code),ibool_outer_core,idoubling_outer_core,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,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS, &
- ibool1D_leftxi_lefteta,ibool1D_rightxi_lefteta, &
- ibool1D_leftxi_righteta,ibool1D_rightxi_righteta, &
- nspec2D_xmin_outer_core,nspec2D_xmax_outer_core,nspec2D_ymin_outer_core,nspec2D_ymax_outer_core, &
- ibelm_xmin_outer_core,ibelm_xmax_outer_core,ibelm_ymin_outer_core,ibelm_ymax_outer_core, &
- xread1D_leftxi_lefteta, xread1D_rightxi_lefteta, xread1D_leftxi_righteta, xread1D_rightxi_righteta, &
- yread1D_leftxi_lefteta, yread1D_rightxi_lefteta, yread1D_leftxi_righteta, yread1D_rightxi_righteta, &
- zread1D_leftxi_lefteta, zread1D_rightxi_lefteta, zread1D_leftxi_righteta, zread1D_rightxi_righteta, &
- iprocfrom_faces,iprocto_faces,imsg_type,iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
- iboolfaces_outer_core,npoin2D_faces_outer_core,iboolcorner_outer_core,NGLOB1D_RADIAL(IREGION_OUTER_CORE), &
- NGLOB2DMAX_XY_VAL_OC)
-
- else if(iregion_code == IREGION_INNER_CORE) then
-! inner_core
- call create_chunk_buffers(iregion_code,NSPEC(iregion_code),ibool_inner_core,idoubling_inner_core,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,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS, &
- ibool1D_leftxi_lefteta,ibool1D_rightxi_lefteta, &
- ibool1D_leftxi_righteta,ibool1D_rightxi_righteta, &
- nspec2D_xmin_inner_core,nspec2D_xmax_inner_core,nspec2D_ymin_inner_core,nspec2D_ymax_inner_core, &
- ibelm_xmin_inner_core,ibelm_xmax_inner_core,ibelm_ymin_inner_core,ibelm_ymax_inner_core, &
- xread1D_leftxi_lefteta, xread1D_rightxi_lefteta, xread1D_leftxi_righteta, xread1D_rightxi_righteta, &
- yread1D_leftxi_lefteta, yread1D_rightxi_lefteta, yread1D_leftxi_righteta, yread1D_rightxi_righteta, &
- zread1D_leftxi_lefteta, zread1D_rightxi_lefteta, zread1D_leftxi_righteta, zread1D_rightxi_righteta, &
- iprocfrom_faces,iprocto_faces,imsg_type,iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
- iboolfaces_inner_core,npoin2D_faces_inner_core,iboolcorner_inner_core,NGLOB1D_RADIAL(IREGION_INNER_CORE), &
- NGLOB2DMAX_XY_VAL_IC)
-
- else
- stop 'DK DK incorrect region in merged code'
- endif
-
- 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(xstore)
- deallocate(ystore)
- deallocate(zstore)
-
-! make sure everybody is synchronized
- call MPI_BARRIER(MPI_COMM_WORLD,ier)
-
-! end of loop on all the regions
- enddo
-
-!! DK DK for the merged version
- deallocate(ibool1D_leftxi_lefteta)
- deallocate(ibool1D_rightxi_lefteta)
- deallocate(ibool1D_leftxi_righteta)
- deallocate(ibool1D_rightxi_righteta)
-
- deallocate(xread1D_leftxi_lefteta)
- deallocate(xread1D_rightxi_lefteta)
- deallocate(xread1D_leftxi_righteta)
- deallocate(xread1D_rightxi_righteta)
-
- deallocate(yread1D_leftxi_lefteta)
- deallocate(yread1D_rightxi_lefteta)
- deallocate(yread1D_leftxi_righteta)
- deallocate(yread1D_rightxi_righteta)
-
- deallocate(zread1D_leftxi_lefteta)
- deallocate(zread1D_rightxi_lefteta)
- deallocate(zread1D_leftxi_righteta)
- deallocate(zread1D_rightxi_righteta)
-
- 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
-!! DK DK suppressed in the merged version because useless
-! 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)
-
-!! DK DK suppressed in the merged version because useless
-! NGLOB1D_RADIAL_TEMP(:) = &
-! (/maxval(NGLOB1D_RADIAL_CORNER(1,:)),maxval(NGLOB1D_RADIAL_CORNER(2,:)),maxval(NGLOB1D_RADIAL_CORNER(3,:))/)
-
-! create include file for the solver
-!! DK DK suppressed in the merged version because useless
-! call save_header_file(NSPEC,nglob,NEX_XI,NEX_ETA,NPROC,NPROCTOT, &
-! TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE,ANISOTROPIC_INNER_CORE, &
-! ELLIPTICITY,GRAVITY,ROTATION,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)
-
- endif ! end of section executed by main process only
-
-! 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)
-!!!!!!!! DK DK solver inserted here
-!!!!!!!! DK DK solver inserted here
-!!!!!!!! DK DK solver inserted here
+! YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY
!! DK DK for merged version, temporary patch for David's code to cut the superbrick
!! DK DK which I have not fully ported to the merged version yet: I do not
@@ -1935,11 +668,9 @@
NDIM_smaller_buffers = 1
endif
-! --------- receivers ---------------
-
+! read the number of receivers
rec_filename = 'DATA/STATIONS'
call get_value_string(STATIONS, 'solver.STATIONS', rec_filename)
-
! get total number of receivers
if(myrank == 0) then
open(unit=IIN,file=STATIONS,iostat=ios,status='old',action='read')
@@ -1962,13 +693,10 @@
if(nrec < 1) call exit_MPI(myrank,'need at least one receiver')
!! DK DK for the merged version
- include 'call_specfem1.f90'
-!! DK DK for now use variables just to make sure we don't get warning about unused variables
-! include 'oldstuff/dummy_use_variables.f90'
-
!!!!!!!! DK DK solver inserted here
!!!!!!!! DK DK solver inserted here
!!!!!!!! DK DK solver inserted here
+ include 'call_specfem1.f90'
! synchronize all the processes to make sure everybody has finished
call MPI_BARRIER(MPI_COMM_WORLD,ier)
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -365,7 +365,7 @@
ROTATE_SEISMOGRAMS_RT,HONOR_1D_SPHERICAL_MOHO,WRITE_SEISMOGRAMS_BY_MASTER,&
SAVE_ALL_SEISMOS_IN_ONE_FILE,USE_BINARY_FOR_LARGE_FILE
- character(len=150) OUTPUT_FILES,LOCAL_PATH,MODEL
+ character(len=150) OUTPUT_FILES,MODEL
! parameters deduced from parameters read from file
integer NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube
@@ -454,20 +454,6 @@
!! DK DK for the merged version
include 'declarations_mesher.f90'
-! ************** PROGRAM STARTS HERE **************
-
-! initialize the MPI communicator and start the NPROCTOT MPI processes.
- call MPI_INIT(ier)
- if(ier /= 0) stop 'error: cannot start MPI!!!'
-
-! 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')
@@ -506,7 +492,7 @@
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,MODEL,SIMULATION_TYPE,SAVE_FORWARD, &
+ INCLUDE_CENTRAL_CUBE,INFLATE_CENTRAL_CUBE,MODEL,SIMULATION_TYPE,SAVE_FORWARD, &
NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
NSPEC, &
NSPEC2D_XI, &
@@ -561,7 +547,6 @@
call MPI_BCAST(bcast_logical,25,MPI_LOGICAL,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(LOCAL_PATH,150,MPI_CHARACTER,0,MPI_COMM_WORLD,ier)
call MPI_BCAST(MODEL,150,MPI_CHARACTER,0,MPI_COMM_WORLD,ier)
call MPI_BCAST(ner,MAX_NUMBER_OF_MESH_LAYERS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
@@ -906,6 +891,7 @@
write(IMAIN,*)
endif
+
if(ELLIPTICITY) call make_ellipticity(nspl,rspl,espl,espl2,ONE_CRUST)
if(ISOTROPIC_3D_MANTLE) then
@@ -1171,9 +1157,6 @@
! 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
!----
@@ -1326,7 +1309,7 @@
NSPEC2D_BOTTOM(iregion_code),NSPEC2D_TOP(iregion_code),ELLIPTICITY,TOPOGRAPHY,TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE, &
ANISOTROPIC_INNER_CORE,ISOTROPIC_3D_MANTLE,CRUSTAL,ONE_CRUST, &
NPROC_XI,NPROC_ETA,NSPEC2D_XI_FACE,NSPEC2D_ETA_FACE,NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER, &
- myrank,LOCAL_PATH,OCEANS,ibathy_topo,rotation_matrix,ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD, &
+ myrank,OCEANS,ibathy_topo,rotation_matrix,ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD, &
ATTENUATION,ATTENUATION_3D,NCHUNKS,INCLUDE_CENTRAL_CUBE,ABSORBING_CONDITIONS,REFERENCE_1D_MODEL,THREE_D_MODEL, &
R_CENTRAL_CUBE,RICB,RHO_OCEANS,RCMB,R670,RMOHO,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,CASE_3D, &
@@ -1364,7 +1347,7 @@
ELLIPTICITY,TOPOGRAPHY,TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE, &
ANISOTROPIC_INNER_CORE,ISOTROPIC_3D_MANTLE,CRUSTAL,ONE_CRUST, &
NPROC_XI,NPROC_ETA,NSPEC2D_XI_FACE,NSPEC2D_ETA_FACE,NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER, &
- myrank,LOCAL_PATH,OCEANS,ibathy_topo,rotation_matrix,ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD, &
+ myrank,OCEANS,ibathy_topo,rotation_matrix,ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD, &
ATTENUATION,ATTENUATION_3D,NCHUNKS,INCLUDE_CENTRAL_CUBE,ABSORBING_CONDITIONS,REFERENCE_1D_MODEL,THREE_D_MODEL, &
R_CENTRAL_CUBE,RICB,RHO_OCEANS,RCMB,R670,RMOHO,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,CASE_3D, &
@@ -1402,7 +1385,7 @@
ELLIPTICITY,TOPOGRAPHY,TRANSVERSE_ISOTROPY,ANISOTROPIC_3D_MANTLE, &
ANISOTROPIC_INNER_CORE,ISOTROPIC_3D_MANTLE,CRUSTAL,ONE_CRUST, &
NPROC_XI,NPROC_ETA,NSPEC2D_XI_FACE,NSPEC2D_ETA_FACE,NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER, &
- myrank,LOCAL_PATH,OCEANS,ibathy_topo,rotation_matrix,ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD, &
+ myrank,OCEANS,ibathy_topo,rotation_matrix,ANGULAR_WIDTH_XI_RAD,ANGULAR_WIDTH_ETA_RAD, &
ATTENUATION,ATTENUATION_3D,NCHUNKS,INCLUDE_CENTRAL_CUBE,ABSORBING_CONDITIONS,REFERENCE_1D_MODEL,THREE_D_MODEL, &
R_CENTRAL_CUBE,RICB,RHO_OCEANS,RCMB,R670,RMOHO,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,CASE_3D, &
@@ -1585,9 +1568,6 @@
deallocate(ystore)
deallocate(zstore)
-! make sure everybody is synchronized
- call MPI_BARRIER(MPI_COMM_WORLD,ier)
-
! end of loop on all the regions
enddo
@@ -1687,60 +1667,5 @@
close(IMAIN)
endif
-! synchronize all the processes to make sure everybody has finished
- call MPI_BARRIER(MPI_COMM_WORLD,ier)
-
-!! DK DK for merged version, temporary patch for David's code to cut the superbrick
-!! DK DK which I have not fully ported to the merged version yet: I do not
-!! DK DK yet distinguish the two values of each array, therefore let me set them
-!! DK DK equal here
- npoin2D_xi_crust_mantle(2) = npoin2D_xi_crust_mantle(1)
- npoin2D_eta_crust_mantle(2) = npoin2D_eta_crust_mantle(1)
-
- npoin2D_xi_outer_core(2) = npoin2D_xi_outer_core(1)
- npoin2D_eta_outer_core(2) = npoin2D_eta_outer_core(1)
-
- npoin2D_xi_inner_core(2) = npoin2D_xi_inner_core(1)
- npoin2D_eta_inner_core(2) = npoin2D_eta_inner_core(1)
-
-!! DK DK added this to reduce the size of the buffers
-! size of buffers is the sum of two sizes because we handle two regions in the same MPI call
- npoin2D_max_all = max(maxval(npoin2D_xi_crust_mantle(:) + npoin2D_xi_inner_core(:)), &
- maxval(npoin2D_eta_crust_mantle(:) + npoin2D_eta_inner_core(:)))
- if(FEWER_MESSAGES_LARGER_BUFFERS) then
- NDIM_smaller_buffers = NDIM
- else
- NDIM_smaller_buffers = 1
- endif
-
-! --------- receivers ---------------
-
- rec_filename = 'DATA/STATIONS'
- call get_value_string(STATIONS, 'solver.STATIONS', rec_filename)
-
-! get total number of receivers
- if(myrank == 0) then
- open(unit=IIN,file=STATIONS,iostat=ios,status='old',action='read')
- nrec = 0
- do while(ios == 0)
- read(IIN,"(a)",iostat=ios) dummystring
- if(ios == 0) nrec = nrec + 1
- enddo
- close(IIN)
- endif
-! broadcast the information read on the master to the nodes
- call MPI_BCAST(nrec,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
-
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) 'Total number of receivers = ', nrec
- write(IMAIN,*)
- endif
-
- if(nrec < 1) call exit_MPI(myrank,'need at least one receiver')
-
-! synchronize all the processes to make sure everybody has finished
- call MPI_BARRIER(MPI_COMM_WORLD,ier)
-
end subroutine meshfem3D
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/read_compute_parameters.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/read_compute_parameters.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/read_compute_parameters.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -43,7 +43,7 @@
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,MODEL,SIMULATION_TYPE,SAVE_FORWARD, &
+ INCLUDE_CENTRAL_CUBE,INFLATE_CENTRAL_CUBE,MODEL,SIMULATION_TYPE,SAVE_FORWARD, &
NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
NSPEC, &
NSPEC2D_XI, &
@@ -91,7 +91,7 @@
ROTATE_SEISMOGRAMS_RT,WRITE_SEISMOGRAMS_BY_MASTER,&
SAVE_ALL_SEISMOS_IN_ONE_FILE,USE_BINARY_FOR_LARGE_FILE,EMULATE_ONLY
- character(len=150) OUTPUT_FILES,LOCAL_PATH,MODEL
+ character(len=150) OUTPUT_FILES,MODEL
! local variables
integer NEX_MAX
@@ -1060,8 +1060,6 @@
if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
call read_value_integer(NUMBER_OF_THIS_RUN, 'solver.NUMBER_OF_THIS_RUN')
if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
- call read_value_string(LOCAL_PATH, 'LOCAL_PATH')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
call read_value_integer(NTSTEP_BETWEEN_OUTPUT_INFO, 'solver.NTSTEP_BETWEEN_OUTPUT_INFO')
if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
call read_value_integer(NTSTEP_BETWEEN_OUTPUT_SEISMOS, 'solver.NTSTEP_BETWEEN_OUTPUT_SEISMOS')
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.f90 2008-08-07 13:48:28 UTC (rev 12580)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.f90 2008-08-07 14:32:47 UTC (rev 12581)
@@ -356,7 +356,7 @@
!! DK DK added this to reduce the size of the buffers
integer :: npoin2D_max_all,NDIM_smaller_buffers
- integer ichunk,iproc_xi,iproc_eta !!!!!!!!!!!!!!!!!!!!!!,iproc,iproc_read
+ integer ichunk,iproc_xi,iproc_eta
integer NPROC_ONE_DIRECTION
! maximum of the norm of the displacement and of the potential in the fluid
@@ -395,7 +395,7 @@
ROTATE_SEISMOGRAMS_RT,HONOR_1D_SPHERICAL_MOHO,WRITE_SEISMOGRAMS_BY_MASTER,&
SAVE_ALL_SEISMOS_IN_ONE_FILE,USE_BINARY_FOR_LARGE_FILE
- character(len=150) OUTPUT_FILES,LOCAL_PATH,MODEL
+ character(len=150) OUTPUT_FILES,MODEL
! parameters deduced from parameters read from file
integer NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cube
@@ -419,8 +419,6 @@
NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX, &
NGLOB_computed
- character(len=150) prname
-
! lookup table every km for gravity
integer int_radius,idoubling
double precision radius,rho,drhodr,vp,vs,Qkappa,Qmu
@@ -462,10 +460,6 @@
! ************** PROGRAM STARTS HERE **************
-!! DK DK added this for merged version
-! synchronize all the processes to make sure everybody has finished
- call MPI_BARRIER(MPI_COMM_WORLD,ier)
-
! set up GLL points, weights and derivation matrices
call define_derivation_matrices(xigll,yigll,zigll,wxgll,wygll,wzgll, &
hprime_xx,hprime_yy,hprime_zz, &
@@ -514,16 +508,6 @@
!! DK DK impossible YYYYYYYYYYYYY deallocate(yelm_store_inner_core)
!! DK DK impossible YYYYYYYYYYYYY deallocate(zelm_store_inner_core)
-! initialize the MPI communicator and start the NPROCTOT MPI processes.
-!! DK DK suppressed for merged version 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 sizeprocs-1.
-! as usual in MPI, process 0 is in charge of coordinating everything
-! and also takes care of the main output
-!! DK DK suppressed for merged version call MPI_COMM_SIZE(MPI_COMM_WORLD,sizeprocs,ier)
-!! DK DK suppressed for merged version call MPI_COMM_RANK(MPI_COMM_WORLD,myrank,ier)
-
if (myrank == 0) then
! read the parameter file and compute additional parameters
@@ -545,7 +529,7 @@
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,MODEL,SIMULATION_TYPE,SAVE_FORWARD, &
+ INCLUDE_CENTRAL_CUBE,INFLATE_CENTRAL_CUBE,MODEL,SIMULATION_TYPE,SAVE_FORWARD, &
NPROC,NPROCTOT,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
NSPEC_computed, &
NSPEC2D_XI, &
@@ -598,7 +582,6 @@
call MPI_BCAST(bcast_logical,33,MPI_LOGICAL,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(LOCAL_PATH,150,MPI_CHARACTER,0,MPI_COMM_WORLD,ier)
call MPI_BCAST(MODEL,150,MPI_CHARACTER,0,MPI_COMM_WORLD,ier)
call MPI_BCAST(ner,MAX_NUMBER_OF_MESH_LAYERS,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
@@ -1185,10 +1168,6 @@
endif
-! synchronize all the processes before assembling the mass matrix
-! to make sure all the nodes have finished to read their databases
- call MPI_BARRIER(MPI_COMM_WORLD,ier)
-
! the mass matrix needs to be assembled with MPI here once and for all
! ocean load
@@ -1378,8 +1357,7 @@
! get and store PREM attenuation model
- call create_name_database(prname, myrank, IREGION_CRUST_MANTLE, LOCAL_PATH)
- call get_attenuation_model_1D(myrank, prname, IREGION_CRUST_MANTLE, tau_sigma_dble, &
+ call get_attenuation_model_1D(myrank, IREGION_CRUST_MANTLE, tau_sigma_dble, &
omsb_crust_mantle_dble, factor_common_crust_mantle_dble, &
factor_scale_crust_mantle_dble, NRAD_ATTENUATION,1,1,1, AM_V)
omsb_inner_core_dble(:,:,:,1:min(ATT4,ATT5)) = omsb_crust_mantle_dble(:,:,:,1:min(ATT4,ATT5))
@@ -1665,14 +1643,6 @@
! ************* MAIN LOOP OVER THE TIME STEPS *************
! *********************************************************
-!! DK DK merged version: may set to 1 for timing
-! displ_crust_mantle = 1
-! veloc_crust_mantle = 1
-! displ_outer_core = 1
-! veloc_outer_core = 1
-! displ_inner_core = 1
-! veloc_inner_core = 1
-
do it = it_begin,it_end
! update position in seismograms
@@ -2253,12 +2223,5 @@
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
-!! DK DK suppressed this for the merged version
-! call MPI_FINALIZE(ier)
-
end subroutine specfem3D
More information about the cig-commits
mailing list