[cig-commits] [commit] devel: added option to broadcast the database between simultaneous runs for identical mesh and model (but different source and/or receiver). (b89f008)
cig_noreply at geodynamics.org
cig_noreply at geodynamics.org
Wed Sep 24 08:33:47 PDT 2014
Repository : https://github.com/geodynamics/specfem3d
On branch : devel
Link : https://github.com/geodynamics/specfem3d/compare/a4d3a420ff47e8ba4905b2df3d6c59ee91e129bf...e8f0b0d06ff8115b57ff7a6688a040b04e174252
>---------------------------------------------------------------
commit b89f008c545565d0e3afabd4a9d77b1978d12753
Author: Dimitri Komatitsch <komatitsch at lma.cnrs-mrs.fr>
Date: Wed Sep 24 15:55:04 2014 +0200
added option to broadcast the database between simultaneous runs for identical mesh and model (but different source and/or receiver).
>---------------------------------------------------------------
b89f008c545565d0e3afabd4a9d77b1978d12753
src/decompose_mesh/decompose_mesh.F90 | 5 +-
src/generate_databases/model_tomography.f90 | 3 +-
src/shared/constants_mod.f90 | 6 +-
src/shared/parallel.f90 | 81 ++++++++------
src/shared/serial.f90 | 141 +++++++++++++++++------
src/specfem3D/read_mesh_databases.F90 | 167 +++++++++++++++++++++++++++-
src/specfem3D/specfem3D_par.f90 | 1 -
7 files changed, 324 insertions(+), 80 deletions(-)
diff --git a/src/decompose_mesh/decompose_mesh.F90 b/src/decompose_mesh/decompose_mesh.F90
index aa104b2..026cdc0 100644
--- a/src/decompose_mesh/decompose_mesh.F90
+++ b/src/decompose_mesh/decompose_mesh.F90
@@ -43,7 +43,7 @@ module decompose_mesh
write_material_props_database,write_boundaries_database, &
write_partition_database,write_cpml_database, &
acoustic_elastic_poro_load,mesh2dual_ncommonnodes, &
- build_glob2loc_elmnts,build_glob2loc_nodes,build_interfaces
+ build_glob2loc_elmnts,build_glob2loc_nodes,build_interfaces,poro_elastic_repartitioning,moho_surface_repartitioning
use fault_scotch,only: ANY_FAULT,nodes_coords_open,read_fault_files,save_nodes_coords,close_faults, &
fault_repartition,write_fault_database
@@ -536,7 +536,7 @@ module decompose_mesh
else
read(98,*) nspec2D_xmin
endif
-! 33333333333333333333333333333333333333333
+
! an array of size 0 is a valid object in Fortran 90, i.e. the array is then considered as allocated
! and can thus for instance be used as an argument in a call to a subroutine without giving any error
! even when full range and pointer checking is used in the compiler options;
@@ -655,7 +655,6 @@ module decompose_mesh
close(98)
print*, ' nspec2D_top = ', nspec2D_top
-! 33333333333333333333333333333333333333333
! an array of size 0 is a valid object in Fortran 90, i.e. the array is then considered as allocated
! and can thus for instance be used as an argument in a call to a subroutine without giving any error
! even when full range and pointer checking is used in the compiler options;
diff --git a/src/generate_databases/model_tomography.f90 b/src/generate_databases/model_tomography.f90
index 2c31041..79e6bce 100644
--- a/src/generate_databases/model_tomography.f90
+++ b/src/generate_databases/model_tomography.f90
@@ -99,9 +99,10 @@
! otherwise:
! only master reads in model file
+ !integer, dimension(1) :: nrecord
!if(myrank == 0) call read_model_tomography()
! broadcast the information read on the master to the nodes, e.g.
- !call bcast_all_one_i(nrecord)
+ !call bcast_all_i(nrecord,1)
!if( myrank /= 0 ) then
! allocate( vp_tomography(1:nrecord) ,stat=ier)
diff --git a/src/shared/constants_mod.f90 b/src/shared/constants_mod.f90
index a277a77..5868f9c 100644
--- a/src/shared/constants_mod.f90
+++ b/src/shared/constants_mod.f90
@@ -38,9 +38,9 @@ module constants
! if NUMBER_OF_SIMULTANEOUS_RUNS > 1
character(len=MAX_STRING_LEN) :: OUTPUT_FILES_PATH = OUTPUT_FILES_PATH_BASE
- ! in the case of simultaneous runs for the same mesh and model, see who reads the mesh and the model and broadcasts it to others
- ! we put default values here
- logical :: I_should_read_the_database = .true., I_should_broadcast_the_database = .false.
+ ! if doing simultaneous runs for the same mesh and model, see who should read the mesh and the model and broadcast it to others
+ ! we put a default value here
+ logical :: I_should_read_the_database = .true.
end module constants
diff --git a/src/shared/parallel.f90 b/src/shared/parallel.f90
index 2286a1b..bcc15e1 100644
--- a/src/shared/parallel.f90
+++ b/src/shared/parallel.f90
@@ -113,24 +113,6 @@ end module my_mpi
!---- broadcast using the default communicator for the whole run
!
- subroutine bcast_all_one_i(buffer)
-
- use my_mpi
-
- implicit none
-
- integer :: buffer
-
- integer ier
-
- call MPI_BCAST(buffer,1,MPI_INTEGER,0,my_local_mpi_comm_world,ier)
-
- end subroutine bcast_all_one_i
-
-!
-!----
-!
-
subroutine bcast_all_i(buffer, countval)
use my_mpi
@@ -210,38 +192,51 @@ end module my_mpi
!---- broadcast using the communicator to send the mesh and model to other simultaneous runs
!
- subroutine bcast_all_one_i_for_database(buffer)
+ subroutine bcast_all_i_for_database(buffer, countval)
use my_mpi
+ use constants,only: NUMBER_OF_SIMULTANEOUS_RUNS,BROADCAST_SAME_MESH_AND_MODEL
implicit none
+ integer countval
+ ! by not specifying any dimensions for the buffer here we can use this routine for arrays of any number
+ ! of indices, provided we call the routine using the first memory cell of that multidimensional array,
+ ! i.e. for instance buffer(1,1,1) if the array has three dimensions with indices that all start at 1.
integer :: buffer
integer ier
- call MPI_BCAST(buffer,1,MPI_INTEGER,0,my_local_mpi_comm_for_bcast,ier)
+ if(.not. (NUMBER_OF_SIMULTANEOUS_RUNS > 1 .and. BROADCAST_SAME_MESH_AND_MODEL)) return
- end subroutine bcast_all_one_i_for_database
+ call MPI_BCAST(buffer,countval,MPI_INTEGER,0,my_local_mpi_comm_for_bcast,ier)
+
+ end subroutine bcast_all_i_for_database
!
!----
!
- subroutine bcast_all_i_for_database(buffer, countval)
+ subroutine bcast_all_l_for_database(buffer, countval)
use my_mpi
+ use constants,only: NUMBER_OF_SIMULTANEOUS_RUNS,BROADCAST_SAME_MESH_AND_MODEL
implicit none
integer countval
- integer, dimension(countval) :: buffer
+ ! by not specifying any dimensions for the buffer here we can use this routine for arrays of any number
+ ! of indices, provided we call the routine using the first memory cell of that multidimensional array,
+ ! i.e. for instance buffer(1,1,1) if the array has three dimensions with indices that all start at 1.
+ logical :: buffer
integer ier
+ if(.not. (NUMBER_OF_SIMULTANEOUS_RUNS > 1 .and. BROADCAST_SAME_MESH_AND_MODEL)) return
+
call MPI_BCAST(buffer,countval,MPI_INTEGER,0,my_local_mpi_comm_for_bcast,ier)
- end subroutine bcast_all_i_for_database
+ end subroutine bcast_all_l_for_database
!
!----
@@ -250,17 +245,22 @@ end module my_mpi
subroutine bcast_all_cr_for_database(buffer, countval)
use my_mpi
- use constants,only: CUSTOM_REAL
+ use constants,only: CUSTOM_REAL,NUMBER_OF_SIMULTANEOUS_RUNS,BROADCAST_SAME_MESH_AND_MODEL
implicit none
include "precision.h"
integer countval
- real(kind=CUSTOM_REAL), dimension(countval) :: buffer
+ ! by not specifying any dimensions for the buffer here we can use this routine for arrays of any number
+ ! of indices, provided we call the routine using the first memory cell of that multidimensional array,
+ ! i.e. for instance buffer(1,1,1) if the array has three dimensions with indices that all start at 1.
+ real(kind=CUSTOM_REAL) :: buffer
integer ier
+ if(.not. (NUMBER_OF_SIMULTANEOUS_RUNS > 1 .and. BROADCAST_SAME_MESH_AND_MODEL)) return
+
call MPI_BCAST(buffer,countval,CUSTOM_MPI_TYPE,0,my_local_mpi_comm_for_bcast,ier)
end subroutine bcast_all_cr_for_database
@@ -272,14 +272,20 @@ end module my_mpi
subroutine bcast_all_dp_for_database(buffer, countval)
use my_mpi
+ use constants,only: NUMBER_OF_SIMULTANEOUS_RUNS,BROADCAST_SAME_MESH_AND_MODEL
implicit none
integer countval
- double precision, dimension(countval) :: buffer
+ ! by not specifying any dimensions for the buffer here we can use this routine for arrays of any number
+ ! of indices, provided we call the routine using the first memory cell of that multidimensional array,
+ ! i.e. for instance buffer(1,1,1) if the array has three dimensions with indices that all start at 1.
+ double precision :: buffer
integer ier
+ if(.not. (NUMBER_OF_SIMULTANEOUS_RUNS > 1 .and. BROADCAST_SAME_MESH_AND_MODEL)) return
+
call MPI_BCAST(buffer,countval,MPI_DOUBLE_PRECISION,0,my_local_mpi_comm_for_bcast,ier)
end subroutine bcast_all_dp_for_database
@@ -291,14 +297,20 @@ end module my_mpi
subroutine bcast_all_r_for_database(buffer, countval)
use my_mpi
+ use constants,only: NUMBER_OF_SIMULTANEOUS_RUNS,BROADCAST_SAME_MESH_AND_MODEL
implicit none
integer countval
- real, dimension(countval) :: buffer
+ ! by not specifying any dimensions for the buffer here we can use this routine for arrays of any number
+ ! of indices, provided we call the routine using the first memory cell of that multidimensional array,
+ ! i.e. for instance buffer(1,1,1) if the array has three dimensions with indices that all start at 1.
+ real :: buffer
integer ier
+ if(.not. (NUMBER_OF_SIMULTANEOUS_RUNS > 1 .and. BROADCAST_SAME_MESH_AND_MODEL)) return
+
call MPI_BCAST(buffer,countval,MPI_REAL,0,my_local_mpi_comm_for_bcast,ier)
end subroutine bcast_all_r_for_database
@@ -325,7 +337,6 @@ end module my_mpi
end subroutine gather_all_i
-
!
!----
!
@@ -348,7 +359,6 @@ end module my_mpi
end subroutine gather_all_singlei
-
!
!----
!
@@ -1268,7 +1278,7 @@ end module my_mpi
use my_mpi
use constants,only: MAX_STRING_LEN,NUMBER_OF_SIMULTANEOUS_RUNS,OUTPUT_FILES_PATH, &
- IMAIN,ISTANDARD_OUTPUT,mygroup,BROADCAST_SAME_MESH_AND_MODEL,I_should_read_the_database,I_should_broadcast_the_database
+ IMAIN,ISTANDARD_OUTPUT,mygroup,BROADCAST_SAME_MESH_AND_MODEL,I_should_read_the_database
implicit none
@@ -1279,6 +1289,8 @@ end module my_mpi
if(NUMBER_OF_SIMULTANEOUS_RUNS <= 0) stop 'NUMBER_OF_SIMULTANEOUS_RUNS <= 0 makes no sense'
call MPI_COMM_SIZE(MPI_COMM_WORLD,sizeval,ier)
+ call MPI_COMM_RANK(MPI_COMM_WORLD,myrank,ier)
+
if(NUMBER_OF_SIMULTANEOUS_RUNS > 1 .and. mod(sizeval,NUMBER_OF_SIMULTANEOUS_RUNS) /= 0) &
stop 'the number of MPI processes is not a multiple of NUMBER_OF_SIMULTANEOUS_RUNS'
@@ -1297,9 +1309,10 @@ end module my_mpi
!--- create a subcommunicator for each independent run
- call MPI_COMM_RANK(MPI_COMM_WORLD,myrank,ier)
+ NPROC = sizeval / NUMBER_OF_SIMULTANEOUS_RUNS
+
! create the different groups of processes, one for each independent run
- mygroup = mod(myrank,NUMBER_OF_SIMULTANEOUS_RUNS)
+ mygroup = myrank / NPROC
key = myrank
if(mygroup < 0 .or. mygroup > NUMBER_OF_SIMULTANEOUS_RUNS-1) stop 'invalid value of mygroup'
@@ -1316,7 +1329,6 @@ end module my_mpi
call MPI_COMM_RANK(MPI_COMM_WORLD,myrank,ier)
! to broadcast the model, split along similar ranks per run instead
- NPROC = sizeval / NUMBER_OF_SIMULTANEOUS_RUNS
my_group_for_bcast = mod(myrank,NPROC)
key = myrank
if(my_group_for_bcast < 0 .or. my_group_for_bcast > NPROC-1) stop 'invalid value of my_group_for_bcast'
@@ -1328,7 +1340,6 @@ end module my_mpi
! see if that process will need to read the mesh and model database and then broadcast it to others
call MPI_COMM_RANK(my_local_mpi_comm_for_bcast,my_local_rank_for_bcast,ier)
if(my_local_rank_for_bcast > 0) I_should_read_the_database = .false.
- if(my_local_rank_for_bcast == 0) I_should_broadcast_the_database = .true.
else
diff --git a/src/shared/serial.f90 b/src/shared/serial.f90
index 2dc46ba..1a5a22a 100644
--- a/src/shared/serial.f90
+++ b/src/shared/serial.f90
@@ -61,28 +61,13 @@
!----
!
- subroutine bcast_all_one_i(buffer)
+ subroutine bcast_all_i(buffer, countval)
use unused_mod
implicit none
- integer :: buffer
-
- unused_i4 = buffer
-
- end subroutine bcast_all_one_i
-
-!
-!----
-!
-
- subroutine bcast_all_i(buffer, count)
-
- use unused_mod
- implicit none
-
- integer count
- integer, dimension(count) :: buffer
+ integer countval
+ integer, dimension(countval) :: buffer
unused_i4 = buffer(1)
@@ -92,15 +77,15 @@
!----
!
- subroutine bcast_all_cr(buffer, count)
+ subroutine bcast_all_cr(buffer, countval)
use unused_mod
use constants,only: CUSTOM_REAL
implicit none
- integer count
- real(kind=CUSTOM_REAL), dimension(count) :: buffer
+ integer countval
+ real(kind=CUSTOM_REAL), dimension(countval) :: buffer
unused_cr = buffer(1)
@@ -110,13 +95,13 @@
!----
!
- subroutine bcast_all_dp(buffer, count)
+ subroutine bcast_all_dp(buffer, countval)
use unused_mod
implicit none
- integer count
- double precision, dimension(count) :: buffer
+ integer countval
+ double precision, dimension(countval) :: buffer
unused_dp = buffer(1)
@@ -126,13 +111,13 @@
!----
!
- subroutine bcast_all_r(buffer, count)
+ subroutine bcast_all_r(buffer, countval)
use unused_mod
implicit none
- integer count
- real, dimension(count) :: buffer
+ integer countval
+ real, dimension(countval) :: buffer
unused_r = buffer(1)
@@ -142,16 +127,108 @@
!----
!
- subroutine bcast_all_one_i_for_database(buffer)
+ subroutine bcast_all_i_for_database(buffer, countval)
use unused_mod
implicit none
+ integer countval
+ ! by not specifying any dimensions for the buffer here we can use this routine for arrays of any number
+ ! of indices, provided we call the routine using the first memory cell of that multidimensional array,
+ ! i.e. for instance buffer(1,1,1) if the array has three dimensions with indices that all start at 1.
integer :: buffer
+ unused_i4 = countval
+
unused_i4 = buffer
- end subroutine bcast_all_one_i_for_database
+ end subroutine bcast_all_i_for_database
+
+!
+!----
+!
+
+ subroutine bcast_all_l_for_database(buffer, countval)
+
+ use unused_mod
+ implicit none
+
+ integer countval
+ ! by not specifying any dimensions for the buffer here we can use this routine for arrays of any number
+ ! of indices, provided we call the routine using the first memory cell of that multidimensional array,
+ ! i.e. for instance buffer(1,1,1) if the array has three dimensions with indices that all start at 1.
+ logical :: buffer
+
+ unused_i4 = countval
+
+ unused_l = buffer
+
+ end subroutine bcast_all_l_for_database
+
+!
+!----
+!
+
+ subroutine bcast_all_cr_for_database(buffer, countval)
+
+ use unused_mod
+ use constants,only: CUSTOM_REAL
+
+ implicit none
+
+ integer countval
+ ! by not specifying any dimensions for the buffer here we can use this routine for arrays of any number
+ ! of indices, provided we call the routine using the first memory cell of that multidimensional array,
+ ! i.e. for instance buffer(1,1,1) if the array has three dimensions with indices that all start at 1.
+ real(kind=CUSTOM_REAL) :: buffer
+
+ unused_i4 = countval
+
+ unused_cr = buffer
+
+ end subroutine bcast_all_cr_for_database
+
+!
+!----
+!
+
+ subroutine bcast_all_dp_for_database(buffer, countval)
+
+ use unused_mod
+ implicit none
+
+ integer countval
+ ! by not specifying any dimensions for the buffer here we can use this routine for arrays of any number
+ ! of indices, provided we call the routine using the first memory cell of that multidimensional array,
+ ! i.e. for instance buffer(1,1,1) if the array has three dimensions with indices that all start at 1.
+ double precision :: buffer
+
+ unused_i4 = countval
+
+ unused_dp = buffer
+
+ end subroutine bcast_all_dp_for_database
+
+!
+!----
+!
+
+ subroutine bcast_all_r_for_database(buffer, countval)
+
+ use unused_mod
+ implicit none
+
+ integer countval
+ ! by not specifying any dimensions for the buffer here we can use this routine for arrays of any number
+ ! of indices, provided we call the routine using the first memory cell of that multidimensional array,
+ ! i.e. for instance buffer(1,1,1) if the array has three dimensions with indices that all start at 1.
+ real :: buffer
+
+ unused_i4 = countval
+
+ unused_r = buffer
+
+ end subroutine bcast_all_r_for_database
!
!----
@@ -417,13 +494,13 @@
!----
!
- subroutine max_allreduce_i(buffer,count)
+ subroutine max_allreduce_i(buffer,countval)
use unused_mod
implicit none
- integer :: count
- integer,dimension(count),intent(inout) :: buffer
+ integer :: countval
+ integer,dimension(countval),intent(inout) :: buffer
unused_i4 = buffer(1)
diff --git a/src/specfem3D/read_mesh_databases.F90 b/src/specfem3D/read_mesh_databases.F90
index 94603b7..6788112 100644
--- a/src/specfem3D/read_mesh_databases.F90
+++ b/src/specfem3D/read_mesh_databases.F90
@@ -84,6 +84,28 @@
read(27) ispec_is_poroelastic
endif
+ call bcast_all_i_for_database(NSPEC_AB, 1)
+ call bcast_all_i_for_database(NGLOB_AB, 1)
+ call bcast_all_i_for_database(ibool(1,1,1,1), size(ibool))
+ call bcast_all_cr_for_database(xstore(1), size(xstore))
+ call bcast_all_cr_for_database(ystore(1), size(ystore))
+ call bcast_all_cr_for_database(zstore(1), size(zstore))
+ call bcast_all_cr_for_database(xix(1,1,1,1), size(xix))
+ call bcast_all_cr_for_database(xiy(1,1,1,1), size(xiy))
+ call bcast_all_cr_for_database(xiz(1,1,1,1), size(xiz))
+ call bcast_all_cr_for_database(etax(1,1,1,1), size(etax))
+ call bcast_all_cr_for_database(etay(1,1,1,1), size(etay))
+ call bcast_all_cr_for_database(etaz(1,1,1,1), size(etaz))
+ call bcast_all_cr_for_database(gammax(1,1,1,1), size(gammax))
+ call bcast_all_cr_for_database(gammay(1,1,1,1), size(gammay))
+ call bcast_all_cr_for_database(gammaz(1,1,1,1), size(gammaz))
+ call bcast_all_cr_for_database(jacobian(1,1,1,1), size(jacobian))
+ call bcast_all_cr_for_database(kappastore(1,1,1,1), size(kappastore))
+ call bcast_all_cr_for_database(mustore(1,1,1,1), size(mustore))
+ call bcast_all_l_for_database(ispec_is_acoustic(1), size(ispec_is_acoustic))
+ call bcast_all_l_for_database(ispec_is_elastic(1), size(ispec_is_elastic))
+ call bcast_all_l_for_database(ispec_is_poroelastic(1), size(ispec_is_poroelastic))
+
! acoustic
! number of acoustic elements in this partition
nspec_acoustic = count(ispec_is_acoustic(:))
@@ -105,6 +127,7 @@
allocate(rmass_acoustic(NGLOB_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array rmass_acoustic'
if(I_should_read_the_database) read(27) rmass_acoustic
+ call bcast_all_cr_for_database(rmass_acoustic(1), size(rmass_acoustic))
! initializes mass matrix contribution
allocate(rmassz_acoustic(NGLOB_AB),stat=ier)
@@ -117,6 +140,7 @@
allocate(rhostore(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array rhostore'
if(I_should_read_the_database) read(27) rhostore
+ call bcast_all_cr_for_database(rhostore(1,1,1,1), size(rhostore))
! elastic
! number of elastic elements in this partition
@@ -214,6 +238,7 @@
! reads mass matrices
if(I_should_read_the_database) read(27,iostat=ier) rmass
+ call bcast_all_cr_for_database(rmass(1), size(rmass))
if( ier /= 0 ) stop 'error reading in array rmass'
if( APPROXIMATE_OCEAN_LOAD ) then
@@ -221,6 +246,7 @@
allocate(rmass_ocean_load(NGLOB_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array rmass_ocean_load'
if(I_should_read_the_database) read(27) rmass_ocean_load
+ call bcast_all_cr_for_database(rmass_ocean_load(1), size(rmass_ocean_load))
else
! dummy allocation
allocate(rmass_ocean_load(1),stat=ier)
@@ -229,8 +255,10 @@
!pll material parameters for stacey conditions
if(I_should_read_the_database) read(27,iostat=ier) rho_vp
+ call bcast_all_cr_for_database(rho_vp(1,1,1,1), size(rho_vp))
if( ier /= 0 ) stop 'error reading in array rho_vp'
if(I_should_read_the_database) read(27,iostat=ier) rho_vs
+ call bcast_all_cr_for_database(rho_vs(1,1,1,1), size(rho_vs))
if( ier /= 0 ) stop 'error reading in array rho_vs'
else
@@ -305,6 +333,17 @@
read(27) rho_vpII
read(27) rho_vsI
endif
+ call bcast_all_cr_for_database(rmass_solid_poroelastic(1), size(rmass_solid_poroelastic))
+ call bcast_all_cr_for_database(rmass_fluid_poroelastic(1), size(rmass_fluid_poroelastic))
+ call bcast_all_cr_for_database(rhoarraystore(1,1,1,1,1), size(rhoarraystore))
+ call bcast_all_cr_for_database(kappaarraystore(1,1,1,1,1), size(kappaarraystore))
+ call bcast_all_cr_for_database(etastore(1,1,1,1), size(etastore))
+ call bcast_all_cr_for_database(tortstore(1,1,1,1), size(tortstore))
+ call bcast_all_cr_for_database(permstore(1,1,1,1,1), size(permstore))
+ call bcast_all_cr_for_database(phistore(1,1,1,1), size(phistore))
+ call bcast_all_cr_for_database(rho_vpI(1,1,1,1), size(rho_vpI))
+ call bcast_all_cr_for_database(rho_vpII(1,1,1,1), size(rho_vpII))
+ call bcast_all_cr_for_database(rho_vsI(1,1,1,1), size(rho_vsI))
endif
! checks simulation types are valid
@@ -324,6 +363,10 @@
read(27) CPML_width_y
read(27) CPML_width_z
endif
+ call bcast_all_i_for_database(NSPEC_CPML, 1)
+ call bcast_all_cr_for_database(CPML_width_x, 1)
+ call bcast_all_cr_for_database(CPML_width_y, 1)
+ call bcast_all_cr_for_database(CPML_width_z, 1)
allocate(is_CPML(NSPEC_AB),stat=ier)
if(ier /= 0) stop 'error allocating array is_CPML'
@@ -370,19 +413,35 @@
read(27) alpha_store_y
read(27) alpha_store_z
endif
+ call bcast_all_i_for_database(CPML_regions(1), size(CPML_regions))
+ call bcast_all_i_for_database(CPML_to_spec(1), size(CPML_to_spec))
+ call bcast_all_l_for_database(is_CPML(1), size(is_CPML))
+ call bcast_all_cr_for_database(d_store_x(1,1,1,1), size(d_store_x))
+ call bcast_all_cr_for_database(d_store_y(1,1,1,1), size(d_store_y))
+ call bcast_all_cr_for_database(d_store_z(1,1,1,1), size(d_store_z))
+ call bcast_all_cr_for_database(k_store_x(1,1,1,1), size(k_store_x))
+ call bcast_all_cr_for_database(k_store_y(1,1,1,1), size(k_store_y))
+ call bcast_all_cr_for_database(k_store_z(1,1,1,1), size(k_store_z))
+ call bcast_all_cr_for_database(alpha_store_x(1,1,1,1), size(alpha_store_x))
+ call bcast_all_cr_for_database(alpha_store_y(1,1,1,1), size(alpha_store_y))
+ call bcast_all_cr_for_database(alpha_store_z(1,1,1,1), size(alpha_store_z))
if((SIMULATION_TYPE == 1 .and. SAVE_FORWARD) .or. SIMULATION_TYPE == 3) then
if(I_should_read_the_database) read(27) nglob_interface_PML_acoustic
+ call bcast_all_i_for_database(nglob_interface_PML_acoustic, 1)
if(I_should_read_the_database) read(27) nglob_interface_PML_elastic
+ call bcast_all_i_for_database(nglob_interface_PML_elastic, 1)
if(nglob_interface_PML_acoustic > 0) then
allocate(points_interface_PML_acoustic(nglob_interface_PML_acoustic),stat=ier)
if(ier /= 0) stop 'error allocating array points_interface_PML_acoustic'
if(I_should_read_the_database) read(27) points_interface_PML_acoustic
+ call bcast_all_i_for_database(points_interface_PML_acoustic(1), size(points_interface_PML_acoustic))
endif
if(nglob_interface_PML_elastic > 0) then
allocate(points_interface_PML_elastic(nglob_interface_PML_elastic),stat=ier)
if(ier /= 0) stop 'error allocating array points_interface_PML_elastic'
if(I_should_read_the_database) read(27) points_interface_PML_elastic
+ call bcast_all_i_for_database(points_interface_PML_elastic(1), size(points_interface_PML_elastic))
endif
endif
endif
@@ -393,6 +452,7 @@
! absorbing boundary surface
if(I_should_read_the_database) read(27) num_abs_boundary_faces
+ call bcast_all_i_for_database(num_abs_boundary_faces, 1)
! checks
if( num_abs_boundary_faces < 0 ) then
@@ -427,6 +487,10 @@
read(27) abs_boundary_jacobian2Dw
read(27) abs_boundary_normal
endif
+ call bcast_all_i_for_database(abs_boundary_ispec(1), size(abs_boundary_ispec))
+ call bcast_all_i_for_database(abs_boundary_ijk(1,1,1), size(abs_boundary_ijk))
+ call bcast_all_cr_for_database(abs_boundary_jacobian2Dw(1,1), size(abs_boundary_jacobian2Dw))
+ call bcast_all_cr_for_database(abs_boundary_normal(1,1,1), size(abs_boundary_normal))
endif
else
if (num_abs_boundary_faces > 0) then
@@ -436,6 +500,10 @@
read(27) abs_boundary_jacobian2Dw
read(27) abs_boundary_normal
endif
+ call bcast_all_i_for_database(abs_boundary_ispec(1), size(abs_boundary_ispec))
+ call bcast_all_i_for_database(abs_boundary_ijk(1,1,1), size(abs_boundary_ijk))
+ call bcast_all_cr_for_database(abs_boundary_jacobian2Dw(1,1), size(abs_boundary_jacobian2Dw))
+ call bcast_all_cr_for_database(abs_boundary_normal(1,1,1), size(abs_boundary_normal))
if (STACEY_ABSORBING_CONDITIONS) then
! store mass matrix contributions
if (ELASTIC_SIMULATION) then
@@ -444,9 +512,13 @@
read(27) rmassy
read(27) rmassz
endif
+ call bcast_all_cr_for_database(rmassx(1), size(rmassx))
+ call bcast_all_cr_for_database(rmassy(1), size(rmassy))
+ call bcast_all_cr_for_database(rmassz(1), size(rmassz))
endif
if (ACOUSTIC_SIMULATION) then
if(I_should_read_the_database) read(27) rmassz_acoustic
+ call bcast_all_cr_for_database(rmassz_acoustic(1), size(rmassz_acoustic))
endif
endif
endif
@@ -460,6 +532,12 @@
read(27) NSPEC2D_BOTTOM
read(27) NSPEC2D_TOP
endif
+ call bcast_all_i_for_database(nspec2D_xmin, 1)
+ call bcast_all_i_for_database(nspec2D_xmax, 1)
+ call bcast_all_i_for_database(nspec2D_ymin, 1)
+ call bcast_all_i_for_database(nspec2D_ymax, 1)
+ call bcast_all_i_for_database(NSPEC2D_BOTTOM, 1)
+ call bcast_all_i_for_database(NSPEC2D_TOP, 1)
allocate(ibelm_xmin(nspec2D_xmin),ibelm_xmax(nspec2D_xmax), &
ibelm_ymin(nspec2D_ymin),ibelm_ymax(nspec2D_ymax), &
@@ -473,9 +551,16 @@
read(27) ibelm_bottom
read(27) ibelm_top
endif
+ if(size(ibelm_xmin) > 0) call bcast_all_i_for_database(ibelm_xmin(1), size(ibelm_xmin))
+ if(size(ibelm_xmax) > 0) call bcast_all_i_for_database(ibelm_xmax(1), size(ibelm_xmax))
+ if(size(ibelm_ymin) > 0) call bcast_all_i_for_database(ibelm_ymin(1), size(ibelm_ymin))
+ if(size(ibelm_ymax) > 0) call bcast_all_i_for_database(ibelm_ymax(1), size(ibelm_ymax))
+ if(size(ibelm_bottom) > 0) call bcast_all_i_for_database(ibelm_bottom(1), size(ibelm_bottom))
+ if(size(ibelm_top) > 0) call bcast_all_i_for_database(ibelm_top(1), size(ibelm_top))
! free surface
if(I_should_read_the_database) read(27) num_free_surface_faces
+ call bcast_all_i_for_database(num_free_surface_faces, 1)
allocate(free_surface_ispec(num_free_surface_faces), &
free_surface_ijk(3,NGLLSQUARE,num_free_surface_faces), &
free_surface_jacobian2Dw(NGLLSQUARE,num_free_surface_faces), &
@@ -488,10 +573,15 @@
read(27) free_surface_jacobian2Dw
read(27) free_surface_normal
endif
+ call bcast_all_i_for_database(free_surface_ispec(1), size(free_surface_ispec))
+ call bcast_all_i_for_database(free_surface_ijk(1,1,1), size(free_surface_ijk))
+ call bcast_all_cr_for_database(free_surface_jacobian2Dw(1,1), size(free_surface_jacobian2Dw))
+ call bcast_all_cr_for_database(free_surface_normal(1,1,1), size(free_surface_normal))
endif
! acoustic-elastic coupling surface
if(I_should_read_the_database) read(27) num_coupling_ac_el_faces
+ call bcast_all_i_for_database(num_coupling_ac_el_faces, 1)
allocate(coupling_ac_el_normal(NDIM,NGLLSQUARE,num_coupling_ac_el_faces), &
coupling_ac_el_jacobian2Dw(NGLLSQUARE,num_coupling_ac_el_faces), &
coupling_ac_el_ijk(3,NGLLSQUARE,num_coupling_ac_el_faces), &
@@ -504,10 +594,15 @@
read(27) coupling_ac_el_jacobian2Dw
read(27) coupling_ac_el_normal
endif
+ call bcast_all_i_for_database(coupling_ac_el_ispec(1), size(coupling_ac_el_ispec))
+ call bcast_all_i_for_database(coupling_ac_el_ijk(1,1,1), size(coupling_ac_el_ijk))
+ call bcast_all_cr_for_database(coupling_ac_el_jacobian2Dw(1,1), size(coupling_ac_el_jacobian2Dw))
+ call bcast_all_cr_for_database(coupling_ac_el_normal(1,1,1), size(coupling_ac_el_normal))
endif
! acoustic-poroelastic coupling surface
if(I_should_read_the_database) read(27) num_coupling_ac_po_faces
+ call bcast_all_i_for_database(num_coupling_ac_po_faces, 1)
allocate(coupling_ac_po_normal(NDIM,NGLLSQUARE,num_coupling_ac_po_faces), &
coupling_ac_po_jacobian2Dw(NGLLSQUARE,num_coupling_ac_po_faces), &
coupling_ac_po_ijk(3,NGLLSQUARE,num_coupling_ac_po_faces), &
@@ -520,10 +615,15 @@
read(27) coupling_ac_po_jacobian2Dw
read(27) coupling_ac_po_normal
endif
+ call bcast_all_i_for_database(coupling_ac_po_ispec(1), size(coupling_ac_po_ispec))
+ call bcast_all_i_for_database(coupling_ac_po_ijk(1,1,1), size(coupling_ac_po_ijk))
+ call bcast_all_cr_for_database(coupling_ac_po_jacobian2Dw(1,1), size(coupling_ac_po_jacobian2Dw))
+ call bcast_all_cr_for_database(coupling_ac_po_normal(1,1,1), size(coupling_ac_po_normal))
endif
! elastic-poroelastic coupling surface
if(I_should_read_the_database) read(27) num_coupling_el_po_faces
+ call bcast_all_i_for_database(num_coupling_el_po_faces, 1)
allocate(coupling_el_po_normal(NDIM,NGLLSQUARE,num_coupling_el_po_faces), &
coupling_el_po_jacobian2Dw(NGLLSQUARE,num_coupling_el_po_faces), &
coupling_el_po_ijk(3,NGLLSQUARE,num_coupling_el_po_faces), &
@@ -540,15 +640,23 @@
read(27) coupling_el_po_jacobian2Dw
read(27) coupling_el_po_normal
endif
+ call bcast_all_i_for_database(coupling_el_po_ispec(1), size(coupling_el_po_ispec))
+ call bcast_all_i_for_database(coupling_po_el_ispec(1), size(coupling_po_el_ispec))
+ call bcast_all_i_for_database(coupling_el_po_ijk(1,1,1), size(coupling_el_po_ijk))
+ call bcast_all_i_for_database(coupling_po_el_ijk(1,1,1), size(coupling_po_el_ijk))
+ call bcast_all_cr_for_database(coupling_el_po_jacobian2Dw(1,1), size(coupling_el_po_jacobian2Dw))
+ call bcast_all_cr_for_database(coupling_el_po_normal(1,1,1), size(coupling_el_po_normal))
endif
! MPI interfaces
if(I_should_read_the_database) read(27) num_interfaces_ext_mesh
+ call bcast_all_i_for_database(num_interfaces_ext_mesh, 1)
allocate(my_neighbours_ext_mesh(num_interfaces_ext_mesh), &
nibool_interfaces_ext_mesh(num_interfaces_ext_mesh),stat=ier)
if( ier /= 0 ) stop 'error allocating array my_neighbours_ext_mesh etc.'
if( num_interfaces_ext_mesh > 0 ) then
if(I_should_read_the_database) read(27) max_nibool_interfaces_ext_mesh
+ call bcast_all_i_for_database(max_nibool_interfaces_ext_mesh, 1)
allocate(ibool_interfaces_ext_mesh(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh),stat=ier)
if( ier /= 0 ) stop 'error allocating array ibool_interfaces_ext_mesh'
if(I_should_read_the_database) then
@@ -556,6 +664,9 @@
read(27) nibool_interfaces_ext_mesh
read(27) ibool_interfaces_ext_mesh
endif
+ call bcast_all_i_for_database(my_neighbours_ext_mesh(1), size(my_neighbours_ext_mesh))
+ call bcast_all_i_for_database(nibool_interfaces_ext_mesh(1), size(nibool_interfaces_ext_mesh))
+ call bcast_all_i_for_database(ibool_interfaces_ext_mesh(1,1), size(ibool_interfaces_ext_mesh))
else
max_nibool_interfaces_ext_mesh = 0
allocate(ibool_interfaces_ext_mesh(0,0),stat=ier)
@@ -585,23 +696,49 @@
read(27) c56store
read(27) c66store
endif
+ call bcast_all_cr_for_database(c11store(1,1,1,1), size(c11store))
+ call bcast_all_cr_for_database(c12store(1,1,1,1), size(c12store))
+ call bcast_all_cr_for_database(c13store(1,1,1,1), size(c13store))
+ call bcast_all_cr_for_database(c14store(1,1,1,1), size(c14store))
+ call bcast_all_cr_for_database(c15store(1,1,1,1), size(c15store))
+ call bcast_all_cr_for_database(c16store(1,1,1,1), size(c16store))
+ call bcast_all_cr_for_database(c22store(1,1,1,1), size(c22store))
+ call bcast_all_cr_for_database(c23store(1,1,1,1), size(c23store))
+ call bcast_all_cr_for_database(c24store(1,1,1,1), size(c24store))
+ call bcast_all_cr_for_database(c25store(1,1,1,1), size(c25store))
+ call bcast_all_cr_for_database(c26store(1,1,1,1), size(c26store))
+ call bcast_all_cr_for_database(c33store(1,1,1,1), size(c33store))
+ call bcast_all_cr_for_database(c34store(1,1,1,1), size(c34store))
+ call bcast_all_cr_for_database(c35store(1,1,1,1), size(c35store))
+ call bcast_all_cr_for_database(c36store(1,1,1,1), size(c36store))
+ call bcast_all_cr_for_database(c44store(1,1,1,1), size(c44store))
+ call bcast_all_cr_for_database(c45store(1,1,1,1), size(c45store))
+ call bcast_all_cr_for_database(c46store(1,1,1,1), size(c46store))
+ call bcast_all_cr_for_database(c55store(1,1,1,1), size(c55store))
+ call bcast_all_cr_for_database(c56store(1,1,1,1), size(c56store))
+ call bcast_all_cr_for_database(c66store(1,1,1,1), size(c66store))
endif
! inner / outer elements
allocate(ispec_is_inner(NSPEC_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array ispec_is_inner'
if(I_should_read_the_database) read(27) ispec_is_inner
+ call bcast_all_l_for_database(ispec_is_inner(1), size(ispec_is_inner))
if( ACOUSTIC_SIMULATION ) then
if(I_should_read_the_database) then
read(27) nspec_inner_acoustic,nspec_outer_acoustic
read(27) num_phase_ispec_acoustic
endif
+ call bcast_all_i_for_database(nspec_inner_acoustic, 1)
+ call bcast_all_i_for_database(nspec_outer_acoustic, 1)
+ call bcast_all_i_for_database(num_phase_ispec_acoustic, 1)
if( num_phase_ispec_acoustic < 0 ) stop 'error acoustic simulation: num_phase_ispec_acoustic is < zero'
allocate( phase_ispec_inner_acoustic(num_phase_ispec_acoustic,2),stat=ier)
if( ier /= 0 ) stop 'error allocating array phase_ispec_inner_acoustic'
if(num_phase_ispec_acoustic > 0 ) then
if(I_should_read_the_database) read(27) phase_ispec_inner_acoustic
+ call bcast_all_i_for_database(phase_ispec_inner_acoustic(1,1), size(phase_ispec_inner_acoustic))
endif
endif
@@ -610,11 +747,15 @@
read(27) nspec_inner_elastic,nspec_outer_elastic
read(27) num_phase_ispec_elastic
endif
+ call bcast_all_i_for_database(nspec_inner_elastic, 1)
+ call bcast_all_i_for_database(nspec_outer_elastic, 1)
+ call bcast_all_i_for_database(num_phase_ispec_elastic, 1)
if( num_phase_ispec_elastic < 0 ) stop 'error elastic simulation: num_phase_ispec_elastic is < zero'
allocate( phase_ispec_inner_elastic(num_phase_ispec_elastic,2),stat=ier)
if( ier /= 0 ) stop 'error allocating array phase_ispec_inner_elastic'
if(num_phase_ispec_elastic > 0 ) then
if(I_should_read_the_database) read(27) phase_ispec_inner_elastic
+ call bcast_all_i_for_database(phase_ispec_inner_elastic(1,1), size(phase_ispec_inner_elastic))
endif
endif
@@ -623,11 +764,15 @@
read(27) nspec_inner_poroelastic,nspec_outer_poroelastic
read(27) num_phase_ispec_poroelastic
endif
+ call bcast_all_i_for_database(nspec_inner_poroelastic, 1)
+ call bcast_all_i_for_database(nspec_outer_poroelastic, 1)
+ call bcast_all_i_for_database(num_phase_ispec_poroelastic, 1)
if( num_phase_ispec_poroelastic < 0 ) stop 'error poroelastic simulation: num_phase_ispec_poroelastic is < zero'
allocate( phase_ispec_inner_poroelastic(num_phase_ispec_poroelastic,2),stat=ier)
if( ier /= 0 ) stop 'error allocating array phase_ispec_inner_poroelastic'
if(num_phase_ispec_poroelastic > 0 ) then
if(I_should_read_the_database) read(27) phase_ispec_inner_poroelastic
+ call bcast_all_i_for_database(phase_ispec_inner_poroelastic(1,1), size(phase_ispec_inner_poroelastic))
endif
endif
@@ -636,20 +781,26 @@
! acoustic domain colors
if( ACOUSTIC_SIMULATION ) then
if(I_should_read_the_database) read(27) num_colors_outer_acoustic,num_colors_inner_acoustic
+ call bcast_all_i_for_database(num_colors_outer_acoustic, 1)
+ call bcast_all_i_for_database(num_colors_inner_acoustic, 1)
allocate(num_elem_colors_acoustic(num_colors_outer_acoustic + num_colors_inner_acoustic),stat=ier)
if( ier /= 0 ) stop 'error allocating num_elem_colors_acoustic array'
if(I_should_read_the_database) read(27) num_elem_colors_acoustic
+ call bcast_all_i_for_database(num_elem_colors_acoustic(1), size(num_elem_colors_acoustic))
endif
! elastic domain colors
if( ELASTIC_SIMULATION ) then
if(I_should_read_the_database) read(27) num_colors_outer_elastic,num_colors_inner_elastic
+ call bcast_all_i_for_database(num_colors_outer_elastic, 1)
+ call bcast_all_i_for_database(num_colors_inner_elastic, 1)
allocate(num_elem_colors_elastic(num_colors_outer_elastic + num_colors_inner_elastic),stat=ier)
if( ier /= 0 ) stop 'error allocating num_elem_colors_elastic array'
if(I_should_read_the_database) read(27) num_elem_colors_elastic
+ call bcast_all_i_for_database(num_elem_colors_elastic(1), size(num_elem_colors_elastic))
endif
else
! allocates dummy arrays
@@ -866,7 +1017,6 @@
if( ier /= 0 ) stop 'error allocating array b_R_trace etc.'
else
- ! modification: Camille Mazoyer
! dummy allocation
allocate(b_displ(1,1),stat=ier)
if( ier /= 0 ) stop 'error allocating dummy array b_displ'
@@ -958,6 +1108,7 @@
endif
if(I_should_read_the_database) read(27) NSPEC2D_MOHO
+ call bcast_all_i_for_database(NSPEC2D_MOHO, 1)
! allocates arrays for moho mesh
allocate(ibelm_moho_bot(NSPEC2D_MOHO), &
@@ -974,6 +1125,10 @@
read(27) ijk_moho_top
read(27) ijk_moho_bot
endif
+ call bcast_all_i_for_database(ibelm_moho_top(1), size(ibelm_moho_top))
+ call bcast_all_i_for_database(ibelm_moho_bot(1), size(ibelm_moho_bot))
+ call bcast_all_i_for_database(ijk_moho_top(1,1,1), size(ijk_moho_top))
+ call bcast_all_i_for_database(ijk_moho_bot(1,1,1), size(ijk_moho_bot))
if(I_should_read_the_database) close(27)
@@ -992,6 +1147,8 @@
read(27) normal_moho_top
read(27) normal_moho_bot
endif
+ call bcast_all_cr_for_database(normal_moho_top(1,1,1), size(normal_moho_top))
+ call bcast_all_cr_for_database(normal_moho_bot(1,1,1), size(normal_moho_bot))
if(I_should_read_the_database) close(27)
! flags
@@ -1009,6 +1166,8 @@
read(27) is_moho_top
read(27) is_moho_bot
endif
+ call bcast_all_l_for_database(is_moho_top(1), size(is_moho_top))
+ call bcast_all_l_for_database(is_moho_bot(1), size(is_moho_bot))
if(I_should_read_the_database) close(27)
endif
@@ -1203,10 +1362,8 @@
read(IIN) NSPEC_AB
read(IIN) NGLOB_AB
endif
- if(I_should_broadcast_the_database) then
- call bcast_all_one_i_for_database(NSPEC_AB)
- call bcast_all_one_i_for_database(NGLOB_AB)
- endif
+ call bcast_all_i_for_database(NSPEC_AB, 1)
+ call bcast_all_i_for_database(NGLOB_AB, 1)
if(I_should_read_the_database) close(IIN)
diff --git a/src/specfem3D/specfem3D_par.f90 b/src/specfem3D/specfem3D_par.f90
index 23dff01..8fb67cd 100644
--- a/src/specfem3D/specfem3D_par.f90
+++ b/src/specfem3D/specfem3D_par.f90
@@ -479,7 +479,6 @@ module specfem_par_poroelastic
epsilons_trace_over_3,epsilonw_trace_over_3
! material properties
-! real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: mustore
real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: etastore,tortstore
real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: phistore
real(kind=CUSTOM_REAL), dimension(:,:,:,:,:), allocatable :: rhoarraystore
More information about the CIG-COMMITS
mailing list