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 : ! Author: A. Marek, MPCDF
54 :
55 :
56 : #include "../../general/sanity.F90"
57 : use elpa
58 : ! use elpa1_compute
59 : use elpa_mpi
60 : use precision
61 : implicit none
62 :
63 : character*1 :: uplo_a, uplo_c
64 :
65 : integer(kind=ik), intent(in) :: na, lda, ldaCols, ldb, ldbCols, ldc, ldcCols, nblk
66 : integer(kind=ik) :: ncb, mpi_comm_rows, mpi_comm_cols
67 : #if REALCASE == 1
68 : #ifdef USE_ASSUMED_SIZE
69 : real(kind=REAL_DATATYPE) :: a(lda,*), b(ldb,*), c(ldc,*)
70 : #else
71 : real(kind=REAL_DATATYPE) :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
72 : #endif
73 : #endif
74 : #if COMPLEXCASE == 1
75 : #ifdef USE_ASSUMED_SIZE
76 : complex(kind=COMPLEX_DATATYPE) :: a(lda,*), b(ldb,*), c(ldc,*)
77 : #else
78 : complex(kind=COMPLEX_DATATYPE) :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
79 : #endif
80 : #endif
81 : ! integer(kind=ik) :: my_prow, my_pcol, np_rows, np_cols, mpierr
82 : ! integer(kind=ik) :: l_cols, l_rows, l_rows_np
83 : ! integer(kind=ik) :: np, n, nb, nblk_mult, lrs, lre, lcs, lce
84 : ! integer(kind=ik) :: gcol_min, gcol, goff
85 : ! integer(kind=ik) :: nstor, nr_done, noff, np_bc, n_aux_bc, nvals
86 : ! integer(kind=ik), allocatable :: lrs_save(:), lre_save(:)
87 :
88 : ! logical :: a_lower, a_upper, c_lower, c_upper
89 : !#if REALCASE == 1
90 : ! real(kind=REAL_DATATYPE), allocatable :: aux_mat(:,:), aux_bc(:), tmp1(:,:), tmp2(:,:)
91 : !#endif
92 : !#if COMPLEXCASE == 1
93 : ! complex(kind=COMPLEX_DATATYPE), allocatable :: aux_mat(:,:), aux_bc(:), tmp1(:,:), tmp2(:,:)
94 : !#endif
95 : ! integer(kind=ik) :: istat
96 : ! character(200) :: errorMessage
97 : logical :: success
98 : integer(kind=ik) :: successInternal, error
99 : class(elpa_t), pointer :: e
100 :
101 : !call timer%start("elpa_mult_at_b_&
102 : !&MATH_DATATYPE&
103 : !&_&
104 : !&PRECISION&
105 : !&_legacy_interface")
106 :
107 1152 : success = .true.
108 :
109 : !call mpi_comm_rank(mpi_comm_rows,my_prow,mpierr)
110 : !call mpi_comm_size(mpi_comm_rows,np_rows,mpierr)
111 : !call mpi_comm_rank(mpi_comm_cols,my_pcol,mpierr)
112 : !call mpi_comm_size(mpi_comm_cols,np_cols,mpierr)
113 :
114 : !l_rows = local_index(na, my_prow, np_rows, nblk, -1) ! Local rows of a and b
115 : !l_cols = local_index(ncb, my_pcol, np_cols, nblk, -1) ! Local cols of b
116 :
117 1152 : if (elpa_init(CURRENT_API_VERSION) /= ELPA_OK) then
118 0 : print *, "ELPA API version not supported"
119 0 : success = .false.
120 0 : return
121 : endif
122 :
123 1152 : e => elpa_allocate()
124 :
125 1152 : call e%set("na", na, error)
126 1152 : if (error .ne. ELPA_OK) then
127 0 : print *,"Problem setting option. Aborting..."
128 0 : stop
129 : endif
130 1152 : call e%set("local_nrows", lda, error)
131 1152 : if (error .ne. ELPA_OK) then
132 0 : print *,"Problem setting option. Aborting..."
133 0 : stop
134 : endif
135 1152 : call e%set("local_ncols", ldaCols, error)
136 1152 : if (error .ne. ELPA_OK) then
137 0 : print *,"Problem setting option. Aborting..."
138 0 : stop
139 : endif
140 1152 : call e%set("nblk", nblk, error)
141 1152 : if (error .ne. ELPA_OK) then
142 0 : print *,"Problem setting option. Aborting..."
143 0 : stop
144 : endif
145 :
146 1152 : call e%set("mpi_comm_rows", mpi_comm_rows, error)
147 1152 : if (error .ne. ELPA_OK) then
148 0 : print *,"Problem setting option. Aborting..."
149 0 : stop
150 : endif
151 1152 : call e%set("mpi_comm_cols", mpi_comm_cols, error)
152 1152 : if (error .ne. ELPA_OK) then
153 0 : print *,"Problem setting option. Aborting..."
154 0 : stop
155 : endif
156 :
157 1152 : if (e%setup() .ne. ELPA_OK) then
158 0 : print *, "Cannot setup ELPA instance"
159 0 : success = .false.
160 : endif
161 :
162 : call e%hermitian_multiply(uplo_a, uplo_c, ncb, a(1:lda,1:ldaCols), &
163 : b(1:ldb,1:ldbCols), ldb, ldbCols, &
164 1152 : c(1:ldc,1:ldcCols), ldc, ldcCols, successInternal)
165 :
166 1152 : if (successInternal .ne. ELPA_OK) then
167 0 : print *, "Cannot run multiply_a_b"
168 0 : success = .false.
169 0 : return
170 : endif
171 1152 : call elpa_deallocate(e)
172 :
173 1152 : call elpa_uninit()
174 :
175 : !call timer%stop("elpa_mult_at_b_&
176 : !&MATH_DATATYPE&
177 : !&_&
178 : !&PRECISION&
179 : !&_legacy_interface")
180 :
181 : #undef REALCASE
182 : #undef COMPLEXCASE
183 : #undef DOUBLE_PRECISION
184 : #undef SINGLE_PRECISION
185 :
|
