(git:e8f5963)
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-2026 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: 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_pdpotri
21#endif
22
23 IMPLICIT NONE
24
25 PRIVATE
26
27 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_fm_dlaf_api'
28
29 PUBLIC :: cp_pdpotrf_dlaf, cp_pdpotri_dlaf
30 PUBLIC :: cp_fm_diag_dlaf, cp_fm_diag_gen_dlaf
31
32CONTAINS
33
34!***************************************************************************************************
35!> \brief Cholesky factorization using DLA-Future
36!> \param uplo ...
37!> \param n Matrix size
38!> \param a Local matrix
39!> \param ia Row index of first row (has to be 1)
40!> \param ja Col index of first column ()
41!> \param desca ScaLAPACK matrix descriptor
42!> \param info 0 if factorization completed normally
43!> \author Rocco Meli
44!> \author Mikael Simberg
45!> \author Mathieu Taillefumier
46! **************************************************************************************************
47 SUBROUTINE cp_pdpotrf_dlaf(uplo, n, a, ia, ja, desca, info)
48 CHARACTER, INTENT(IN) :: uplo
49 INTEGER, INTENT(IN) :: n
50 REAL(kind=dp), DIMENSION(:, :), TARGET :: a
51 INTEGER, INTENT(IN) :: ia, ja
52 INTEGER, DIMENSION(9) :: desca
53 INTEGER, TARGET :: info
54
55 CHARACTER(len=*), PARAMETER :: routinen = 'cp_pdpotrf_dlaf'
56
57 INTEGER :: handle
58
59 CALL timeset(routinen, handle)
60#if defined(__DLAF)
61 CALL dlaf_pdpotrf(uplo, n, a, ia, ja, desca, info)
62#else
63 mark_used(uplo)
64 mark_used(n)
65 mark_used(a)
66 mark_used(ia)
67 mark_used(ja)
68 mark_used(desca)
69 mark_used(info)
70 cpabort("CP2K compiled without the DLA-Future library.")
71#endif
72 CALL timestop(handle)
73 END SUBROUTINE cp_pdpotrf_dlaf
74
75!***************************************************************************************************
76!> \brief Inverse from Cholesky factorization using DLA-Future
77!> \param uplo ...
78!> \param n Matrix size
79!> \param a Local matrix
80!> \param ia Row index of first row (has to be 1)
81!> \param ja Col index of first column ()
82!> \param desca ScaLAPACK matrix descriptor
83!> \param info 0 if factorization completed normally
84!> \author Rocco Meli
85! **************************************************************************************************
86 SUBROUTINE cp_pdpotri_dlaf(uplo, n, a, ia, ja, desca, info)
87 CHARACTER, INTENT(IN) :: uplo
88 INTEGER, INTENT(IN) :: n
89 REAL(kind=dp), DIMENSION(:, :), TARGET :: a
90 INTEGER, INTENT(IN) :: ia, ja
91 INTEGER, DIMENSION(9) :: desca
92 INTEGER, TARGET :: info
93
94 CHARACTER(len=*), PARAMETER :: routinen = 'cp_pdpotri_dlaf'
95
96 INTEGER :: handle
97
98 CALL timeset(routinen, handle)
99#if defined(__DLAF)
100 CALL dlaf_pdpotri(uplo, n, a, ia, ja, desca, info)
101#else
102 mark_used(uplo)
103 mark_used(n)
104 mark_used(a)
105 mark_used(ia)
106 mark_used(ja)
107 mark_used(desca)
108 mark_used(info)
109 cpabort("CP2K compiled without the DLA-Future library.")
110#endif
111 CALL timestop(handle)
112 END SUBROUTINE cp_pdpotri_dlaf
113
114! **************************************************************************************************
115!> \brief ...
116!> \param matrix ...
117!> \param eigenvectors ...
118!> \param eigenvalues ...
119! **************************************************************************************************
120 SUBROUTINE cp_fm_diag_dlaf(matrix, eigenvectors, eigenvalues)
121
122 TYPE(cp_fm_type), INTENT(IN) :: matrix, eigenvectors
123 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: eigenvalues
124
125 CHARACTER(LEN=*), PARAMETER :: routinen = 'cp_fm_diag_dlaf'
126
127 INTEGER :: handle, n, nmo
128 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), TARGET :: eig
129
130 CALL timeset(routinen, handle)
131
132 n = matrix%matrix_struct%nrow_global
133 ALLOCATE (eig(n))
134
135 CALL cp_fm_diag_dlaf_base(matrix, eigenvectors, eig)
136
137 nmo = SIZE(eigenvalues, 1)
138 IF (nmo > n) THEN
139 eigenvalues(1:n) = eig(1:n)
140 ELSE
141 eigenvalues(1:nmo) = eig(1:nmo)
142 END IF
143
144 DEALLOCATE (eig)
145
146 CALL timestop(handle)
147
148 END SUBROUTINE cp_fm_diag_dlaf
149
150!***************************************************************************************************
151!> \brief DLA-Future eigensolver
152!> \param matrix ...
153!> \param eigenvectors ...
154!> \param eigenvalues ...
155!> \author Rocco Meli
156! **************************************************************************************************
157 SUBROUTINE cp_fm_diag_dlaf_base(matrix, eigenvectors, eigenvalues)
158 TYPE(cp_fm_type), INTENT(IN) :: matrix, eigenvectors
159 REAL(kind=dp), DIMENSION(:), INTENT(OUT), TARGET :: eigenvalues
160
161 CHARACTER(len=*), PARAMETER :: dlaf_name = 'pdsyevd_dlaf', routinen = 'cp_fm_diag_dlaf_base'
162 CHARACTER, PARAMETER :: uplo = 'L'
163
164 CHARACTER(LEN=100) :: message
165 INTEGER :: blacs_context, dlaf_handle, handle, n
166 INTEGER, DIMENSION(9) :: desca, descz
167 INTEGER, TARGET :: info
168 REAL(kind=dp), DIMENSION(:, :), POINTER :: a, z
169
170 CALL timeset(routinen, handle)
171
172#if defined(__DLAF)
173 ! DLAF needs the lower triangular part
174 ! Use eigenvectors matrix as workspace
175 CALL cp_fm_uplo_to_full(matrix, eigenvectors)
176
177 ! Create DLAF grid from BLACS context (if already present, does nothing)
178 blacs_context = matrix%matrix_struct%context%get_handle()
179 CALL cp_dlaf_create_grid(blacs_context)
180
181 n = matrix%matrix_struct%nrow_global
182
183 a => matrix%local_data
184 z => eigenvectors%local_data
185
186 desca(:) = matrix%matrix_struct%descriptor(:)
187 descz(:) = eigenvectors%matrix_struct%descriptor(:)
188
189 info = -1
190 CALL timeset(dlaf_name, dlaf_handle)
191 CALL dlaf_pdsyevd(uplo, n, a, 1, 1, desca, eigenvalues, z, 1, 1, descz, info)
192 CALL timestop(dlaf_handle)
193
194 IF (info /= 0) THEN
195 WRITE (message, "(A,I0,A)") "ERROR in DLAF_PDSYEVD: Eigensolver failed (INFO = ", info, ")"
196 cpabort(trim(message))
197 END IF
198#else
199 mark_used(a)
200 mark_used(z)
201 mark_used(desca)
202 mark_used(descz)
203 mark_used(matrix)
204 mark_used(eigenvectors)
205 mark_used(eigenvalues)
206 mark_used(uplo)
207 mark_used(n)
208 mark_used(info)
209 mark_used(dlaf_handle)
210 mark_used(dlaf_name)
211 mark_used(message)
212 mark_used(blacs_context)
213 cpabort("CP2K compiled without DLA-Future-Fortran library.")
214#endif
215
216 CALL timestop(handle)
217
218 END SUBROUTINE cp_fm_diag_dlaf_base
219
220! **************************************************************************************************
221!> \brief ...
222!> \param a_matrix ...
223!> \param b_matrix ...
224!> \param eigenvectors ...
225!> \param eigenvalues ...
226!> \author Rocco Meli
227! **************************************************************************************************
228 SUBROUTINE cp_fm_diag_gen_dlaf(a_matrix, b_matrix, eigenvectors, eigenvalues)
229
230 TYPE(cp_fm_type), INTENT(IN) :: a_matrix, b_matrix, eigenvectors
231 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: eigenvalues
232
233 CHARACTER(LEN=*), PARAMETER :: routinen = 'cp_fm_diag_gen_dlaf'
234
235 INTEGER :: handle, n, nmo
236 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), TARGET :: eig
237
238 CALL timeset(routinen, handle)
239
240 n = a_matrix%matrix_struct%nrow_global
241 ALLOCATE (eig(n))
242
243 CALL cp_fm_diag_gen_dlaf_base(a_matrix, b_matrix, eigenvectors, eig)
244
245 nmo = SIZE(eigenvalues, 1)
246 IF (nmo > n) THEN
247 eigenvalues(1:n) = eig(1:n)
248 ELSE
249 eigenvalues(1:nmo) = eig(1:nmo)
250 END IF
251
252 DEALLOCATE (eig)
253
254 CALL timestop(handle)
255
256 END SUBROUTINE cp_fm_diag_gen_dlaf
257
258!***************************************************************************************************
259!> \brief DLA-Future generalized eigensolver
260!> \param a_matrix ...
261!> \param b_matrix ...
262!> \param eigenvectors ...
263!> \param eigenvalues ...
264!> \author Rocco Meli
265! **************************************************************************************************
266 SUBROUTINE cp_fm_diag_gen_dlaf_base(a_matrix, b_matrix, eigenvectors, eigenvalues)
267 TYPE(cp_fm_type), INTENT(IN) :: a_matrix, b_matrix, eigenvectors
268 REAL(kind=dp), DIMENSION(:), INTENT(OUT), TARGET :: eigenvalues
269
270 CHARACTER(len=*), PARAMETER :: dlaf_name = 'pdsygvd_dlaf', &
271 routinen = 'cp_fm_diag_gen_dlaf_base'
272 CHARACTER, PARAMETER :: uplo = 'L'
273
274 CHARACTER(LEN=100) :: message
275 INTEGER :: blacs_context, dlaf_handle, handle, n
276 INTEGER, DIMENSION(9) :: desca, descb, descz
277 INTEGER, TARGET :: info
278 REAL(kind=dp), DIMENSION(:, :), POINTER :: a, b, z
279
280 CALL timeset(routinen, handle)
281
282#if defined(__DLAF)
283 ! DLAF needs the lower triangular part
284 ! Use eigenvectors matrix as workspace
285 CALL cp_fm_uplo_to_full(a_matrix, eigenvectors)
286 CALL cp_fm_uplo_to_full(b_matrix, eigenvectors)
287
288 ! Create DLAF grid from BLACS context; if already present, does nothing
289 blacs_context = a_matrix%matrix_struct%context%get_handle()
290 CALL cp_dlaf_create_grid(blacs_context)
291
292 n = a_matrix%matrix_struct%nrow_global
293
294 a => a_matrix%local_data
295 b => b_matrix%local_data
296 z => eigenvectors%local_data
297
298 desca(:) = a_matrix%matrix_struct%descriptor(:)
299 descb(:) = b_matrix%matrix_struct%descriptor(:)
300 descz(:) = eigenvectors%matrix_struct%descriptor(:)
301
302 info = -1
303 CALL timeset(dlaf_name, dlaf_handle)
304 CALL dlaf_pdsygvd(uplo, n, a, 1, 1, desca, b, 1, 1, descb, eigenvalues, z, 1, 1, descz, info)
305 CALL timestop(dlaf_handle)
306
307 IF (info /= 0) THEN
308 WRITE (message, "(A,I0,A)") "ERROR in DLAF_PDSYGVD: Generalized Eigensolver failed (INFO = ", info, ")"
309 cpabort(trim(message))
310 END IF
311#else
312 mark_used(a)
313 mark_used(b)
314 mark_used(z)
315 mark_used(desca)
316 mark_used(descb)
317 mark_used(descz)
318 mark_used(a_matrix)
319 mark_used(b_matrix)
320 mark_used(eigenvectors)
321 mark_used(eigenvalues)
322 mark_used(uplo)
323 mark_used(n)
324 mark_used(info)
325 mark_used(blacs_context)
326 mark_used(dlaf_handle)
327 mark_used(dlaf_name)
328 mark_used(message)
329 cpabort("CP2K compiled without DLA-Future-Fortran library.")
330#endif
331
332 CALL timestop(handle)
333
334 END SUBROUTINE cp_fm_diag_gen_dlaf_base
335
336END 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:1586
cp_fm_dlaf_api
Definition cp_fm_dlaf_api.F:8
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:48
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:87
cp_fm_dlaf_api::cp_fm_diag_dlaf
subroutine, public cp_fm_diag_dlaf(matrix, eigenvectors, eigenvalues)
...
Definition cp_fm_dlaf_api.F:121
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:229
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
cp_fm_types::cp_fm_type
represent a full matrix
Definition cp_fm_types.F:114