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 8832 : function solve_evp_&
53 : &MATH_DATATYPE&
54 : &_&
55 : &2stage_&
56 : &PRECISION &
57 8832 : (na, nev, a, lda, ev, q, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, mpi_comm_all, &
58 : #if REALCASE == 1
59 : THIS_ELPA_KERNEL_API, useQR, &
60 : #endif
61 : #if COMPLEXCASE == 1
62 : THIS_ELPA_KERNEL_API, &
63 : #endif
64 : useGPU) result(success)
65 :
66 : use iso_c_binding
67 : use elpa
68 : use elpa_mpi
69 :
70 : implicit none
71 :
72 : logical, intent(in), optional :: useGPU
73 : #if REALCASE == 1
74 : logical, intent(in), optional :: useQR
75 : #endif
76 : integer(kind=c_int), intent(in), optional :: THIS_ELPA_KERNEL_API
77 :
78 : integer(kind=c_int), intent(in) :: na, nev, lda, ldq, matrixCols, mpi_comm_rows, &
79 : mpi_comm_cols, mpi_comm_all
80 : integer(kind=c_int), intent(in) :: nblk
81 :
82 : #ifdef USE_ASSUMED_SIZE
83 : MATH_DATATYPE(kind=C_DATATYPE_KIND), intent(inout) :: a(lda,*), q(ldq,*)
84 : #else
85 : MATH_DATATYPE(kind=C_DATATYPE_KIND), intent(inout) :: a(lda,matrixCols), q(ldq,matrixCols)
86 : #endif
87 : real(kind=C_DATATYPE_KIND), intent(inout) :: ev(na)
88 :
89 : integer(kind=c_int) :: my_prow, my_pcol, mpierr
90 : logical :: success
91 :
92 : integer(kind=c_int) :: successInternal,error
93 : class(elpa_t), pointer :: e
94 :
95 8832 : call mpi_comm_rank(mpi_comm_rows,my_prow,mpierr)
96 8832 : call mpi_comm_rank(mpi_comm_cols,my_pcol,mpierr)
97 :
98 8832 : success = .true.
99 8832 : if (elpa_init(CURRENT_API_VERSION) /= ELPA_OK) then
100 0 : print *, "ELPA API version not supported"
101 0 : success = .false.
102 0 : return
103 : endif
104 :
105 8832 : e => elpa_allocate()
106 :
107 8832 : call e%set("na", na,error)
108 8832 : if (error .ne. ELPA_OK) then
109 0 : print *,"Problem setting option. Aborting..."
110 0 : stop
111 : endif
112 8832 : call e%set("nev", nev,error)
113 8832 : if (error .ne. ELPA_OK) then
114 0 : print *,"Problem setting option. Aborting..."
115 0 : stop
116 : endif
117 8832 : call e%set("local_nrows", lda,error)
118 8832 : if (error .ne. ELPA_OK) then
119 0 : print *,"Problem setting option. Aborting..."
120 0 : stop
121 : endif
122 8832 : call e%set("local_ncols", matrixCols,error)
123 8832 : if (error .ne. ELPA_OK) then
124 0 : print *,"Problem setting option. Aborting..."
125 0 : stop
126 : endif
127 8832 : call e%set("nblk", nblk,error)
128 8832 : if (error .ne. ELPA_OK) then
129 0 : print *,"Problem setting option. Aborting..."
130 0 : stop
131 : endif
132 :
133 8832 : call e%set("mpi_comm_parent", mpi_comm_all,error)
134 8832 : if (error .ne. ELPA_OK) then
135 0 : print *,"Problem setting option. Aborting..."
136 0 : stop
137 : endif
138 8832 : call e%set("mpi_comm_rows", mpi_comm_rows,error)
139 8832 : if (error .ne. ELPA_OK) then
140 0 : print *,"Problem setting option. Aborting..."
141 0 : stop
142 : endif
143 8832 : call e%set("mpi_comm_cols", mpi_comm_cols,error)
144 8832 : if (error .ne. ELPA_OK) then
145 0 : print *,"Problem setting option. Aborting..."
146 0 : stop
147 : endif
148 :
149 8832 : call e%set("timings",1,error)
150 8832 : if (error .ne. ELPA_OK) then
151 0 : print *,"Problem setting option. Aborting..."
152 0 : stop
153 : endif
154 :
155 8832 : if (e%setup() .ne. ELPA_OK) then
156 0 : print *, "Cannot setup ELPA instance"
157 0 : success = .false.
158 0 : return
159 : endif
160 :
161 8832 : call e%set("solver", ELPA_SOLVER_2STAGE, successInternal)
162 8832 : if (successInternal .ne. ELPA_OK) then
163 0 : print *, "Cannot set ELPA 1stage solver"
164 0 : success = .false.
165 0 : return
166 : endif
167 :
168 8832 : if (present(useGPU)) then
169 3072 : if (useGPU) then
170 0 : call e%set("gpu", 1, successInternal)
171 0 : if (successInternal .ne. ELPA_OK) then
172 0 : print *, "Cannot set gpu"
173 0 : success = .false.
174 0 : return
175 : endif
176 : else
177 3072 : call e%set("gpu", 0, successInternal)
178 3072 : if (successInternal .ne. ELPA_OK) then
179 0 : print *, "Cannot set gpu"
180 0 : success = .false.
181 0 : return
182 : endif
183 : endif
184 : endif
185 :
186 : #if REALCASE == 1
187 4416 : if (present(useQR)) then
188 1536 : if (useQR) then
189 0 : call e%set("qr", 1, successInternal)
190 0 : if (successInternal .ne. ELPA_OK) then
191 0 : print *, "Cannot set qr"
192 0 : success = .false.
193 0 : return
194 : endif
195 : else
196 1536 : call e%set("qr", 0, successInternal)
197 1536 : if (successInternal .ne. ELPA_OK) then
198 0 : print *, "Cannot set qr"
199 0 : success = .false.
200 0 : return
201 : endif
202 : endif
203 : endif
204 : #endif
205 :
206 : #if REALCASE == 1
207 4416 : if (present(THIS_ELPA_KERNEL_API)) then
208 2112 : call e%set("real_kernel",THIS_ELPA_KERNEL_API, successInternal)
209 2112 : if (successInternal .ne. ELPA_OK) then
210 0 : print *, "Cannot set ELPA2 stage real_kernel"
211 0 : success = .false.
212 0 : return
213 : endif
214 : endif
215 : #endif
216 :
217 : #if COMPLEXCASE == 1
218 4416 : if (present(THIS_ELPA_KERNEL_API)) then
219 2112 : call e%set("complex_kernel",THIS_ELPA_KERNEL_API, successInternal)
220 2112 : if (successInternal .ne. ELPA_OK) then
221 0 : print *, "Cannot set ELPA2 stage complex_kernel"
222 0 : success = .false.
223 0 : return
224 : endif
225 : endif
226 : #endif
227 :
228 8832 : call e%set("print_flops", 1,successInternal)
229 8832 : if (successInternal .ne. ELPA_OK) then
230 0 : print *, "Cannot set print_flops"
231 0 : success = .false.
232 0 : return
233 : endif
234 8832 : call e%set("timings", 1,error)
235 8832 : if (error .ne. ELPA_OK) then
236 0 : print *,"Problem setting option. Aborting..."
237 0 : stop
238 : endif
239 :
240 8832 : call e%eigenvectors(a(1:lda,1:matrixCols), ev, q(1:ldq,1:matrixCols), successInternal)
241 8832 : if (successInternal .ne. ELPA_OK) then
242 0 : print *, "Cannot solve with ELPA 2stage"
243 0 : success = .false.
244 0 : return
245 : endif
246 :
247 8832 : if (na .gt. 1) then
248 : time_evp_fwd = e%get_time("elpa_solve_evp_&
249 : &MATH_DATATYPE&
250 : &_2stage_&
251 : &PRECISION&
252 8832 : &","bandred")
253 :
254 8832 : if (my_prow==0 .and. my_pcol==0 .and. elpa_print_times) &
255 3840 : write(error_unit,*) 'Time bandred_real :', time_evp_fwd
256 :
257 : time_evp_fwd = time_evp_fwd + e%get_time("elpa_solve_evp_&
258 : &MATH_DATATYPE&
259 : &_2stage_&
260 : &PRECISION&
261 8832 : &","tridiag")
262 :
263 8832 : if (my_prow==0 .and. my_pcol==0 .and. elpa_print_times) &
264 3840 : write(error_unit,*) 'Time tridiag_band_real :',e%get_time("elpa_solve_evp_&
265 : &MATH_DATATYPE&
266 : &_2stage_&
267 : &PRECISION&
268 7680 : &","tridiag")
269 :
270 : time_evp_solve = e%get_time("elpa_solve_evp_&
271 : &MATH_DATATYPE&
272 : &_2stage_&
273 : &PRECISION&
274 8832 : &","solve")
275 :
276 8832 : if (my_prow==0 .and. my_pcol==0 .and. elpa_print_times) &
277 3840 : write(error_unit,*) 'Time solve_tridi :',time_evp_solve
278 :
279 8832 : if (nev .ge. 1) then
280 : time_evp_back = e%get_time("elpa_solve_evp_&
281 : &MATH_DATATYPE&
282 : &_2stage_&
283 : &PRECISION&
284 8832 : &","trans_ev_to_band")
285 :
286 8832 : if (my_prow==0 .and. my_pcol==0 .and. elpa_print_times) &
287 3840 : write(error_unit,*) 'Time trans_ev_tridi_to_band_real:',time_evp_back
288 :
289 : time_evp_back = time_evp_back + &
290 : e%get_time("elpa_solve_evp_&
291 : &MATH_DATATYPE&
292 : &_2stage_&
293 : &PRECISION&
294 8832 : &","trans_ev_to_full")
295 :
296 8832 : if (my_prow==0 .and. my_pcol==0 .and. elpa_print_times) &
297 3840 : write(error_unit,*) 'Time trans_ev_band_to_full_real :',e%get_time("elpa_solve_evp_&
298 : &MATH_DATATYPE&
299 : &_2stage_&
300 : &PRECISION&
301 7680 : &","trans_ev_to_full")
302 : endif
303 : endif ! na > 1
304 8832 : call elpa_deallocate(e)
305 :
306 8832 : call elpa_uninit()
307 :
308 8832 : end function
309 :
310 : ! vim: syntax=fortran
|
