elpa2_symm_matrix_allreduce_real_template.X90 1.82 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

    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