(git:e5b1968)
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#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_pspotrf_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 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!> \author Mikael Simberg
86!> \author Mathieu Taillefumier
87! **************************************************************************************************
88 SUBROUTINE cp_pspotrf_dlaf(uplo, n, a, ia, ja, desca, info)
89 CHARACTER, INTENT(IN) :: uplo
90 INTEGER, INTENT(IN) :: n
91 REAL, DIMENSION(:, :), TARGET :: a
92 INTEGER, INTENT(IN) :: ia, ja
93 INTEGER, DIMENSION(9) :: desca
94 INTEGER, TARGET :: info
95
96 CHARACTER(len=*), PARAMETER :: routinen = 'cp_pspotrf_dlaf'
97
98 INTEGER :: handle
99
100 CALL timeset(routinen, handle)
101
102#if defined(__DLAF)
103 CALL dlaf_pspotrf(uplo, n, a, ia, ja, desca, info)
104#else
105 mark_used(uplo)
106 mark_used(n)
107 mark_used(a)
108 mark_used(ia)
109 mark_used(ja)
110 mark_used(desca)
111 mark_used(info)
112 cpabort("CP2K compiled without the DLA-Future library.")
113#endif
114 CALL timestop(handle)
115 END SUBROUTINE cp_pspotrf_dlaf
116
117! **************************************************************************************************
118!> \brief ...
119!> \param matrix ...
120!> \param eigenvectors ...
121!> \param eigenvalues ...
122! **************************************************************************************************
123 SUBROUTINE cp_fm_diag_dlaf(matrix, eigenvectors, eigenvalues)
124
125 TYPE(cp_fm_type), INTENT(IN) :: matrix, eigenvectors
126 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: eigenvalues
127
128 CHARACTER(LEN=*), PARAMETER :: routinen = 'cp_fm_diag_dlaf'
129
130 INTEGER :: handle, n, nmo
131 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), TARGET :: eig
132
133 CALL timeset(routinen, handle)
134
135 n = matrix%matrix_struct%nrow_global
136 ALLOCATE (eig(n))
137
138 CALL cp_fm_diag_dlaf_base(matrix, eigenvectors, eig)
139
140 nmo = SIZE(eigenvalues, 1)
141 IF (nmo > n) THEN
142 eigenvalues(1:n) = eig(1:n)
143 ELSE
144 eigenvalues(1:nmo) = eig(1:nmo)
145 END IF
146
147 DEALLOCATE (eig)
148
149 CALL timestop(handle)
150
151 END SUBROUTINE cp_fm_diag_dlaf
152
153!***************************************************************************************************
154!> \brief DLA-Future eigensolver
155!> \param matrix ...
156!> \param eigenvectors ...
157!> \param eigenvalues ...
158!> \author Rocco Meli
159! **************************************************************************************************
160 SUBROUTINE cp_fm_diag_dlaf_base(matrix, eigenvectors, eigenvalues)
161 TYPE(cp_fm_type), INTENT(IN) :: matrix, eigenvectors
162 REAL(kind=dp), DIMENSION(:), INTENT(OUT), TARGET :: eigenvalues
163
164 CHARACTER(len=*), PARAMETER :: dlaf_name = 'pdsyevd_dlaf', routinen = 'cp_fm_diag_dlaf_base'
165 CHARACTER, PARAMETER :: uplo = 'L'
166
167 CHARACTER(LEN=100) :: message
168 INTEGER :: dlaf_handle, handle, n
169 INTEGER, DIMENSION(9) :: desca, descz
170 INTEGER, TARGET :: info
171 REAL(kind=dp), DIMENSION(:, :), POINTER :: a, z
172
173 CALL timeset(routinen, handle)
174
175#if defined(__DLAF)
176 ! DLAF needs the lower triangular part
177 ! Use eigenvectors matrix as workspace
178 CALL cp_fm_uplo_to_full(matrix, eigenvectors)
179
180 ! Create DLAF grid from BLACS context; if already present, does nothing
181 CALL cp_dlaf_create_grid(matrix%matrix_struct%context%get_handle())
182
183 n = matrix%matrix_struct%nrow_global
184
185 a => matrix%local_data
186 z => eigenvectors%local_data
187
188 desca(:) = matrix%matrix_struct%descriptor(:)
189 descz(:) = eigenvectors%matrix_struct%descriptor(:)
190
191 info = -1
192 CALL timeset(dlaf_name, dlaf_handle)
193
194 CALL dlaf_pdsyevd(uplo, n, a, 1, 1, desca, eigenvalues, z, 1, 1, descz, info)
195
196 CALL timestop(dlaf_handle)
197
198 IF (info /= 0) THEN
199 WRITE (message, "(A,I0,A)") "ERROR in DLAF_PDSYEVD: Eigensolver failed (INFO = ", info, ")"
200 cpabort(trim(message))
201 END IF
202#else
203 mark_used(a)
204 mark_used(z)
205 mark_used(desca)
206 mark_used(descz)
207 mark_used(matrix)
208 mark_used(eigenvectors)
209 mark_used(eigenvalues)
210 mark_used(uplo)
211 mark_used(n)
212 mark_used(info)
213 mark_used(dlaf_handle)
214 mark_used(dlaf_name)
215 mark_used(message)
216 cpabort("CP2K compiled without DLA-Future-Fortran library.")
217#endif
218
219 CALL timestop(handle)
220
221 END SUBROUTINE cp_fm_diag_dlaf_base
222
223! **************************************************************************************************
224!> \brief ...
225!> \param a_matrix ...
226!> \param b_matrix ...
227!> \param eigenvectors ...
228!> \param eigenvalues ...
229!> \author Rocco Meli
230! **************************************************************************************************
231 SUBROUTINE cp_fm_diag_gen_dlaf(a_matrix, b_matrix, eigenvectors, eigenvalues)
232
233 TYPE(cp_fm_type), INTENT(IN) :: a_matrix, b_matrix, eigenvectors
234 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: eigenvalues
235
236 CHARACTER(LEN=*), PARAMETER :: routinen = 'cp_fm_diag_gen_dlaf'
237
238 INTEGER :: handle, n, nmo
239 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), TARGET :: eig
240
241 CALL timeset(routinen, handle)
242
243 n = a_matrix%matrix_struct%nrow_global
244 ALLOCATE (eig(n))
245
246 CALL cp_fm_diag_gen_dlaf_base(a_matrix, b_matrix, eigenvectors, eig)
247
248 nmo = SIZE(eigenvalues, 1)
249 IF (nmo > n) THEN
250 eigenvalues(1:n) = eig(1:n)
251 ELSE
252 eigenvalues(1:nmo) = eig(1:nmo)
253 END IF
254
255 DEALLOCATE (eig)
256
257 CALL timestop(handle)
258
259 END SUBROUTINE cp_fm_diag_gen_dlaf
260
261!***************************************************************************************************
262!> \brief DLA-Future generalized eigensolver
263!> \param a_matrix ...
264!> \param b_matrix ...
265!> \param eigenvectors ...
266!> \param eigenvalues ...
267!> \author Rocco Meli
268! **************************************************************************************************
269 SUBROUTINE cp_fm_diag_gen_dlaf_base(a_matrix, b_matrix, eigenvectors, eigenvalues)
270 TYPE(cp_fm_type), INTENT(IN) :: a_matrix, b_matrix, eigenvectors
271 REAL(kind=dp), DIMENSION(:), INTENT(OUT), TARGET :: eigenvalues
272
273 CHARACTER(len=*), PARAMETER :: dlaf_name = 'pdsyevd_dlaf', &
274 routinen = 'cp_fm_diag_gen_dlaf_base'
275 CHARACTER, PARAMETER :: uplo = 'L'
276
277 CHARACTER(LEN=100) :: message
278 INTEGER :: dlaf_handle, handle, n
279 INTEGER, DIMENSION(9) :: desca, descb, descz
280 INTEGER, TARGET :: info
281 REAL(kind=dp), DIMENSION(:, :), POINTER :: a, b, z
282
283 CALL timeset(routinen, handle)
284
285#if defined(__DLAF)
286 ! DLAF needs the lower triangular part
287 ! Use eigenvectors matrix as workspace
288 CALL cp_fm_uplo_to_full(a_matrix, eigenvectors)
289 CALL cp_fm_uplo_to_full(b_matrix, eigenvectors)
290
291 ! Create DLAF grid from BLACS context; if already present, does nothing
292 CALL cp_dlaf_create_grid(a_matrix%matrix_struct%context%get_handle())
293
294 n = a_matrix%matrix_struct%nrow_global
295
296 a => a_matrix%local_data
297 b => b_matrix%local_data
298 z => eigenvectors%local_data
299
300 desca(:) = a_matrix%matrix_struct%descriptor(:)
301 descb(:) = b_matrix%matrix_struct%descriptor(:)
302 descz(:) = eigenvectors%matrix_struct%descriptor(:)
303
304 info = -1
305 CALL timeset(dlaf_name, dlaf_handle)
306 CALL dlaf_pdsygvd(uplo, n, a, 1, 1, desca, b, 1, 1, descb, eigenvalues, z, 1, 1, descz, info)
307 CALL timestop(dlaf_handle)
308
309 IF (info /= 0) THEN
310 WRITE (message, "(A,I0,A)") "ERROR in DLAF_PDSYGVD: Generalized Eigensolver failed (INFO = ", info, ")"
311 cpabort(trim(message))
312 END IF
313#else
314 mark_used(a)
315 mark_used(b)
316 mark_used(z)
317 mark_used(desca)
318 mark_used(descb)
319 mark_used(descz)
320 mark_used(a_matrix)
321 mark_used(b_matrix)
322 mark_used(eigenvectors)
323 mark_used(eigenvalues)
324 mark_used(uplo)
325 mark_used(n)
326 mark_used(info)
327 mark_used(dlaf_handle)
328 mark_used(dlaf_name)
329 mark_used(message)
330 cpabort("CP2K compiled without DLA-Future-Fortran library.")
331#endif
332
333 CALL timestop(handle)
334
335 END SUBROUTINE cp_fm_diag_gen_dlaf_base
336
337END 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_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_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:89
cp_fm_dlaf_api::cp_fm_diag_dlaf
subroutine, public cp_fm_diag_dlaf(matrix, eigenvectors, eigenvalues)
...
Definition cp_fm_dlaf_api.F:124
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:232
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