(git:936074a)
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#if defined(__DLAF)
105 CALL dlaf_pspotrf(uplo, n, a, ia, ja, desca, info)
106#else
107 mark_used(uplo)
108 mark_used(n)
109 mark_used(a)
110 mark_used(ia)
111 mark_used(ja)
112 mark_used(desca)
113 mark_used(info)
114 cpabort("CP2K compiled without the DLA-Future library.")
115#endif
116 CALL timestop(handle)
117 END SUBROUTINE cp_pspotrf_dlaf
118
119!***************************************************************************************************
120!> \brief Inverse from Cholesky factorization using DLA-Future
121!> \param uplo ...
122!> \param n Matrix size
123!> \param a Local matrix
124!> \param ia Row index of first row (has to be 1)
125!> \param ja Col index of first column ()
126!> \param desca ScaLAPACK matrix descriptor
127!> \param info 0 if factorization completed normally
128!> \author Rocco Meli
129! **************************************************************************************************
130 SUBROUTINE cp_pdpotri_dlaf(uplo, n, a, ia, ja, desca, info)
131 CHARACTER, INTENT(IN) :: uplo
132 INTEGER, INTENT(IN) :: n
133 REAL(kind=dp), DIMENSION(:, :), TARGET :: a
134 INTEGER, INTENT(IN) :: ia, ja
135 INTEGER, DIMENSION(9) :: desca
136 INTEGER, TARGET :: info
137
138 CHARACTER(len=*), PARAMETER :: routinen = 'cp_pdpotri_dlaf'
139
140 INTEGER :: handle
141
142 CALL timeset(routinen, handle)
143#if defined(__DLAF)
144 CALL dlaf_pdpotri(uplo, n, a, ia, ja, desca, info)
145#else
146 mark_used(uplo)
147 mark_used(n)
148 mark_used(a)
149 mark_used(ia)
150 mark_used(ja)
151 mark_used(desca)
152 mark_used(info)
153 cpabort("CP2K compiled without the DLA-Future library.")
154#endif
155 CALL timestop(handle)
156 END SUBROUTINE cp_pdpotri_dlaf
157
158!***************************************************************************************************
159!> \brief Inverse from Cholesky factorization using DLA-Future
160!> \param uplo ...
161!> \param n Matrix size
162!> \param a Local matrix
163!> \param ia Row index of first row (has to be 1)
164!> \param ja Col index of first column ()
165!> \param desca ScaLAPACK matrix descriptor
166!> \param info 0 if factorization completed normally
167!> \author Rocco Meli
168! **************************************************************************************************
169 SUBROUTINE cp_pspotri_dlaf(uplo, n, a, ia, ja, desca, info)
170 CHARACTER, INTENT(IN) :: uplo
171 INTEGER, INTENT(IN) :: n
172 REAL, DIMENSION(:, :), TARGET :: a
173 INTEGER, INTENT(IN) :: ia, ja
174 INTEGER, DIMENSION(9) :: desca
175 INTEGER, TARGET :: info
176
177 CHARACTER(len=*), PARAMETER :: routinen = 'cp_pspotri_dlaf'
178
179 INTEGER :: handle
180
181 CALL timeset(routinen, handle)
182
183#if defined(__DLAF)
184 CALL dlaf_pspotri(uplo, n, a, ia, ja, desca, info)
185#else
186 mark_used(uplo)
187 mark_used(n)
188 mark_used(a)
189 mark_used(ia)
190 mark_used(ja)
191 mark_used(desca)
192 mark_used(info)
193 cpabort("CP2K compiled without the DLA-Future library.")
194#endif
195 CALL timestop(handle)
196 END SUBROUTINE cp_pspotri_dlaf
197
198! **************************************************************************************************
199!> \brief ...
200!> \param matrix ...
201!> \param eigenvectors ...
202!> \param eigenvalues ...
203! **************************************************************************************************
204 SUBROUTINE cp_fm_diag_dlaf(matrix, eigenvectors, eigenvalues)
205
206 TYPE(cp_fm_type), INTENT(IN) :: matrix, eigenvectors
207 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: eigenvalues
208
209 CHARACTER(LEN=*), PARAMETER :: routinen = 'cp_fm_diag_dlaf'
210
211 INTEGER :: handle, n, nmo
212 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), TARGET :: eig
213
214 CALL timeset(routinen, handle)
215
216 n = matrix%matrix_struct%nrow_global
217 ALLOCATE (eig(n))
218
219 CALL cp_fm_diag_dlaf_base(matrix, eigenvectors, eig)
220
221 nmo = SIZE(eigenvalues, 1)
222 IF (nmo > n) THEN
223 eigenvalues(1:n) = eig(1:n)
224 ELSE
225 eigenvalues(1:nmo) = eig(1:nmo)
226 END IF
227
228 DEALLOCATE (eig)
229
230 CALL timestop(handle)
231
232 END SUBROUTINE cp_fm_diag_dlaf
233
234!***************************************************************************************************
235!> \brief DLA-Future eigensolver
236!> \param matrix ...
237!> \param eigenvectors ...
238!> \param eigenvalues ...
239!> \author Rocco Meli
240! **************************************************************************************************
241 SUBROUTINE cp_fm_diag_dlaf_base(matrix, eigenvectors, eigenvalues)
242 TYPE(cp_fm_type), INTENT(IN) :: matrix, eigenvectors
243 REAL(kind=dp), DIMENSION(:), INTENT(OUT), TARGET :: eigenvalues
244
245 CHARACTER(len=*), PARAMETER :: dlaf_name = 'pdsyevd_dlaf', routinen = 'cp_fm_diag_dlaf_base'
246 CHARACTER, PARAMETER :: uplo = 'L'
247
248 CHARACTER(LEN=100) :: message
249 INTEGER :: blacs_context, dlaf_handle, handle, n
250 INTEGER, DIMENSION(9) :: desca, descz
251 INTEGER, TARGET :: info
252 REAL(kind=dp), DIMENSION(:, :), POINTER :: a, z
253
254 CALL timeset(routinen, handle)
255
256#if defined(__DLAF)
257 ! DLAF needs the lower triangular part
258 ! Use eigenvectors matrix as workspace
259 CALL cp_fm_uplo_to_full(matrix, eigenvectors)
260
261 ! Create DLAF grid from BLACS context (if already present, does nothing)
262 blacs_context = matrix%matrix_struct%context%get_handle()
263 CALL cp_dlaf_create_grid(blacs_context)
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 CALL dlaf_pdsyevd(uplo, n, a, 1, 1, desca, eigenvalues, z, 1, 1, descz, info)
276 CALL timestop(dlaf_handle)
277
278 IF (info /= 0) THEN
279 WRITE (message, "(A,I0,A)") "ERROR in DLAF_PDSYEVD: Eigensolver failed (INFO = ", info, ")"
280 cpabort(trim(message))
281 END IF
282#else
283 mark_used(a)
284 mark_used(z)
285 mark_used(desca)
286 mark_used(descz)
287 mark_used(matrix)
288 mark_used(eigenvectors)
289 mark_used(eigenvalues)
290 mark_used(uplo)
291 mark_used(n)
292 mark_used(info)
293 mark_used(dlaf_handle)
294 mark_used(dlaf_name)
295 mark_used(message)
296 mark_used(blacs_context)
297 cpabort("CP2K compiled without DLA-Future-Fortran library.")
298#endif
299
300 CALL timestop(handle)
301
302 END SUBROUTINE cp_fm_diag_dlaf_base
303
304! **************************************************************************************************
305!> \brief ...
306!> \param a_matrix ...
307!> \param b_matrix ...
308!> \param eigenvectors ...
309!> \param eigenvalues ...
310!> \author Rocco Meli
311! **************************************************************************************************
312 SUBROUTINE cp_fm_diag_gen_dlaf(a_matrix, b_matrix, eigenvectors, eigenvalues)
313
314 TYPE(cp_fm_type), INTENT(IN) :: a_matrix, b_matrix, eigenvectors
315 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: eigenvalues
316
317 CHARACTER(LEN=*), PARAMETER :: routinen = 'cp_fm_diag_gen_dlaf'
318
319 INTEGER :: handle, n, nmo
320 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), TARGET :: eig
321
322 CALL timeset(routinen, handle)
323
324 n = a_matrix%matrix_struct%nrow_global
325 ALLOCATE (eig(n))
326
327 CALL cp_fm_diag_gen_dlaf_base(a_matrix, b_matrix, eigenvectors, eig)
328
329 nmo = SIZE(eigenvalues, 1)
330 IF (nmo > n) THEN
331 eigenvalues(1:n) = eig(1:n)
332 ELSE
333 eigenvalues(1:nmo) = eig(1:nmo)
334 END IF
335
336 DEALLOCATE (eig)
337
338 CALL timestop(handle)
339
340 END SUBROUTINE cp_fm_diag_gen_dlaf
341
342!***************************************************************************************************
343!> \brief DLA-Future generalized eigensolver
344!> \param a_matrix ...
345!> \param b_matrix ...
346!> \param eigenvectors ...
347!> \param eigenvalues ...
348!> \author Rocco Meli
349! **************************************************************************************************
350 SUBROUTINE cp_fm_diag_gen_dlaf_base(a_matrix, b_matrix, eigenvectors, eigenvalues)
351 TYPE(cp_fm_type), INTENT(IN) :: a_matrix, b_matrix, eigenvectors
352 REAL(kind=dp), DIMENSION(:), INTENT(OUT), TARGET :: eigenvalues
353
354 CHARACTER(len=*), PARAMETER :: dlaf_name = 'pdsyevd_dlaf', &
355 routinen = 'cp_fm_diag_gen_dlaf_base'
356 CHARACTER, PARAMETER :: uplo = 'L'
357
358 CHARACTER(LEN=100) :: message
359 INTEGER :: blacs_context, dlaf_handle, handle, n
360 INTEGER, DIMENSION(9) :: desca, descb, descz
361 INTEGER, TARGET :: info
362 REAL(kind=dp), DIMENSION(:, :), POINTER :: a, b, z
363
364 CALL timeset(routinen, handle)
365
366#if defined(__DLAF)
367 ! DLAF needs the lower triangular part
368 ! Use eigenvectors matrix as workspace
369 CALL cp_fm_uplo_to_full(a_matrix, eigenvectors)
370 CALL cp_fm_uplo_to_full(b_matrix, eigenvectors)
371
372 ! Create DLAF grid from BLACS context; if already present, does nothing
373 blacs_context = a_matrix%matrix_struct%context%get_handle()
374 CALL cp_dlaf_create_grid(blacs_context)
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(blacs_context)
410 mark_used(dlaf_handle)
411 mark_used(dlaf_name)
412 mark_used(message)
413 cpabort("CP2K compiled without DLA-Future-Fortran library.")
414#endif
415
416 CALL timestop(handle)
417
418 END SUBROUTINE cp_fm_diag_gen_dlaf_base
419
420END 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:1801
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:170
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:131
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:205
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:313
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:114