Line data Source code
1 : ! This file is part of ELPA.
2 : !
3 : ! The ELPA library was originally created by the ELPA consortium,
4 : ! consisting of the following organizations:
5 : !
6 : ! - Max Planck Computing and Data Facility (MPCDF), formerly known as
7 : ! Rechenzentrum Garching der Max-Planck-Gesellschaft (RZG),
8 : ! - Bergische Universität Wuppertal, Lehrstuhl für angewandte
9 : ! Informatik,
10 : ! - Technische Universität München, Lehrstuhl für Informatik mit
11 : ! Schwerpunkt Wissenschaftliches Rechnen ,
12 : ! - Fritz-Haber-Institut, Berlin, Abt. Theorie,
13 : ! - Max-Plack-Institut für Mathematik in den Naturwissenschaften,
14 : ! Leipzig, Abt. Komplexe Strukutren in Biologie und Kognition,
15 : ! and
16 : ! - IBM Deutschland GmbH
17 : !
18 : ! This particular source code file contains additions, changes and
19 : ! enhancements authored by Intel Corporation which is not part of
20 : ! the ELPA consortium.
21 : !
22 : ! More information can be found here:
23 : ! http://elpa.mpcdf.mpg.de/
24 : !
25 : ! ELPA is free software: you can redistribute it and/or modify
26 : ! it under the terms of the version 3 of the license of the
27 : ! GNU Lesser General Public License as published by the Free
28 : ! Software Foundation.
29 : !
30 : ! ELPA is distributed in the hope that it will be useful,
31 : ! but WITHOUT ANY WARRANTY; without even the implied warranty of
32 : ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
33 : ! GNU Lesser General Public License for more details.
34 : !
35 : ! You should have received a copy of the GNU Lesser General Public License
36 : ! along with ELPA. If not, see <http://www.gnu.org/licenses/>
37 : !
38 : ! ELPA reflects a substantial effort on the part of the original
39 : ! ELPA consortium, and we ask you to respect the spirit of the
40 : ! license that we chose: i.e., please contribute any changes you
41 : ! may have back to the original ELPA library distribution, and keep
42 : ! any derivatives of ELPA under the same license that we chose for
43 : ! the original distribution, the GNU Lesser General Public License.
44 : !
45 : !
46 : ! ELPA1 -- Faster replacements for ScaLAPACK symmetric eigenvalue routines
47 : !
48 : ! Copyright of the original code rests with the authors inside the ELPA
49 : ! consortium. The copyright of any additional modifications shall rest
50 : ! with their original authors, but shall adhere to the licensing terms
51 : ! distributed along with the original code in the file "COPYING".
52 :
53 : #include "../general/sanity.F90"
54 :
55 : subroutine herm_matrix_allreduce_&
56 209664 : &PRECISION &
57 209664 : (obj, n, a, lda, ldb, comm)
58 : !-------------------------------------------------------------------------------
59 : ! herm_matrix_allreduce: Does an mpi_allreduce for a hermitian matrix A.
60 : ! On entry, only the upper half of A needs to be set
61 : ! On exit, the complete matrix is set
62 : use elpa_abstract_impl
63 : use precision
64 : implicit none
65 : class(elpa_abstract_impl_t), intent(inout) :: obj
66 : integer(kind=ik) :: n, lda, ldb, comm
67 : complex(kind=COMPLEX_DATATYPE) :: a(lda,ldb)
68 :
69 : integer(kind=ik) :: i, nc, mpierr
70 419328 : complex(kind=COMPLEX_DATATYPE) :: h1(n*n), h2(n*n)
71 :
72 209664 : call obj%timer%start("herm_matrix_allreduce" // PRECISION_SUFFIX)
73 :
74 209664 : nc = 0
75 6518016 : do i=1,n
76 6308352 : h1(nc+1:nc+i) = a(1:i,i)
77 6308352 : nc = nc+i
78 : enddo
79 : #ifdef WITH_MPI
80 139776 : call obj%timer%start("mpi_communication")
81 139776 : call mpi_allreduce(h1, h2, nc, MPI_COMPLEX_PRECISION, MPI_SUM, comm, mpierr)
82 139776 : call obj%timer%stop("mpi_communication")
83 :
84 139776 : nc = 0
85 4345344 : do i=1,n
86 4205568 : a(1:i,i) = h2(nc+1:nc+i)
87 4205568 : a(i,1:i-1) = conjg(a(1:i-1,i))
88 4205568 : nc = nc+i
89 : enddo
90 :
91 :
92 : #else /* WITH_MPI */
93 : ! h2(1:nc) = h1(1:nc)
94 :
95 69888 : nc = 0
96 2172672 : do i=1,n
97 2102784 : a(1:i,i) = h1(nc+1:nc+i)
98 2102784 : a(i,1:i-1) = conjg(a(1:i-1,i))
99 2102784 : nc = nc+i
100 : enddo
101 :
102 :
103 : #endif /* WITH_MPI */
104 :
105 : ! nc = 0
106 : ! do i=1,n
107 : ! a(1:i,i) = h2(nc+1:nc+i)
108 : ! a(i,1:i-1) = conjg(a(1:i-1,i))
109 : ! nc = nc+i
110 : ! enddo
111 :
112 209664 : call obj%timer%stop("herm_matrix_allreduce" // PRECISION_SUFFIX)
113 :
114 : end subroutine herm_matrix_allreduce_&
115 209664 : &PRECISION
116 :
117 :
|