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 : ! **************************************************************************************************
9 : !> \brief A DIIS implementation for the ALMO-based SCF methods
10 : !> \par History
11 : !> 2011.12 created [Rustam Z Khaliullin]
12 : !> \author Rustam Z Khaliullin
13 : ! **************************************************************************************************
14 : MODULE almo_scf_diis_types
15 : USE cp_dbcsr_api, ONLY: dbcsr_add,&
16 : dbcsr_copy,&
17 : dbcsr_create,&
18 : dbcsr_release,&
19 : dbcsr_set,&
20 : dbcsr_type
21 : USE cp_dbcsr_contrib, ONLY: dbcsr_dot
22 : USE cp_log_handling, ONLY: cp_get_default_logger,&
23 : cp_logger_get_default_unit_nr,&
24 : cp_logger_type
25 : USE domain_submatrix_methods, ONLY: add_submatrices,&
26 : copy_submatrices,&
27 : init_submatrices,&
28 : release_submatrices,&
29 : set_submatrices
30 : USE domain_submatrix_types, ONLY: domain_submatrix_type
31 : USE kinds, ONLY: dp
32 : #include "./base/base_uses.f90"
33 :
34 : IMPLICIT NONE
35 :
36 : PRIVATE
37 :
38 : INTEGER, PARAMETER :: diis_error_orthogonal = 1
39 :
40 : INTEGER, PARAMETER :: diis_env_dbcsr = 1
41 : INTEGER, PARAMETER :: diis_env_domain = 2
42 :
43 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'almo_scf_diis_types'
44 :
45 : PUBLIC :: almo_scf_diis_type, &
46 : almo_scf_diis_init, almo_scf_diis_release, almo_scf_diis_push, &
47 : almo_scf_diis_extrapolate
48 :
49 : INTERFACE almo_scf_diis_init
50 : MODULE PROCEDURE almo_scf_diis_init_dbcsr
51 : MODULE PROCEDURE almo_scf_diis_init_domain
52 : END INTERFACE
53 :
54 : TYPE almo_scf_diis_type
55 :
56 : INTEGER :: diis_env_type = 0
57 :
58 : INTEGER :: buffer_length = 0
59 : INTEGER :: max_buffer_length = 0
60 : !INTEGER, DIMENSION(:), ALLOCATABLE :: history_index
61 :
62 : TYPE(dbcsr_type), DIMENSION(:), ALLOCATABLE :: m_var
63 : TYPE(dbcsr_type), DIMENSION(:), ALLOCATABLE :: m_err
64 :
65 : ! first dimension is history index, second - domain index
66 : TYPE(domain_submatrix_type), DIMENSION(:, :), ALLOCATABLE :: d_var
67 : TYPE(domain_submatrix_type), DIMENSION(:, :), ALLOCATABLE :: d_err
68 :
69 : ! distributed matrix of error overlaps
70 : TYPE(domain_submatrix_type), DIMENSION(:), ALLOCATABLE :: m_b
71 :
72 : ! insertion point
73 : INTEGER :: in_point = 0
74 :
75 : ! in order to calculate the overlap between error vectors
76 : ! it is desirable to know tensorial properties of the error
77 : ! vector, e.g. convariant, contravariant, orthogonal
78 : INTEGER :: error_type = 0
79 :
80 : END TYPE almo_scf_diis_type
81 :
82 : CONTAINS
83 :
84 : ! **************************************************************************************************
85 : !> \brief initializes the diis structure
86 : !> \param diis_env ...
87 : !> \param sample_err ...
88 : !> \param sample_var ...
89 : !> \param error_type ...
90 : !> \param max_length ...
91 : !> \par History
92 : !> 2011.12 created [Rustam Z Khaliullin]
93 : !> \author Rustam Z Khaliullin
94 : ! **************************************************************************************************
95 76 : SUBROUTINE almo_scf_diis_init_dbcsr(diis_env, sample_err, sample_var, error_type, &
96 : max_length)
97 :
98 : TYPE(almo_scf_diis_type), INTENT(INOUT) :: diis_env
99 : TYPE(dbcsr_type), INTENT(IN) :: sample_err, sample_var
100 : INTEGER, INTENT(IN) :: error_type, max_length
101 :
102 : CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_init_dbcsr'
103 :
104 : INTEGER :: handle, idomain, im, ndomains
105 :
106 76 : CALL timeset(routineN, handle)
107 :
108 76 : IF (max_length <= 0) THEN
109 0 : CPABORT("DIIS: max_length is less than zero")
110 : END IF
111 :
112 76 : diis_env%diis_env_type = diis_env_dbcsr
113 :
114 76 : diis_env%max_buffer_length = max_length
115 76 : diis_env%buffer_length = 0
116 76 : diis_env%error_type = error_type
117 76 : diis_env%in_point = 1
118 :
119 600 : ALLOCATE (diis_env%m_err(diis_env%max_buffer_length))
120 524 : ALLOCATE (diis_env%m_var(diis_env%max_buffer_length))
121 :
122 : ! create matrices
123 448 : DO im = 1, diis_env%max_buffer_length
124 : CALL dbcsr_create(diis_env%m_err(im), &
125 372 : template=sample_err)
126 : CALL dbcsr_create(diis_env%m_var(im), &
127 448 : template=sample_var)
128 : END DO
129 :
130 : ! current B matrices are only 1-by-1, they will be expanded on-the-fly
131 : ! only one matrix is used with dbcsr version of DIIS
132 76 : ndomains = 1
133 152 : ALLOCATE (diis_env%m_b(ndomains))
134 76 : CALL init_submatrices(diis_env%m_b)
135 : ! hack into d_b structure to gain full control
136 152 : diis_env%m_b(:)%domain = 100 ! arbitrary positive number
137 152 : DO idomain = 1, ndomains
138 152 : IF (diis_env%m_b(idomain)%domain > 0) THEN
139 76 : ALLOCATE (diis_env%m_b(idomain)%mdata(1, 1))
140 228 : diis_env%m_b(idomain)%mdata(:, :) = 0.0_dp
141 : END IF
142 : END DO
143 :
144 76 : CALL timestop(handle)
145 :
146 76 : END SUBROUTINE almo_scf_diis_init_dbcsr
147 :
148 : ! **************************************************************************************************
149 : !> \brief initializes the diis structure
150 : !> \param diis_env ...
151 : !> \param sample_err ...
152 : !> \param error_type ...
153 : !> \param max_length ...
154 : !> \par History
155 : !> 2011.12 created [Rustam Z Khaliullin]
156 : !> \author Rustam Z Khaliullin
157 : ! **************************************************************************************************
158 2 : SUBROUTINE almo_scf_diis_init_domain(diis_env, sample_err, error_type, &
159 : max_length)
160 :
161 : TYPE(almo_scf_diis_type), INTENT(INOUT) :: diis_env
162 : TYPE(domain_submatrix_type), DIMENSION(:), &
163 : INTENT(IN) :: sample_err
164 : INTEGER, INTENT(IN) :: error_type, max_length
165 :
166 : CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_init_domain'
167 :
168 : INTEGER :: handle, idomain, ndomains
169 :
170 2 : CALL timeset(routineN, handle)
171 :
172 2 : IF (max_length <= 0) THEN
173 0 : CPABORT("DIIS: max_length is less than zero")
174 : END IF
175 :
176 2 : diis_env%diis_env_type = diis_env_domain
177 :
178 2 : diis_env%max_buffer_length = max_length
179 2 : diis_env%buffer_length = 0
180 2 : diis_env%error_type = error_type
181 2 : diis_env%in_point = 1
182 :
183 2 : ndomains = SIZE(sample_err)
184 :
185 38 : ALLOCATE (diis_env%d_err(diis_env%max_buffer_length, ndomains))
186 38 : ALLOCATE (diis_env%d_var(diis_env%max_buffer_length, ndomains))
187 :
188 : ! create matrices
189 2 : CALL init_submatrices(diis_env%d_var)
190 2 : CALL init_submatrices(diis_env%d_err)
191 :
192 : ! current B matrices are only 1-by-1, they will be expanded on-the-fly
193 16 : ALLOCATE (diis_env%m_b(ndomains))
194 2 : CALL init_submatrices(diis_env%m_b)
195 : ! hack into d_b structure to gain full control
196 : ! distribute matrices as the err/var matrices
197 12 : diis_env%m_b(:)%domain = sample_err(:)%domain
198 12 : DO idomain = 1, ndomains
199 12 : IF (diis_env%m_b(idomain)%domain > 0) THEN
200 5 : ALLOCATE (diis_env%m_b(idomain)%mdata(1, 1))
201 15 : diis_env%m_b(idomain)%mdata(:, :) = 0.0_dp
202 : END IF
203 : END DO
204 :
205 2 : CALL timestop(handle)
206 :
207 2 : END SUBROUTINE almo_scf_diis_init_domain
208 :
209 : ! **************************************************************************************************
210 : !> \brief adds a variable-error pair to the diis structure
211 : !> \param diis_env ...
212 : !> \param var ...
213 : !> \param err ...
214 : !> \param d_var ...
215 : !> \param d_err ...
216 : !> \par History
217 : !> 2011.12 created [Rustam Z Khaliullin]
218 : !> \author Rustam Z Khaliullin
219 : ! **************************************************************************************************
220 426 : SUBROUTINE almo_scf_diis_push(diis_env, var, err, d_var, d_err)
221 : TYPE(almo_scf_diis_type), INTENT(INOUT) :: diis_env
222 : TYPE(dbcsr_type), INTENT(IN), OPTIONAL :: var, err
223 : TYPE(domain_submatrix_type), DIMENSION(:), &
224 : INTENT(IN), OPTIONAL :: d_var, d_err
225 :
226 : CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_push'
227 :
228 : INTEGER :: handle, idomain, in_point, irow, &
229 : ndomains, old_buffer_length
230 : REAL(KIND=dp) :: trace0
231 426 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: m_b_tmp
232 :
233 426 : CALL timeset(routineN, handle)
234 :
235 426 : IF (diis_env%diis_env_type == diis_env_dbcsr) THEN
236 424 : IF (.NOT. (PRESENT(var) .AND. PRESENT(err))) THEN
237 0 : CPABORT("provide DBCSR matrices")
238 : END IF
239 2 : ELSE IF (diis_env%diis_env_type == diis_env_domain) THEN
240 2 : IF (.NOT. (PRESENT(d_var) .AND. PRESENT(d_err))) THEN
241 0 : CPABORT("provide domain submatrices")
242 : END IF
243 : ELSE
244 0 : CPABORT("illegal DIIS ENV type")
245 : END IF
246 :
247 426 : in_point = diis_env%in_point
248 :
249 : ! store a var-error pair
250 426 : IF (diis_env%diis_env_type == diis_env_dbcsr) THEN
251 424 : CALL dbcsr_copy(diis_env%m_var(in_point), var)
252 424 : CALL dbcsr_copy(diis_env%m_err(in_point), err)
253 2 : ELSE IF (diis_env%diis_env_type == diis_env_domain) THEN
254 2 : CALL copy_submatrices(d_var, diis_env%d_var(in_point, :), copy_data=.TRUE.)
255 2 : CALL copy_submatrices(d_err, diis_env%d_err(in_point, :), copy_data=.TRUE.)
256 : END IF
257 :
258 : ! update the buffer length
259 426 : old_buffer_length = diis_env%buffer_length
260 426 : diis_env%buffer_length = diis_env%buffer_length + 1
261 426 : IF (diis_env%buffer_length > diis_env%max_buffer_length) THEN
262 96 : diis_env%buffer_length = diis_env%max_buffer_length
263 : END IF
264 :
265 : !!!! resize B matrix
266 : !!!IF (old_buffer_length.lt.diis_env%buffer_length) THEN
267 : !!! ALLOCATE(m_b_tmp(diis_env%buffer_length+1,diis_env%buffer_length+1))
268 : !!! m_b_tmp(1:diis_env%buffer_length,1:diis_env%buffer_length)=&
269 : !!! diis_env%m_b(:,:)
270 : !!! DEALLOCATE(diis_env%m_b)
271 : !!! ALLOCATE(diis_env%m_b(diis_env%buffer_length+1,&
272 : !!! diis_env%buffer_length+1))
273 : !!! diis_env%m_b(:,:)=m_b_tmp(:,:)
274 : !!! DEALLOCATE(m_b_tmp)
275 : !!!ENDIF
276 : !!!! update B matrix elements
277 : !!!diis_env%m_b(1,in_point+1)=-1.0_dp
278 : !!!diis_env%m_b(in_point+1,1)=-1.0_dp
279 : !!!DO irow=1,diis_env%buffer_length
280 : !!! trace0=almo_scf_diis_error_overlap(diis_env,&
281 : !!! A=diis_env%m_err(irow),B=diis_env%m_err(in_point))
282 : !!!
283 : !!! diis_env%m_b(irow+1,in_point+1)=trace0
284 : !!! diis_env%m_b(in_point+1,irow+1)=trace0
285 : !!!ENDDO
286 :
287 : ! resize B matrix and update its elements
288 426 : ndomains = SIZE(diis_env%m_b)
289 426 : IF (old_buffer_length < diis_env%buffer_length) THEN
290 1320 : ALLOCATE (m_b_tmp(diis_env%buffer_length + 1, diis_env%buffer_length + 1))
291 668 : DO idomain = 1, ndomains
292 668 : IF (diis_env%m_b(idomain)%domain > 0) THEN
293 333 : m_b_tmp(:, :) = 0.0_dp
294 : m_b_tmp(1:diis_env%buffer_length, 1:diis_env%buffer_length) = &
295 4447 : diis_env%m_b(idomain)%mdata(:, :)
296 333 : DEALLOCATE (diis_env%m_b(idomain)%mdata)
297 0 : ALLOCATE (diis_env%m_b(idomain)%mdata(diis_env%buffer_length + 1, &
298 1332 : diis_env%buffer_length + 1))
299 6947 : diis_env%m_b(idomain)%mdata(:, :) = m_b_tmp(:, :)
300 : END IF
301 : END DO
302 330 : DEALLOCATE (m_b_tmp)
303 : END IF
304 860 : DO idomain = 1, ndomains
305 860 : IF (diis_env%m_b(idomain)%domain > 0) THEN
306 429 : diis_env%m_b(idomain)%mdata(1, in_point + 1) = -1.0_dp
307 429 : diis_env%m_b(idomain)%mdata(in_point + 1, 1) = -1.0_dp
308 1796 : DO irow = 1, diis_env%buffer_length
309 1367 : IF (diis_env%diis_env_type == diis_env_dbcsr) THEN
310 : trace0 = almo_scf_diis_error_overlap(diis_env, &
311 1362 : A=diis_env%m_err(irow), B=diis_env%m_err(in_point))
312 5 : ELSE IF (diis_env%diis_env_type == diis_env_domain) THEN
313 : trace0 = almo_scf_diis_error_overlap(diis_env, &
314 : d_A=diis_env%d_err(irow, idomain), &
315 5 : d_B=diis_env%d_err(in_point, idomain))
316 : END IF
317 1367 : diis_env%m_b(idomain)%mdata(irow + 1, in_point + 1) = trace0
318 1796 : diis_env%m_b(idomain)%mdata(in_point + 1, irow + 1) = trace0
319 : END DO ! loop over prev errors
320 : END IF
321 : END DO ! loop over domains
322 :
323 : ! update the insertion point for the next "PUSH"
324 426 : diis_env%in_point = diis_env%in_point + 1
325 426 : IF (diis_env%in_point > diis_env%max_buffer_length) diis_env%in_point = 1
326 :
327 426 : CALL timestop(handle)
328 :
329 426 : END SUBROUTINE almo_scf_diis_push
330 :
331 : ! **************************************************************************************************
332 : !> \brief extrapolates the variable using the saved history
333 : !> \param diis_env ...
334 : !> \param extr_var ...
335 : !> \param d_extr_var ...
336 : !> \par History
337 : !> 2011.12 created [Rustam Z Khaliullin]
338 : !> \author Rustam Z Khaliullin
339 : ! **************************************************************************************************
340 272 : SUBROUTINE almo_scf_diis_extrapolate(diis_env, extr_var, d_extr_var)
341 : TYPE(almo_scf_diis_type), INTENT(INOUT) :: diis_env
342 : TYPE(dbcsr_type), INTENT(INOUT), OPTIONAL :: extr_var
343 : TYPE(domain_submatrix_type), DIMENSION(:), &
344 : INTENT(INOUT), OPTIONAL :: d_extr_var
345 :
346 : CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_extrapolate'
347 :
348 : INTEGER :: handle, idomain, im, INFO, LWORK, &
349 : ndomains, unit_nr
350 : REAL(KIND=dp) :: checksum
351 272 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: coeff, eigenvalues, tmp1, WORK
352 272 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: m_b_copy
353 : TYPE(cp_logger_type), POINTER :: logger
354 :
355 272 : CALL timeset(routineN, handle)
356 :
357 : ! get a useful output_unit
358 272 : logger => cp_get_default_logger()
359 272 : IF (logger%para_env%is_source()) THEN
360 136 : unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
361 : ELSE
362 : unit_nr = -1
363 : END IF
364 :
365 272 : IF (diis_env%diis_env_type == diis_env_dbcsr) THEN
366 272 : IF (.NOT. PRESENT(extr_var)) THEN
367 0 : CPABORT("provide DBCSR matrix")
368 : END IF
369 0 : ELSE IF (diis_env%diis_env_type == diis_env_domain) THEN
370 0 : IF (.NOT. PRESENT(d_extr_var)) THEN
371 0 : CPABORT("provide domain submatrices")
372 : END IF
373 : ELSE
374 0 : CPABORT("illegal DIIS ENV type")
375 : END IF
376 :
377 : ! Prepare data
378 816 : ALLOCATE (eigenvalues(diis_env%buffer_length + 1))
379 1088 : ALLOCATE (m_b_copy(diis_env%buffer_length + 1, diis_env%buffer_length + 1))
380 :
381 272 : ndomains = SIZE(diis_env%m_b)
382 :
383 544 : DO idomain = 1, ndomains
384 :
385 544 : IF (diis_env%m_b(idomain)%domain > 0) THEN
386 :
387 7456 : m_b_copy(:, :) = diis_env%m_b(idomain)%mdata(:, :)
388 :
389 : ! Query the optimal workspace for dsyev
390 272 : LWORK = -1
391 272 : ALLOCATE (WORK(MAX(1, LWORK)))
392 : CALL dsyev('V', 'L', diis_env%buffer_length + 1, m_b_copy, &
393 272 : diis_env%buffer_length + 1, eigenvalues, WORK, LWORK, INFO)
394 272 : LWORK = INT(WORK(1))
395 272 : DEALLOCATE (WORK)
396 :
397 : ! Allocate the workspace and solve the eigenproblem
398 816 : ALLOCATE (WORK(MAX(1, LWORK)))
399 : CALL dsyev('V', 'L', diis_env%buffer_length + 1, m_b_copy, &
400 272 : diis_env%buffer_length + 1, eigenvalues, WORK, LWORK, INFO)
401 272 : IF (INFO /= 0) CPABORT("DSYEV failed")
402 272 : DEALLOCATE (WORK)
403 :
404 : ! use the eigensystem to invert (implicitly) B matrix
405 : ! and compute the extrapolation coefficients
406 816 : ALLOCATE (tmp1(diis_env%buffer_length + 1))
407 544 : ALLOCATE (coeff(diis_env%buffer_length + 1))
408 1502 : tmp1(:) = -1.0_dp*m_b_copy(1, :)/eigenvalues(:)
409 7456 : coeff(:) = MATMUL(m_b_copy, tmp1)
410 272 : DEALLOCATE (tmp1)
411 :
412 : ! extrapolate the variable
413 272 : checksum = 0.0_dp
414 272 : IF (diis_env%diis_env_type == diis_env_dbcsr) THEN
415 272 : CALL dbcsr_set(extr_var, 0.0_dp)
416 1230 : DO im = 1, diis_env%buffer_length
417 : CALL dbcsr_add(extr_var, diis_env%m_var(im), &
418 958 : 1.0_dp, coeff(im + 1))
419 1230 : checksum = checksum + coeff(im + 1)
420 : END DO
421 0 : ELSE IF (diis_env%diis_env_type == diis_env_domain) THEN
422 : CALL copy_submatrices(diis_env%d_var(1, idomain), &
423 : d_extr_var(idomain), &
424 0 : copy_data=.FALSE.)
425 0 : CALL set_submatrices(d_extr_var(idomain), 0.0_dp)
426 0 : DO im = 1, diis_env%buffer_length
427 : CALL add_submatrices(1.0_dp, d_extr_var(idomain), &
428 : coeff(im + 1), diis_env%d_var(im, idomain), &
429 0 : 'N')
430 0 : checksum = checksum + coeff(im + 1)
431 : END DO
432 : END IF
433 :
434 272 : DEALLOCATE (coeff)
435 :
436 : END IF ! domain is local to this mpi node
437 :
438 : END DO ! loop over domains
439 :
440 272 : DEALLOCATE (eigenvalues)
441 272 : DEALLOCATE (m_b_copy)
442 :
443 272 : CALL timestop(handle)
444 :
445 544 : END SUBROUTINE almo_scf_diis_extrapolate
446 :
447 : ! **************************************************************************************************
448 : !> \brief computes elements of b-matrix
449 : !> \param diis_env ...
450 : !> \param A ...
451 : !> \param B ...
452 : !> \param d_A ...
453 : !> \param d_B ...
454 : !> \return ...
455 : !> \par History
456 : !> 2013.02 created [Rustam Z Khaliullin]
457 : !> \author Rustam Z Khaliullin
458 : ! **************************************************************************************************
459 1367 : FUNCTION almo_scf_diis_error_overlap(diis_env, A, B, d_A, d_B)
460 :
461 : TYPE(almo_scf_diis_type), INTENT(INOUT) :: diis_env
462 : TYPE(dbcsr_type), INTENT(INOUT), OPTIONAL :: A, B
463 : TYPE(domain_submatrix_type), INTENT(INOUT), &
464 : OPTIONAL :: d_A, d_B
465 : REAL(KIND=dp) :: almo_scf_diis_error_overlap
466 :
467 : CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_error_overlap'
468 :
469 : INTEGER :: handle
470 : REAL(KIND=dp) :: trace
471 :
472 1367 : CALL timeset(routineN, handle)
473 :
474 1367 : IF (diis_env%diis_env_type == diis_env_dbcsr) THEN
475 1362 : IF (.NOT. (PRESENT(A) .AND. PRESENT(B))) THEN
476 0 : CPABORT("provide DBCSR matrices")
477 : END IF
478 5 : ELSE IF (diis_env%diis_env_type == diis_env_domain) THEN
479 5 : IF (.NOT. (PRESENT(d_A) .AND. PRESENT(d_B))) THEN
480 0 : CPABORT("provide domain submatrices")
481 : END IF
482 : ELSE
483 0 : CPABORT("illegal DIIS ENV type")
484 : END IF
485 :
486 2734 : SELECT CASE (diis_env%error_type)
487 : CASE (diis_error_orthogonal)
488 1367 : IF (diis_env%diis_env_type == diis_env_dbcsr) THEN
489 1362 : CALL dbcsr_dot(A, B, trace)
490 5 : ELSE IF (diis_env%diis_env_type == diis_env_domain) THEN
491 5 : CPASSERT(SIZE(d_A%mdata, 1) == SIZE(d_B%mdata, 1))
492 5 : CPASSERT(SIZE(d_A%mdata, 2) == SIZE(d_B%mdata, 2))
493 5 : CPASSERT(d_A%domain == d_B%domain)
494 5 : CPASSERT(d_A%domain > 0)
495 5 : CPASSERT(d_B%domain > 0)
496 31607 : trace = SUM(d_A%mdata(:, :)*d_B%mdata(:, :))
497 : END IF
498 : CASE DEFAULT
499 1367 : CPABORT("Vector type is unknown")
500 : END SELECT
501 :
502 1367 : almo_scf_diis_error_overlap = trace
503 :
504 1367 : CALL timestop(handle)
505 :
506 1367 : END FUNCTION almo_scf_diis_error_overlap
507 :
508 : ! **************************************************************************************************
509 : !> \brief destroys the diis structure
510 : !> \param diis_env ...
511 : !> \par History
512 : !> 2011.12 created [Rustam Z Khaliullin]
513 : !> \author Rustam Z Khaliullin
514 : ! **************************************************************************************************
515 78 : SUBROUTINE almo_scf_diis_release(diis_env)
516 : TYPE(almo_scf_diis_type), INTENT(INOUT) :: diis_env
517 :
518 : CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_release'
519 :
520 : INTEGER :: handle, im
521 :
522 78 : CALL timeset(routineN, handle)
523 :
524 : ! release matrices
525 454 : DO im = 1, diis_env%max_buffer_length
526 454 : IF (diis_env%diis_env_type == diis_env_dbcsr) THEN
527 372 : CALL dbcsr_release(diis_env%m_err(im))
528 372 : CALL dbcsr_release(diis_env%m_var(im))
529 4 : ELSE IF (diis_env%diis_env_type == diis_env_domain) THEN
530 4 : CALL release_submatrices(diis_env%d_var(im, :))
531 4 : CALL release_submatrices(diis_env%d_err(im, :))
532 : END IF
533 : END DO
534 :
535 78 : IF (diis_env%diis_env_type == diis_env_domain) THEN
536 2 : CALL release_submatrices(diis_env%m_b(:))
537 : END IF
538 :
539 164 : IF (ALLOCATED(diis_env%m_b)) DEALLOCATE (diis_env%m_b)
540 78 : IF (ALLOCATED(diis_env%m_err)) DEALLOCATE (diis_env%m_err)
541 78 : IF (ALLOCATED(diis_env%m_var)) DEALLOCATE (diis_env%m_var)
542 98 : IF (ALLOCATED(diis_env%d_err)) DEALLOCATE (diis_env%d_err)
543 98 : IF (ALLOCATED(diis_env%d_var)) DEALLOCATE (diis_env%d_var)
544 :
545 78 : CALL timestop(handle)
546 :
547 78 : END SUBROUTINE almo_scf_diis_release
548 :
549 0 : END MODULE almo_scf_diis_types
550 :
|
