subroutine M_symm_matrix_allreduce_PRECISION(n,a,lda,ldb,comm) !------------------------------------------------------------------------------- ! symm_matrix_allreduce: Does an mpi_allreduce for a symmetric matrix A. ! On entry, only the upper half of A needs to be set ! On exit, the complete matrix is set !------------------------------------------------------------------------------- #ifdef HAVE_DETAILED_TIMINGS use timings #endif use precision implicit none integer(kind=ik) :: n, lda, ldb, comm #ifdef USE_ASSUMED_SIZE real(kind=REAL_DATATYPE) :: a(lda,*) #else real(kind=REAL_DATATYPE) :: a(lda,ldb) #endif integer(kind=ik) :: i, nc, mpierr real(kind=REAL_DATATYPE) :: h1(n*n), h2(n*n) #ifdef HAVE_DETAILED_TIMINGS call timer%start("symm_matrix_allreduce" // M_PRECISION_SUFFIX) #endif nc = 0 do i=1,n h1(nc+1:nc+i) = a(1:i,i) nc = nc+i enddo #ifdef WITH_MPI #ifdef HAVE_DETAILED_TIMINGS call timer%start("mpi_communication") #endif call mpi_allreduce(h1, h2, nc, M_MPI_REAL_PRECISION, MPI_SUM, comm, mpierr) #ifdef HAVE_DETAILED_TIMINGS call timer%stop("mpi_communication") #endif nc = 0 do i=1,n a(1:i,i) = h2(nc+1:nc+i) a(i,1:i-1) = a(1:i-1,i) nc = nc+i enddo #else /* WITH_MPI */ ! h2=h1 nc = 0 do i=1,n a(1:i,i) = h1(nc+1:nc+i) a(i,1:i-1) = a(1:i-1,i) nc = nc+i enddo #endif /* WITH_MPI */ ! nc = 0 ! do i=1,n ! a(1:i,i) = h2(nc+1:nc+i) ! a(i,1:i-1) = a(1:i-1,i) ! nc = nc+i ! enddo #ifdef HAVE_DETAILED_TIMINGS call timer%stop("symm_matrix_allreduce" // M_PRECISION_SUFFIX) #endif end subroutine M_symm_matrix_allreduce_PRECISION