[cig-commits] [commit] devel: Reads locally and broadcasts database MPI IC (4f3bbe7)
cig_noreply at geodynamics.org
cig_noreply at geodynamics.org
Fri Dec 5 07:23:09 PST 2014
Repository : https://github.com/geodynamics/specfem3d_globe
On branch : devel
Link : https://github.com/geodynamics/specfem3d_globe/compare/b9fb1aa33196d161098710455fadbb4ed91c5e47...897de40783bd1a4630c2aacd3fa5f8b016d4c189
>---------------------------------------------------------------
commit 4f3bbe7ed773d207613815b59a53de871794b495
Author: Matthieu Lefebvre <ml15 at princeton.edu>
Date: Tue Dec 2 10:23:29 2014 -0500
Reads locally and broadcasts database MPI IC
>---------------------------------------------------------------
4f3bbe7ed773d207613815b59a53de871794b495
src/specfem3D/read_mesh_databases.F90 | 100 ++++++++++++++++++++++++++++++++--
1 file changed, 96 insertions(+), 4 deletions(-)
diff --git a/src/specfem3D/read_mesh_databases.F90 b/src/specfem3D/read_mesh_databases.F90
index 2645df5..22cbdf1 100644
--- a/src/specfem3D/read_mesh_databases.F90
+++ b/src/specfem3D/read_mesh_databases.F90
@@ -962,11 +962,14 @@
endif
! inner core
- if (ADIOS_FOR_MPI_ARRAYS) then
- call read_mesh_databases_MPI_IC_adios()
- else
- call read_mesh_databases_MPI_IC()
+ if (I_should_read_the_database) then
+ if (ADIOS_FOR_MPI_ARRAYS) then
+ call read_mesh_databases_MPI_IC_adios()
+ else
+ call read_mesh_databases_MPI_IC()
+ endif
endif
+ call bcast_mesh_databases_MPI_IC()
allocate(buffer_send_vector_inner_core(NDIM,max_nibool_interfaces_ic,num_interfaces_inner_core), &
buffer_recv_vector_inner_core(NDIM,max_nibool_interfaces_ic,num_interfaces_inner_core), &
@@ -1834,3 +1837,92 @@
endif
end subroutine bcast_mesh_databases_MPI_OC
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine bcast_mesh_databases_MPI_IC()
+
+ use specfem_par
+ use specfem_par_innercore
+ implicit none
+
+ ! local parameters
+ integer :: ier
+
+ ! MPI interfaces
+ call bcast_all_i_for_database(num_interfaces_inner_core, 1)
+ if (.not. I_should_read_the_database) then
+ allocate(my_neighbours_inner_core(num_interfaces_inner_core), &
+ nibool_interfaces_inner_core(num_interfaces_inner_core), &
+ stat=ier)
+ if (ier /= 0 ) &
+ call exit_mpi(myrank,'Error allocating array my_neighbours_inner_core etc.')
+ endif
+
+ if (num_interfaces_inner_core > 0) then
+ call bcast_all_i_for_database(max_nibool_interfaces_ic, 1)
+ if (.not. I_should_read_the_database) then
+ allocate(ibool_interfaces_inner_core(max_nibool_interfaces_ic,num_interfaces_inner_core), &
+ stat=ier)
+ if (ier /= 0 ) call exit_mpi(myrank,'Error allocating array ibool_interfaces_inner_core')
+ endif
+
+ call bcast_all_i_for_database(my_neighbours_inner_core(1), 1)
+ call bcast_all_i_for_database(nibool_interfaces_inner_core(1), 1)
+ call bcast_all_i_for_database(ibool_interfaces_inner_core(1,1), 1)
+ else
+ ! dummy array
+ max_nibool_interfaces_ic = 0
+ if (.not. I_should_read_the_database) then
+ allocate(ibool_interfaces_inner_core(0,0),stat=ier)
+ if (ier /= 0 ) call exit_mpi(myrank,'Error allocating array dummy ibool_interfaces_inner_core')
+ endif
+ endif
+
+ ! inner / outer elements
+ call bcast_all_i_for_database(nspec_inner_inner_core, 1)
+ call bcast_all_i_for_database(nspec_outer_inner_core, 1)
+ call bcast_all_i_for_database(num_phase_ispec_inner_core, 1)
+ if (num_phase_ispec_inner_core < 0 ) &
+ call exit_mpi(myrank,'Error num_phase_ispec_inner_core is < zero')
+
+ if (.not. I_should_read_the_database) then
+ allocate(phase_ispec_inner_inner_core(num_phase_ispec_inner_core,2),&
+ stat=ier)
+ if (ier /= 0 ) &
+ call exit_mpi(myrank,'Error allocating array phase_ispec_inner_inner_core')
+ endif
+
+ if (num_phase_ispec_inner_core > 0 ) then
+ call bcast_all_i_for_database(phase_ispec_inner_inner_core(1,1), 1)
+ endif
+
+ ! mesh coloring for GPUs
+ if (USE_MESH_COLORING_GPU) then
+ ! colors
+ call bcast_all_i_for_database(num_colors_outer_inner_core, 1)
+ call bcast_all_i_for_database(num_colors_inner_inner_core, 1)
+
+ if (.not. I_should_read_the_database) then
+ allocate(num_elem_colors_inner_core(num_colors_outer_inner_core + num_colors_inner_inner_core), &
+ stat=ier)
+ if (ier /= 0 ) &
+ call exit_mpi(myrank,'Error allocating num_elem_colors_inner_core array')
+ endif
+
+ call bcast_all_i_for_database(num_elem_colors_inner_core(1), 1)
+ else
+ ! allocates dummy arrays
+ num_colors_outer_inner_core = 0
+ num_colors_inner_inner_core = 0
+ if (.not. I_should_read_the_database) then
+ allocate(num_elem_colors_inner_core(num_colors_outer_inner_core + num_colors_inner_inner_core), &
+ stat=ier)
+ if (ier /= 0 ) &
+ call exit_mpi(myrank,'Error allocating num_elem_colors_inner_core array')
+ endif
+ endif
+
+ end subroutine bcast_mesh_databases_MPI_IC
More information about the CIG-COMMITS
mailing list