[cig-commits] [commit] devel: parallel fault fix:Add sychronizations at every timestep to ensure thet the displacement and velocity values at nodes on MPI interface stay equal on all processors that share the node. This have to be done because of the nolinearity introduced by dynamic fault solver. Will be activated only when dynamic fault simulation is turned on. (7fd4b96)

cig_noreply at geodynamics.org cig_noreply at geodynamics.org
Tue Jul 1 17:01:18 PDT 2014


Repository : https://github.com/geodynamics/specfem3d

On branch  : devel
Link       : https://github.com/geodynamics/specfem3d/compare/8bb89bad6a40cbe495495c3fdaddbb8ff3374bd7...35ff4e4b7f0c54c55b1a26cdbe5c6cd7d5dd3b55

>---------------------------------------------------------------

commit 7fd4b96939df53459f0d61fa35301a0e9e934d50
Author: Kangchen Bai <kbai at mjollnir.gps.caltech.edu>
Date:   Tue Jul 1 15:37:49 2014 -0700

    parallel fault fix:Add sychronizations at every timestep to ensure thet the displacement and velocity values at nodes on MPI interface stay equal on all processors that share the node. This have to be done because of the nolinearity introduced by dynamic fault solver. Will be activated only when dynamic fault simulation is turned on.


>---------------------------------------------------------------

7fd4b96939df53459f0d61fa35301a0e9e934d50
 src/specfem3D/assemble_MPI_vector.f90              | 104 +++++++++++++++++++++
 ...compute_forces_viscoelastic_calling_routine.F90 |  16 ++++
 2 files changed, 120 insertions(+)

diff --git a/src/specfem3D/assemble_MPI_vector.f90 b/src/specfem3D/assemble_MPI_vector.f90
index 3a6a2bb..464a59c 100644
--- a/src/specfem3D/assemble_MPI_vector.f90
+++ b/src/specfem3D/assemble_MPI_vector.f90
@@ -128,7 +128,111 @@
 !
 !-------------------------------------------------------------------------------------------------
 !
+  subroutine synchronize_MPI_vector_blocking_ord(NPROC,NGLOB_AB,array_val, &
+                        num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
+                        nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
+                        my_neighbours_ext_mesh,myrank)
+! kbai added this subroutine to synchronize a vector field 
+! to ensure that its values at nodes on MPI interfaces stay equal on all processors that share the node.
+! Synchronize by setting the value to that of the processor with highest rank
+! (it doesn't really matter which value we take, as long as all procs end up with exactly the same value). 
+! We assume that the interfaces are ordered by increasing rank of the neighbour.
+! Uses blocking communication: only returns after values have been received and assembled
+  implicit none
+
+  include "constants.h"
+
+  integer :: NPROC
+  integer :: NGLOB_AB
+
+! array to assemble
+  real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: array_val
+
+  integer :: num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh,myrank
+  integer, dimension(num_interfaces_ext_mesh) :: nibool_interfaces_ext_mesh,my_neighbours_ext_mesh
+  integer, dimension(max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh) :: ibool_interfaces_ext_mesh
+  ! local parameters
+
+  ! send/receive temporary buffers
+  real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: buffer_send_vector
+  real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: buffer_recv_vector
+  ! requests
+  integer, dimension(:), allocatable :: request_send_vector
+  integer, dimension(:), allocatable :: request_recv_vector
+
+  integer ipoin,iinterface,ier,iglob
+
+
+
+! setting the value to that of the processor with highest rank
+
+  if(NPROC > 1) then
+
+    allocate(buffer_send_vector(NDIM,max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh),stat=ier)
+    if( ier /= 0 ) stop 'error allocating array buffer_send_vector'
+    allocate(buffer_recv_vector(NDIM,max_nibool_interfaces_ext_mesh,num_interfaces_ext_mesh),stat=ier)
+    if( ier /= 0 ) stop 'error allocating array buffer_recv_vector'
+     allocate(request_send_vector(num_interfaces_ext_mesh),stat=ier)
+    if( ier /= 0 ) stop 'error allocating array request_send_vector'
+    allocate(request_recv_vector(num_interfaces_ext_mesh),stat=ier)
+    if( ier /= 0 ) stop 'error allocating array request_recv_vector'
+
+    ! partition border copy into the buffer
+    do iinterface = 1, num_interfaces_ext_mesh
+      do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
+        iglob = ibool_interfaces_ext_mesh(ipoin,iinterface)
+        buffer_send_vector(:,ipoin,iinterface) = array_val(:,iglob)
+      enddo
+    enddo
 
+    ! send messages
+    do iinterface = 1, num_interfaces_ext_mesh
+      call isend_cr(buffer_send_vector(1,1,iinterface), &
+                     NDIM*nibool_interfaces_ext_mesh(iinterface), &
+                     my_neighbours_ext_mesh(iinterface), &
+                     itag, &
+                     request_send_vector(iinterface) )
+      call irecv_cr(buffer_recv_vector(1,1,iinterface), &
+                     NDIM*nibool_interfaces_ext_mesh(iinterface), &
+                     my_neighbours_ext_mesh(iinterface), &
+                     itag, &
+                     request_recv_vector(iinterface) )
+    enddo
+
+    ! wait for communications completion (recv)
+    do iinterface = 1, num_interfaces_ext_mesh
+      call wait_req(request_recv_vector(iinterface))
+    enddo
+
+    ! set the value to that of the highest-rank processor
+  do iinterface = 1, num_interfaces_ext_mesh
+    if ( myrank < my_neighbours_ext_mesh(iinterface)) then
+    do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
+      iglob = ibool_interfaces_ext_mesh(ipoin,iinterface)
+      array_val(:,iglob) = buffer_recv_vector(:,ipoin,iinterface)
+    enddo
+    endif
+  enddo
+
+ 
+
+  ! wait for communications completion (send)
+    do iinterface = 1, num_interfaces_ext_mesh
+      call wait_req(request_send_vector(iinterface))
+    enddo
+
+    deallocate(buffer_send_vector)
+    deallocate(buffer_recv_vector)
+    deallocate(request_send_vector)
+    deallocate(request_recv_vector)
+  endif
+
+
+
+  end subroutine synchronize_MPI_vector_blocking_ord
+!
+!------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+!
   subroutine assemble_MPI_vector_async_send(NPROC,NGLOB_AB,array_val, &
                                            buffer_send_vector_ext_mesh,buffer_recv_vector_ext_mesh, &
                                            num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
diff --git a/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90 b/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90
index 2fbfec5..8467454 100644
--- a/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90
+++ b/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90
@@ -43,6 +43,22 @@ subroutine compute_forces_viscoelastic()
   logical:: phase_is_inner
   integer:: iface,ispec,igll,i,j,k,iglob
 
+ 
+  ! kbai added the following two synchronizations to ensure that the displacement and velocity values 
+  ! at nodes on MPI interfaces stay equal on all processors that share the node.
+  ! Do this only for dynamic rupture simulations
+  if (SIMULATION_TYPE_DYN) then
+    call synchronize_MPI_vector_blocking_ord(NPROC,NGLOB_AB,displ, &
+                                     num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
+                                     nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
+                                     my_neighbours_ext_mesh,myrank)
+    call synchronize_MPI_vector_blocking_ord(NPROC,NGLOB_AB,veloc, &
+                                     num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
+                                     nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
+                                     my_neighbours_ext_mesh,myrank)
+  endif
+
+
 ! distinguishes two runs: for points on MPI interfaces, and points within the partitions
   do iphase=1,2
 



More information about the CIG-COMMITS mailing list