Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 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_dot,&
19 : dbcsr_release,&
20 : dbcsr_set,&
21 : dbcsr_type
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 .LE. 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 600 : 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 .GT. 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 .LE. 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 .GT. 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 .EQ. 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 .EQ. 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 .EQ. 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 .EQ. 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 .GT. diis_env%max_buffer_length) &
262 96 : diis_env%buffer_length = diis_env%max_buffer_length
263 :
264 : !!!! resize B matrix
265 : !!!IF (old_buffer_length.lt.diis_env%buffer_length) THEN
266 : !!! ALLOCATE(m_b_tmp(diis_env%buffer_length+1,diis_env%buffer_length+1))
267 : !!! m_b_tmp(1:diis_env%buffer_length,1:diis_env%buffer_length)=&
268 : !!! diis_env%m_b(:,:)
269 : !!! DEALLOCATE(diis_env%m_b)
270 : !!! ALLOCATE(diis_env%m_b(diis_env%buffer_length+1,&
271 : !!! diis_env%buffer_length+1))
272 : !!! diis_env%m_b(:,:)=m_b_tmp(:,:)
273 : !!! DEALLOCATE(m_b_tmp)
274 : !!!ENDIF
275 : !!!! update B matrix elements
276 : !!!diis_env%m_b(1,in_point+1)=-1.0_dp
277 : !!!diis_env%m_b(in_point+1,1)=-1.0_dp
278 : !!!DO irow=1,diis_env%buffer_length
279 : !!! trace0=almo_scf_diis_error_overlap(diis_env,&
280 : !!! A=diis_env%m_err(irow),B=diis_env%m_err(in_point))
281 : !!!
282 : !!! diis_env%m_b(irow+1,in_point+1)=trace0
283 : !!! diis_env%m_b(in_point+1,irow+1)=trace0
284 : !!!ENDDO
285 :
286 : ! resize B matrix and update its elements
287 426 : ndomains = SIZE(diis_env%m_b)
288 426 : IF (old_buffer_length .LT. diis_env%buffer_length) THEN
289 1320 : ALLOCATE (m_b_tmp(diis_env%buffer_length + 1, diis_env%buffer_length + 1))
290 668 : DO idomain = 1, ndomains
291 668 : IF (diis_env%m_b(idomain)%domain .GT. 0) THEN
292 6947 : m_b_tmp(:, :) = 0.0_dp
293 : m_b_tmp(1:diis_env%buffer_length, 1:diis_env%buffer_length) = &
294 4447 : diis_env%m_b(idomain)%mdata(:, :)
295 333 : DEALLOCATE (diis_env%m_b(idomain)%mdata)
296 0 : ALLOCATE (diis_env%m_b(idomain)%mdata(diis_env%buffer_length + 1, &
297 1332 : diis_env%buffer_length + 1))
298 6947 : diis_env%m_b(idomain)%mdata(:, :) = m_b_tmp(:, :)
299 : END IF
300 : END DO
301 330 : DEALLOCATE (m_b_tmp)
302 : END IF
303 860 : DO idomain = 1, ndomains
304 860 : IF (diis_env%m_b(idomain)%domain .GT. 0) THEN
305 429 : diis_env%m_b(idomain)%mdata(1, in_point + 1) = -1.0_dp
306 429 : diis_env%m_b(idomain)%mdata(in_point + 1, 1) = -1.0_dp
307 1796 : DO irow = 1, diis_env%buffer_length
308 1367 : IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
309 : trace0 = almo_scf_diis_error_overlap(diis_env, &
310 1362 : A=diis_env%m_err(irow), B=diis_env%m_err(in_point))
311 5 : ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
312 : trace0 = almo_scf_diis_error_overlap(diis_env, &
313 : d_A=diis_env%d_err(irow, idomain), &
314 5 : d_B=diis_env%d_err(in_point, idomain))
315 : END IF
316 1367 : diis_env%m_b(idomain)%mdata(irow + 1, in_point + 1) = trace0
317 1796 : diis_env%m_b(idomain)%mdata(in_point + 1, irow + 1) = trace0
318 : END DO ! loop over prev errors
319 : END IF
320 : END DO ! loop over domains
321 :
322 : ! update the insertion point for the next "PUSH"
323 426 : diis_env%in_point = diis_env%in_point + 1
324 426 : IF (diis_env%in_point .GT. diis_env%max_buffer_length) diis_env%in_point = 1
325 :
326 426 : CALL timestop(handle)
327 :
328 426 : END SUBROUTINE almo_scf_diis_push
329 :
330 : ! **************************************************************************************************
331 : !> \brief extrapolates the variable using the saved history
332 : !> \param diis_env ...
333 : !> \param extr_var ...
334 : !> \param d_extr_var ...
335 : !> \par History
336 : !> 2011.12 created [Rustam Z Khaliullin]
337 : !> \author Rustam Z Khaliullin
338 : ! **************************************************************************************************
339 272 : SUBROUTINE almo_scf_diis_extrapolate(diis_env, extr_var, d_extr_var)
340 : TYPE(almo_scf_diis_type), INTENT(INOUT) :: diis_env
341 : TYPE(dbcsr_type), INTENT(INOUT), OPTIONAL :: extr_var
342 : TYPE(domain_submatrix_type), DIMENSION(:), &
343 : INTENT(INOUT), OPTIONAL :: d_extr_var
344 :
345 : CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_extrapolate'
346 :
347 : INTEGER :: handle, idomain, im, INFO, LWORK, &
348 : ndomains, unit_nr
349 : REAL(KIND=dp) :: checksum
350 272 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: coeff, eigenvalues, tmp1, WORK
351 272 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: m_b_copy
352 : TYPE(cp_logger_type), POINTER :: logger
353 :
354 272 : CALL timeset(routineN, handle)
355 :
356 : ! get a useful output_unit
357 272 : logger => cp_get_default_logger()
358 272 : IF (logger%para_env%is_source()) THEN
359 136 : unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
360 : ELSE
361 : unit_nr = -1
362 : END IF
363 :
364 272 : IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
365 272 : IF (.NOT. PRESENT(extr_var)) THEN
366 0 : CPABORT("provide DBCSR matrix")
367 : END IF
368 0 : ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
369 0 : IF (.NOT. PRESENT(d_extr_var)) THEN
370 0 : CPABORT("provide domain submatrices")
371 : END IF
372 : ELSE
373 0 : CPABORT("illegal DIIS ENV type")
374 : END IF
375 :
376 : ! Prepare data
377 816 : ALLOCATE (eigenvalues(diis_env%buffer_length + 1))
378 1088 : ALLOCATE (m_b_copy(diis_env%buffer_length + 1, diis_env%buffer_length + 1))
379 :
380 272 : ndomains = SIZE(diis_env%m_b)
381 :
382 544 : DO idomain = 1, ndomains
383 :
384 544 : IF (diis_env%m_b(idomain)%domain .GT. 0) THEN
385 :
386 7456 : m_b_copy(:, :) = diis_env%m_b(idomain)%mdata(:, :)
387 :
388 : ! Query the optimal workspace for dsyev
389 272 : LWORK = -1
390 272 : ALLOCATE (WORK(MAX(1, LWORK)))
391 : CALL DSYEV('V', 'L', diis_env%buffer_length + 1, m_b_copy, &
392 272 : diis_env%buffer_length + 1, eigenvalues, WORK, LWORK, INFO)
393 272 : LWORK = INT(WORK(1))
394 272 : DEALLOCATE (WORK)
395 :
396 : ! Allocate the workspace and solve the eigenproblem
397 816 : ALLOCATE (WORK(MAX(1, LWORK)))
398 : CALL DSYEV('V', 'L', diis_env%buffer_length + 1, m_b_copy, &
399 272 : diis_env%buffer_length + 1, eigenvalues, WORK, LWORK, INFO)
400 272 : IF (INFO .NE. 0) THEN
401 0 : CPABORT("DSYEV failed")
402 : END IF
403 272 : DEALLOCATE (WORK)
404 :
405 : ! use the eigensystem to invert (implicitly) B matrix
406 : ! and compute the extrapolation coefficients
407 : !! ALLOCATE(tmp1(diis_env%buffer_length+1,1))
408 : !! ALLOCATE(coeff(diis_env%buffer_length+1,1))
409 : !! tmp1(:,1)=-1.0_dp*m_b_copy(1,:)/eigenvalues(:)
410 : !! coeff=MATMUL(m_b_copy,tmp1)
411 : !! DEALLOCATE(tmp1)
412 816 : ALLOCATE (tmp1(diis_env%buffer_length + 1))
413 544 : ALLOCATE (coeff(diis_env%buffer_length + 1))
414 1502 : tmp1(:) = -1.0_dp*m_b_copy(1, :)/eigenvalues(:)
415 8686 : coeff(:) = MATMUL(m_b_copy, tmp1)
416 272 : DEALLOCATE (tmp1)
417 :
418 : !IF (unit_nr.gt.0) THEN
419 : ! DO im=1,diis_env%buffer_length+1
420 : ! WRITE(unit_nr,*) diis_env%m_b(idomain)%mdata(im,:)
421 : ! ENDDO
422 : ! WRITE (unit_nr,*) coeff(:,1)
423 : !ENDIF
424 :
425 : ! extrapolate the variable
426 272 : checksum = 0.0_dp
427 272 : IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
428 272 : CALL dbcsr_set(extr_var, 0.0_dp)
429 1230 : DO im = 1, diis_env%buffer_length
430 : CALL dbcsr_add(extr_var, diis_env%m_var(im), &
431 958 : 1.0_dp, coeff(im + 1))
432 1230 : checksum = checksum + coeff(im + 1)
433 : END DO
434 0 : ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
435 : CALL copy_submatrices(diis_env%d_var(1, idomain), &
436 : d_extr_var(idomain), &
437 0 : copy_data=.FALSE.)
438 0 : CALL set_submatrices(d_extr_var(idomain), 0.0_dp)
439 0 : DO im = 1, diis_env%buffer_length
440 : CALL add_submatrices(1.0_dp, d_extr_var(idomain), &
441 : coeff(im + 1), diis_env%d_var(im, idomain), &
442 0 : 'N')
443 0 : checksum = checksum + coeff(im + 1)
444 : END DO
445 : END IF
446 : !WRITE(*,*) checksum
447 :
448 272 : DEALLOCATE (coeff)
449 :
450 : END IF ! domain is local to this mpi node
451 :
452 : END DO ! loop over domains
453 :
454 272 : DEALLOCATE (eigenvalues)
455 272 : DEALLOCATE (m_b_copy)
456 :
457 272 : CALL timestop(handle)
458 :
459 544 : END SUBROUTINE almo_scf_diis_extrapolate
460 :
461 : ! **************************************************************************************************
462 : !> \brief computes elements of b-matrix
463 : !> \param diis_env ...
464 : !> \param A ...
465 : !> \param B ...
466 : !> \param d_A ...
467 : !> \param d_B ...
468 : !> \return ...
469 : !> \par History
470 : !> 2013.02 created [Rustam Z Khaliullin]
471 : !> \author Rustam Z Khaliullin
472 : ! **************************************************************************************************
473 1367 : FUNCTION almo_scf_diis_error_overlap(diis_env, A, B, d_A, d_B)
474 :
475 : TYPE(almo_scf_diis_type), INTENT(INOUT) :: diis_env
476 : TYPE(dbcsr_type), INTENT(INOUT), OPTIONAL :: A, B
477 : TYPE(domain_submatrix_type), INTENT(INOUT), &
478 : OPTIONAL :: d_A, d_B
479 : REAL(KIND=dp) :: almo_scf_diis_error_overlap
480 :
481 : CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_error_overlap'
482 :
483 : INTEGER :: handle
484 : REAL(KIND=dp) :: trace
485 :
486 1367 : CALL timeset(routineN, handle)
487 :
488 1367 : IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
489 1362 : IF (.NOT. (PRESENT(A) .AND. PRESENT(B))) THEN
490 0 : CPABORT("provide DBCSR matrices")
491 : END IF
492 5 : ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
493 5 : IF (.NOT. (PRESENT(d_A) .AND. PRESENT(d_B))) THEN
494 0 : CPABORT("provide domain submatrices")
495 : END IF
496 : ELSE
497 0 : CPABORT("illegal DIIS ENV type")
498 : END IF
499 :
500 2734 : SELECT CASE (diis_env%error_type)
501 : CASE (diis_error_orthogonal)
502 1367 : IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
503 1362 : CALL dbcsr_dot(A, B, trace)
504 5 : ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
505 5 : CPASSERT(SIZE(d_A%mdata, 1) .EQ. SIZE(d_B%mdata, 1))
506 5 : CPASSERT(SIZE(d_A%mdata, 2) .EQ. SIZE(d_B%mdata, 2))
507 5 : CPASSERT(d_A%domain .EQ. d_B%domain)
508 5 : CPASSERT(d_A%domain .GT. 0)
509 5 : CPASSERT(d_B%domain .GT. 0)
510 31607 : trace = SUM(d_A%mdata(:, :)*d_B%mdata(:, :))
511 : END IF
512 : CASE DEFAULT
513 1367 : CPABORT("Vector type is unknown")
514 : END SELECT
515 :
516 1367 : almo_scf_diis_error_overlap = trace
517 :
518 1367 : CALL timestop(handle)
519 :
520 1367 : END FUNCTION almo_scf_diis_error_overlap
521 :
522 : ! **************************************************************************************************
523 : !> \brief destroys the diis structure
524 : !> \param diis_env ...
525 : !> \par History
526 : !> 2011.12 created [Rustam Z Khaliullin]
527 : !> \author Rustam Z Khaliullin
528 : ! **************************************************************************************************
529 78 : SUBROUTINE almo_scf_diis_release(diis_env)
530 : TYPE(almo_scf_diis_type), INTENT(INOUT) :: diis_env
531 :
532 : CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_release'
533 :
534 : INTEGER :: handle, im
535 :
536 78 : CALL timeset(routineN, handle)
537 :
538 : ! release matrices
539 454 : DO im = 1, diis_env%max_buffer_length
540 454 : IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
541 372 : CALL dbcsr_release(diis_env%m_err(im))
542 372 : CALL dbcsr_release(diis_env%m_var(im))
543 4 : ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
544 4 : CALL release_submatrices(diis_env%d_var(im, :))
545 4 : CALL release_submatrices(diis_env%d_err(im, :))
546 : END IF
547 : END DO
548 :
549 78 : IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
550 2 : CALL release_submatrices(diis_env%m_b(:))
551 : END IF
552 :
553 164 : IF (ALLOCATED(diis_env%m_b)) DEALLOCATE (diis_env%m_b)
554 78 : IF (ALLOCATED(diis_env%m_err)) DEALLOCATE (diis_env%m_err)
555 78 : IF (ALLOCATED(diis_env%m_var)) DEALLOCATE (diis_env%m_var)
556 98 : IF (ALLOCATED(diis_env%d_err)) DEALLOCATE (diis_env%d_err)
557 98 : IF (ALLOCATED(diis_env%d_var)) DEALLOCATE (diis_env%d_var)
558 :
559 78 : CALL timestop(handle)
560 :
561 78 : END SUBROUTINE almo_scf_diis_release
562 :
563 0 : END MODULE almo_scf_diis_types
564 :
|
