Line data Source code
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 :
8 : MODULE 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 :
32 : CONTAINS
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 0 : 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 0 : 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 0 : CPABORT("CP2K compiled without the DLA-Future library.")
71 : #endif
72 0 : CALL timestop(handle)
73 0 : 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 0 : 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 0 : 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 0 : CPABORT("CP2K compiled without the DLA-Future library.")
110 : #endif
111 0 : CALL timestop(handle)
112 0 : END SUBROUTINE cp_pdpotri_dlaf
113 :
114 : ! **************************************************************************************************
115 : !> \brief ...
116 : !> \param matrix ...
117 : !> \param eigenvectors ...
118 : !> \param eigenvalues ...
119 : ! **************************************************************************************************
120 0 : 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 0 : CALL timeset(routineN, handle)
131 :
132 0 : n = matrix%matrix_struct%nrow_global
133 0 : ALLOCATE (eig(n))
134 :
135 0 : CALL cp_fm_diag_dlaf_base(matrix, eigenvectors, eig)
136 :
137 0 : nmo = SIZE(eigenvalues, 1)
138 0 : IF (nmo > n) THEN
139 0 : eigenvalues(1:n) = eig(1:n)
140 : ELSE
141 0 : eigenvalues(1:nmo) = eig(1:nmo)
142 : END IF
143 :
144 0 : DEALLOCATE (eig)
145 :
146 0 : CALL timestop(handle)
147 :
148 0 : 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 0 : 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 0 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: a, z
169 :
170 0 : 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 0 : CPABORT("CP2K compiled without DLA-Future-Fortran library.")
214 : #endif
215 :
216 0 : CALL timestop(handle)
217 :
218 0 : 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 0 : 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 0 : CALL timeset(routineN, handle)
239 :
240 0 : n = a_matrix%matrix_struct%nrow_global
241 0 : ALLOCATE (eig(n))
242 :
243 0 : CALL cp_fm_diag_gen_dlaf_base(a_matrix, b_matrix, eigenvectors, eig)
244 :
245 0 : nmo = SIZE(eigenvalues, 1)
246 0 : IF (nmo > n) THEN
247 0 : eigenvalues(1:n) = eig(1:n)
248 : ELSE
249 0 : eigenvalues(1:nmo) = eig(1:nmo)
250 : END IF
251 :
252 0 : DEALLOCATE (eig)
253 :
254 0 : CALL timestop(handle)
255 :
256 0 : 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 0 : 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 0 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: a, b, z
279 :
280 0 : 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 0 : CPABORT("CP2K compiled without DLA-Future-Fortran library.")
330 : #endif
331 :
332 0 : CALL timestop(handle)
333 :
334 0 : END SUBROUTINE cp_fm_diag_gen_dlaf_base
335 :
336 : END MODULE cp_fm_dlaf_api
|
