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