(git:97501a3)
Loading...
Searching...
No Matches
cp_fm_dlaf_api.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8MODULE cp_fm_dlaf_api
9
10 USE cp_fm_basic_linalg, ONLY: cp_fm_uplo_to_full
11 USE cp_fm_types, ONLY: cp_fm_type
12 USE kinds, ONLY: sp, dp
13#include "../base/base_uses.f90"
14
15#if defined(__DLAF)
16 USE cp_dlaf_utils_api, ONLY: cp_dlaf_create_grid
17 USE dlaf_fortran, ONLY: dlaf_pdpotrf, &
18 dlaf_pdsyevd, &
19 dlaf_pdsygvd, &
20 dlaf_pspotrf, &
21 dlaf_pspotri, &
22 dlaf_pdpotri
23#endif
24
25 IMPLICIT NONE
26
27 PRIVATE
28
29 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_fm_dlaf_api'
30
31 PUBLIC :: cp_pdpotrf_dlaf, cp_pspotrf_dlaf
32 PUBLIC :: cp_pdpotri_dlaf, cp_pspotri_dlaf
33 PUBLIC :: cp_fm_diag_dlaf, cp_fm_diag_gen_dlaf
34
35CONTAINS
36
37!***************************************************************************************************
38!> \brief Cholesky factorization using DLA-Future
39!> \param uplo ...
40!> \param n Matrix size
41!> \param a Local matrix
42!> \param ia Row index of first row (has to be 1)
43!> \param ja Col index of first column ()
44!> \param desca ScaLAPACK matrix descriptor
45!> \param info 0 if factorization completed normally
46!> \author Rocco Meli
47!> \author Mikael Simberg
48!> \author Mathieu Taillefumier
49! **************************************************************************************************
50 SUBROUTINE cp_pdpotrf_dlaf(uplo, n, a, ia, ja, desca, info)
51 CHARACTER, INTENT(IN) :: uplo
52 INTEGER, INTENT(IN) :: n
53 REAL(kind=dp), DIMENSION(:, :), TARGET :: a
54 INTEGER, INTENT(IN) :: ia, ja
55 INTEGER, DIMENSION(9) :: desca
56 INTEGER, TARGET :: info
57
58 CHARACTER(len=*), PARAMETER :: routinen = 'cp_pdpotrf_dlaf'
59
60 INTEGER :: handle
61
62 CALL timeset(routinen, handle)
63#if defined(__DLAF)
64 CALL dlaf_pdpotrf(uplo, n, a, ia, ja, desca, info)
65#else
66 mark_used(uplo)
67 mark_used(n)
68 mark_used(a)
69 mark_used(ia)
70 mark_used(ja)
71 mark_used(desca)
72 mark_used(info)
73 cpabort("CP2K compiled without the DLA-Future library.")
74#endif
75 CALL timestop(handle)
76 END SUBROUTINE cp_pdpotrf_dlaf
77
78!***************************************************************************************************
79!> \brief Cholesky factorization using DLA-Future
80!> \param uplo ...
81!> \param n Matrix size
82!> \param a Local matrix
83!> \param ia Row index of first row (has to be 1)
84!> \param ja Col index of first column ()
85!> \param desca ScaLAPACK matrix descriptor
86!> \param info 0 if factorization completed normally
87!> \author Rocco Meli
88!> \author Mikael Simberg
89!> \author Mathieu Taillefumier
90! **************************************************************************************************
91 SUBROUTINE cp_pspotrf_dlaf(uplo, n, a, ia, ja, desca, info)
92 CHARACTER, INTENT(IN) :: uplo
93 INTEGER, INTENT(IN) :: n
94 REAL, DIMENSION(:, :), TARGET :: a
95 INTEGER, INTENT(IN) :: ia, ja
96 INTEGER, DIMENSION(9) :: desca
97 INTEGER, TARGET :: info
98
99 CHARACTER(len=*), PARAMETER :: routinen = 'cp_pspotrf_dlaf'
100
101 INTEGER :: handle
102
103 CALL timeset(routinen, handle)
104
105#if defined(__DLAF)
106 CALL dlaf_pspotrf(uplo, n, a, ia, ja, desca, info)
107#else
108 mark_used(uplo)
109 mark_used(n)
110 mark_used(a)
111 mark_used(ia)
112 mark_used(ja)
113 mark_used(desca)
114 mark_used(info)
115 cpabort("CP2K compiled without the DLA-Future library.")
116#endif
117 CALL timestop(handle)
118 END SUBROUTINE cp_pspotrf_dlaf
119
120!***************************************************************************************************
121!> \brief Inverse from Cholesky factorization using DLA-Future
122!> \param uplo ...
123!> \param n Matrix size
124!> \param a Local matrix
125!> \param ia Row index of first row (has to be 1)
126!> \param ja Col index of first column ()
127!> \param desca ScaLAPACK matrix descriptor
128!> \param info 0 if factorization completed normally
129!> \author Rocco Meli
130! **************************************************************************************************
131 SUBROUTINE cp_pdpotri_dlaf(uplo, n, a, ia, ja, desca, info)
132 CHARACTER, INTENT(IN) :: uplo
133 INTEGER, INTENT(IN) :: n
134 REAL(kind=dp), DIMENSION(:, :), TARGET :: a
135 INTEGER, INTENT(IN) :: ia, ja
136 INTEGER, DIMENSION(9) :: desca
137 INTEGER, TARGET :: info
138
139 CHARACTER(len=*), PARAMETER :: routinen = 'cp_pdpotri_dlaf'
140
141 INTEGER :: handle
142
143 CALL timeset(routinen, handle)
144#if defined(__DLAF)
145 CALL dlaf_pdpotri(uplo, n, a, ia, ja, desca, info)
146#else
147 mark_used(uplo)
148 mark_used(n)
149 mark_used(a)
150 mark_used(ia)
151 mark_used(ja)
152 mark_used(desca)
153 mark_used(info)
154 cpabort("CP2K compiled without the DLA-Future library.")
155#endif
156 CALL timestop(handle)
157 END SUBROUTINE cp_pdpotri_dlaf
158
159!***************************************************************************************************
160!> \brief Inverse from Cholesky factorization using DLA-Future
161!> \param uplo ...
162!> \param n Matrix size
163!> \param a Local matrix
164!> \param ia Row index of first row (has to be 1)
165!> \param ja Col index of first column ()
166!> \param desca ScaLAPACK matrix descriptor
167!> \param info 0 if factorization completed normally
168!> \author Rocco Meli
169! **************************************************************************************************
170 SUBROUTINE cp_pspotri_dlaf(uplo, n, a, ia, ja, desca, info)
171 CHARACTER, INTENT(IN) :: uplo
172 INTEGER, INTENT(IN) :: n
173 REAL, DIMENSION(:, :), TARGET :: a
174 INTEGER, INTENT(IN) :: ia, ja
175 INTEGER, DIMENSION(9) :: desca
176 INTEGER, TARGET :: info
177
178 CHARACTER(len=*), PARAMETER :: routinen = 'cp_pspotri_dlaf'
179
180 INTEGER :: handle
181
182 CALL timeset(routinen, handle)
183
184#if defined(__DLAF)
185 CALL dlaf_pspotri(uplo, n, a, ia, ja, desca, info)
186#else
187 mark_used(uplo)
188 mark_used(n)
189 mark_used(a)
190 mark_used(ia)
191 mark_used(ja)
192 mark_used(desca)
193 mark_used(info)
194 cpabort("CP2K compiled without the DLA-Future library.")
195#endif
196 CALL timestop(handle)
197 END SUBROUTINE cp_pspotri_dlaf
198
199! **************************************************************************************************
200!> \brief ...
201!> \param matrix ...
202!> \param eigenvectors ...
203!> \param eigenvalues ...
204! **************************************************************************************************
205 SUBROUTINE cp_fm_diag_dlaf(matrix, eigenvectors, eigenvalues)
206
207 TYPE(cp_fm_type), INTENT(IN) :: matrix, eigenvectors
208 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: eigenvalues
209
210 CHARACTER(LEN=*), PARAMETER :: routinen = 'cp_fm_diag_dlaf'
211
212 INTEGER :: handle, n, nmo
213 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), TARGET :: eig
214
215 CALL timeset(routinen, handle)
216
217 n = matrix%matrix_struct%nrow_global
218 ALLOCATE (eig(n))
219
220 CALL cp_fm_diag_dlaf_base(matrix, eigenvectors, eig)
221
222 nmo = SIZE(eigenvalues, 1)
223 IF (nmo > n) THEN
224 eigenvalues(1:n) = eig(1:n)
225 ELSE
226 eigenvalues(1:nmo) = eig(1:nmo)
227 END IF
228
229 DEALLOCATE (eig)
230
231 CALL timestop(handle)
232
233 END SUBROUTINE cp_fm_diag_dlaf
234
235!***************************************************************************************************
236!> \brief DLA-Future eigensolver
237!> \param matrix ...
238!> \param eigenvectors ...
239!> \param eigenvalues ...
240!> \author Rocco Meli
241! **************************************************************************************************
242 SUBROUTINE cp_fm_diag_dlaf_base(matrix, eigenvectors, eigenvalues)
243 TYPE(cp_fm_type), INTENT(IN) :: matrix, eigenvectors
244 REAL(kind=dp), DIMENSION(:), INTENT(OUT), TARGET :: eigenvalues
245
246 CHARACTER(len=*), PARAMETER :: dlaf_name = 'pdsyevd_dlaf', routinen = 'cp_fm_diag_dlaf_base'
247 CHARACTER, PARAMETER :: uplo = 'L'
248
249 CHARACTER(LEN=100) :: message
250 INTEGER :: dlaf_handle, handle, n
251 INTEGER, DIMENSION(9) :: desca, descz
252 INTEGER, TARGET :: info
253 REAL(kind=dp), DIMENSION(:, :), POINTER :: a, z
254
255 CALL timeset(routinen, handle)
256
257#if defined(__DLAF)
258 ! DLAF needs the lower triangular part
259 ! Use eigenvectors matrix as workspace
260 CALL cp_fm_uplo_to_full(matrix, eigenvectors)
261
262 ! Create DLAF grid from BLACS context; if already present, does nothing
263 CALL cp_dlaf_create_grid(matrix%matrix_struct%context%get_handle())
264
265 n = matrix%matrix_struct%nrow_global
266
267 a => matrix%local_data
268 z => eigenvectors%local_data
269
270 desca(:) = matrix%matrix_struct%descriptor(:)
271 descz(:) = eigenvectors%matrix_struct%descriptor(:)
272
273 info = -1
274 CALL timeset(dlaf_name, dlaf_handle)
275
276 CALL dlaf_pdsyevd(uplo, n, a, 1, 1, desca, eigenvalues, z, 1, 1, descz, info)
277
278 CALL timestop(dlaf_handle)
279
280 IF (info /= 0) THEN
281 WRITE (message, "(A,I0,A)") "ERROR in DLAF_PDSYEVD: Eigensolver failed (INFO = ", info, ")"
282 cpabort(trim(message))
283 END IF
284#else
285 mark_used(a)
286 mark_used(z)
287 mark_used(desca)
288 mark_used(descz)
289 mark_used(matrix)
290 mark_used(eigenvectors)
291 mark_used(eigenvalues)
292 mark_used(uplo)
293 mark_used(n)
294 mark_used(info)
295 mark_used(dlaf_handle)
296 mark_used(dlaf_name)
297 mark_used(message)
298 cpabort("CP2K compiled without DLA-Future-Fortran library.")
299#endif
300
301 CALL timestop(handle)
302
303 END SUBROUTINE cp_fm_diag_dlaf_base
304
305! **************************************************************************************************
306!> \brief ...
307!> \param a_matrix ...
308!> \param b_matrix ...
309!> \param eigenvectors ...
310!> \param eigenvalues ...
311!> \author Rocco Meli
312! **************************************************************************************************
313 SUBROUTINE cp_fm_diag_gen_dlaf(a_matrix, b_matrix, eigenvectors, eigenvalues)
314
315 TYPE(cp_fm_type), INTENT(IN) :: a_matrix, b_matrix, eigenvectors
316 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: eigenvalues
317
318 CHARACTER(LEN=*), PARAMETER :: routinen = 'cp_fm_diag_gen_dlaf'
319
320 INTEGER :: handle, n, nmo
321 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), TARGET :: eig
322
323 CALL timeset(routinen, handle)
324
325 n = a_matrix%matrix_struct%nrow_global
326 ALLOCATE (eig(n))
327
328 CALL cp_fm_diag_gen_dlaf_base(a_matrix, b_matrix, eigenvectors, eig)
329
330 nmo = SIZE(eigenvalues, 1)
331 IF (nmo > n) THEN
332 eigenvalues(1:n) = eig(1:n)
333 ELSE
334 eigenvalues(1:nmo) = eig(1:nmo)
335 END IF
336
337 DEALLOCATE (eig)
338
339 CALL timestop(handle)
340
341 END SUBROUTINE cp_fm_diag_gen_dlaf
342
343!***************************************************************************************************
344!> \brief DLA-Future generalized eigensolver
345!> \param a_matrix ...
346!> \param b_matrix ...
347!> \param eigenvectors ...
348!> \param eigenvalues ...
349!> \author Rocco Meli
350! **************************************************************************************************
351 SUBROUTINE cp_fm_diag_gen_dlaf_base(a_matrix, b_matrix, eigenvectors, eigenvalues)
352 TYPE(cp_fm_type), INTENT(IN) :: a_matrix, b_matrix, eigenvectors
353 REAL(kind=dp), DIMENSION(:), INTENT(OUT), TARGET :: eigenvalues
354
355 CHARACTER(len=*), PARAMETER :: dlaf_name = 'pdsyevd_dlaf', &
356 routinen = 'cp_fm_diag_gen_dlaf_base'
357 CHARACTER, PARAMETER :: uplo = 'L'
358
359 CHARACTER(LEN=100) :: message
360 INTEGER :: dlaf_handle, handle, n
361 INTEGER, DIMENSION(9) :: desca, descb, descz
362 INTEGER, TARGET :: info
363 REAL(kind=dp), DIMENSION(:, :), POINTER :: a, b, z
364
365 CALL timeset(routinen, handle)
366
367#if defined(__DLAF)
368 ! DLAF needs the lower triangular part
369 ! Use eigenvectors matrix as workspace
370 CALL cp_fm_uplo_to_full(a_matrix, eigenvectors)
371 CALL cp_fm_uplo_to_full(b_matrix, eigenvectors)
372
373 ! Create DLAF grid from BLACS context; if already present, does nothing
374 CALL cp_dlaf_create_grid(a_matrix%matrix_struct%context%get_handle())
375
376 n = a_matrix%matrix_struct%nrow_global
377
378 a => a_matrix%local_data
379 b => b_matrix%local_data
380 z => eigenvectors%local_data
381
382 desca(:) = a_matrix%matrix_struct%descriptor(:)
383 descb(:) = b_matrix%matrix_struct%descriptor(:)
384 descz(:) = eigenvectors%matrix_struct%descriptor(:)
385
386 info = -1
387 CALL timeset(dlaf_name, dlaf_handle)
388 CALL dlaf_pdsygvd(uplo, n, a, 1, 1, desca, b, 1, 1, descb, eigenvalues, z, 1, 1, descz, info)
389 CALL timestop(dlaf_handle)
390
391 IF (info /= 0) THEN
392 WRITE (message, "(A,I0,A)") "ERROR in DLAF_PDSYGVD: Generalized Eigensolver failed (INFO = ", info, ")"
393 cpabort(trim(message))
394 END IF
395#else
396 mark_used(a)
397 mark_used(b)
398 mark_used(z)
399 mark_used(desca)
400 mark_used(descb)
401 mark_used(descz)
402 mark_used(a_matrix)
403 mark_used(b_matrix)
404 mark_used(eigenvectors)
405 mark_used(eigenvalues)
406 mark_used(uplo)
407 mark_used(n)
408 mark_used(info)
409 mark_used(dlaf_handle)
410 mark_used(dlaf_name)
411 mark_used(message)
412 cpabort("CP2K compiled without DLA-Future-Fortran library.")
413#endif
414
415 CALL timestop(handle)
416
417 END SUBROUTINE cp_fm_diag_gen_dlaf_base
418
419END MODULE cp_fm_dlaf_api
cp_dlaf_utils_api
Definition cp_dlaf_utils_api.F:8
cp_dlaf_utils_api::cp_dlaf_create_grid
subroutine, public cp_dlaf_create_grid(blacs_context)
Create DLA-Future grid from BLACS context.
Definition cp_dlaf_utils_api.F:75
cp_fm_basic_linalg
Basic linear algebra operations for full matrices.
Definition cp_fm_basic_linalg.F:14
cp_fm_basic_linalg::cp_fm_uplo_to_full
subroutine, public cp_fm_uplo_to_full(matrix, work, uplo)
given a triangular matrix according to uplo, computes the corresponding full matrix
Definition cp_fm_basic_linalg.F:1747
cp_fm_dlaf_api
Definition cp_fm_dlaf_api.F:8
cp_fm_dlaf_api::cp_pspotri_dlaf
subroutine, public cp_pspotri_dlaf(uplo, n, a, ia, ja, desca, info)
Inverse from Cholesky factorization using DLA-Future.
Definition cp_fm_dlaf_api.F:171
cp_fm_dlaf_api::cp_pdpotrf_dlaf
subroutine, public cp_pdpotrf_dlaf(uplo, n, a, ia, ja, desca, info)
Cholesky factorization using DLA-Future.
Definition cp_fm_dlaf_api.F:51
cp_fm_dlaf_api::cp_pdpotri_dlaf
subroutine, public cp_pdpotri_dlaf(uplo, n, a, ia, ja, desca, info)
Inverse from Cholesky factorization using DLA-Future.
Definition cp_fm_dlaf_api.F:132
cp_fm_dlaf_api::cp_pspotrf_dlaf
subroutine, public cp_pspotrf_dlaf(uplo, n, a, ia, ja, desca, info)
Cholesky factorization using DLA-Future.
Definition cp_fm_dlaf_api.F:92
cp_fm_dlaf_api::cp_fm_diag_dlaf
subroutine, public cp_fm_diag_dlaf(matrix, eigenvectors, eigenvalues)
...
Definition cp_fm_dlaf_api.F:206
cp_fm_dlaf_api::cp_fm_diag_gen_dlaf
subroutine, public cp_fm_diag_gen_dlaf(a_matrix, b_matrix, eigenvectors, eigenvalues)
...
Definition cp_fm_dlaf_api.F:314
cp_fm_types
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::sp
integer, parameter, public sp
Definition kinds.F:33
cp_fm_types::cp_fm_type
represent a full matrix
Definition cp_fm_types.F:113