99 TYPE(
dbcsr_type),
INTENT(IN) :: sample_err, sample_var
100 INTEGER,
INTENT(IN) :: error_type, max_length
102 CHARACTER(len=*),
PARAMETER :: routineN =
'almo_scf_diis_init_dbcsr'
104 INTEGER :: handle, idomain, im, ndomains
106 CALL timeset(routinen, handle)
108 IF (max_length <= 0)
THEN
109 cpabort(
"DIIS: max_length is less than zero")
112 diis_env%diis_env_type = diis_env_dbcsr
114 diis_env%max_buffer_length = max_length
115 diis_env%buffer_length = 0
116 diis_env%error_type = error_type
117 diis_env%in_point = 1
119 ALLOCATE (diis_env%m_err(diis_env%max_buffer_length))
120 ALLOCATE (diis_env%m_var(diis_env%max_buffer_length))
123 DO im = 1, diis_env%max_buffer_length
133 ALLOCATE (diis_env%m_b(ndomains))
136 diis_env%m_b(:)%domain = 100
137 DO idomain = 1, ndomains
138 IF (diis_env%m_b(idomain)%domain > 0)
THEN
139 ALLOCATE (diis_env%m_b(idomain)%mdata(1, 1))
140 diis_env%m_b(idomain)%mdata(:, :) = 0.0_dp
144 CALL timestop(handle)
158 SUBROUTINE almo_scf_diis_init_domain(diis_env, sample_err, error_type, &
163 INTENT(IN) :: sample_err
164 INTEGER,
INTENT(IN) :: error_type, max_length
166 CHARACTER(len=*),
PARAMETER :: routineN =
'almo_scf_diis_init_domain'
168 INTEGER :: handle, idomain, ndomains
170 CALL timeset(routinen, handle)
172 IF (max_length <= 0)
THEN
173 cpabort(
"DIIS: max_length is less than zero")
176 diis_env%diis_env_type = diis_env_domain
178 diis_env%max_buffer_length = max_length
179 diis_env%buffer_length = 0
180 diis_env%error_type = error_type
181 diis_env%in_point = 1
183 ndomains =
SIZE(sample_err)
185 ALLOCATE (diis_env%d_err(diis_env%max_buffer_length, ndomains))
186 ALLOCATE (diis_env%d_var(diis_env%max_buffer_length, ndomains))
193 ALLOCATE (diis_env%m_b(ndomains))
197 diis_env%m_b(:)%domain = sample_err(:)%domain
198 DO idomain = 1, ndomains
199 IF (diis_env%m_b(idomain)%domain > 0)
THEN
200 ALLOCATE (diis_env%m_b(idomain)%mdata(1, 1))
201 diis_env%m_b(idomain)%mdata(:, :) = 0.0_dp
205 CALL timestop(handle)
222 TYPE(
dbcsr_type),
INTENT(IN),
OPTIONAL :: var, err
224 INTENT(IN),
OPTIONAL :: d_var, d_err
226 CHARACTER(len=*),
PARAMETER :: routinen =
'almo_scf_diis_push'
228 INTEGER :: handle, idomain, in_point, irow, &
229 ndomains, old_buffer_length
230 REAL(kind=
dp) :: trace0
231 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: m_b_tmp
233 CALL timeset(routinen, handle)
235 IF (diis_env%diis_env_type == diis_env_dbcsr)
THEN
236 IF (.NOT. (
PRESENT(var) .AND.
PRESENT(err)))
THEN
237 cpabort(
"provide DBCSR matrices")
239 ELSE IF (diis_env%diis_env_type == diis_env_domain)
THEN
240 IF (.NOT. (
PRESENT(d_var) .AND.
PRESENT(d_err)))
THEN
241 cpabort(
"provide domain submatrices")
244 cpabort(
"illegal DIIS ENV type")
247 in_point = diis_env%in_point
250 IF (diis_env%diis_env_type == diis_env_dbcsr)
THEN
251 CALL dbcsr_copy(diis_env%m_var(in_point), var)
252 CALL dbcsr_copy(diis_env%m_err(in_point), err)
253 ELSE IF (diis_env%diis_env_type == diis_env_domain)
THEN
259 old_buffer_length = diis_env%buffer_length
260 diis_env%buffer_length = diis_env%buffer_length + 1
261 IF (diis_env%buffer_length > diis_env%max_buffer_length)
THEN
262 diis_env%buffer_length = diis_env%max_buffer_length
288 ndomains =
SIZE(diis_env%m_b)
289 IF (old_buffer_length < diis_env%buffer_length)
THEN
290 ALLOCATE (m_b_tmp(diis_env%buffer_length + 1, diis_env%buffer_length + 1))
291 DO idomain = 1, ndomains
292 IF (diis_env%m_b(idomain)%domain > 0)
THEN
293 m_b_tmp(:, :) = 0.0_dp
294 m_b_tmp(1:diis_env%buffer_length, 1:diis_env%buffer_length) = &
295 diis_env%m_b(idomain)%mdata(:, :)
296 DEALLOCATE (diis_env%m_b(idomain)%mdata)
297 ALLOCATE (diis_env%m_b(idomain)%mdata(diis_env%buffer_length + 1, &
298 diis_env%buffer_length + 1))
299 diis_env%m_b(idomain)%mdata(:, :) = m_b_tmp(:, :)
304 DO idomain = 1, ndomains
305 IF (diis_env%m_b(idomain)%domain > 0)
THEN
306 diis_env%m_b(idomain)%mdata(1, in_point + 1) = -1.0_dp
307 diis_env%m_b(idomain)%mdata(in_point + 1, 1) = -1.0_dp
308 DO irow = 1, diis_env%buffer_length
309 IF (diis_env%diis_env_type == diis_env_dbcsr)
THEN
310 trace0 = almo_scf_diis_error_overlap(diis_env, &
311 a=diis_env%m_err(irow), b=diis_env%m_err(in_point))
312 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 d_b=diis_env%d_err(in_point, idomain))
317 diis_env%m_b(idomain)%mdata(irow + 1, in_point + 1) = trace0
318 diis_env%m_b(idomain)%mdata(in_point + 1, irow + 1) = trace0
324 diis_env%in_point = diis_env%in_point + 1
325 IF (diis_env%in_point > diis_env%max_buffer_length) diis_env%in_point = 1
327 CALL timestop(handle)
342 TYPE(
dbcsr_type),
INTENT(INOUT),
OPTIONAL :: extr_var
344 INTENT(INOUT),
OPTIONAL :: d_extr_var
346 CHARACTER(len=*),
PARAMETER :: routinen =
'almo_scf_diis_extrapolate'
348 INTEGER :: handle, idomain, im, info, lwork, &
350 REAL(kind=
dp) :: checksum
351 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: coeff, eigenvalues, tmp1, work
352 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: m_b_copy
355 CALL timeset(routinen, handle)
359 IF (logger%para_env%is_source())
THEN
365 IF (diis_env%diis_env_type == diis_env_dbcsr)
THEN
366 IF (.NOT.
PRESENT(extr_var))
THEN
367 cpabort(
"provide DBCSR matrix")
369 ELSE IF (diis_env%diis_env_type == diis_env_domain)
THEN
370 IF (.NOT.
PRESENT(d_extr_var))
THEN
371 cpabort(
"provide domain submatrices")
374 cpabort(
"illegal DIIS ENV type")
378 ALLOCATE (eigenvalues(diis_env%buffer_length + 1))
379 ALLOCATE (m_b_copy(diis_env%buffer_length + 1, diis_env%buffer_length + 1))
381 ndomains =
SIZE(diis_env%m_b)
383 DO idomain = 1, ndomains
385 IF (diis_env%m_b(idomain)%domain > 0)
THEN
387 m_b_copy(:, :) = diis_env%m_b(idomain)%mdata(:, :)
391 ALLOCATE (work(max(1, lwork)))
392 CALL dsyev(
'V',
'L', diis_env%buffer_length + 1, m_b_copy, &
393 diis_env%buffer_length + 1, eigenvalues, work, lwork, info)
398 ALLOCATE (work(max(1, lwork)))
399 CALL dsyev(
'V',
'L', diis_env%buffer_length + 1, m_b_copy, &
400 diis_env%buffer_length + 1, eigenvalues, work, lwork, info)
401 IF (info /= 0) cpabort(
"DSYEV failed")
406 ALLOCATE (tmp1(diis_env%buffer_length + 1))
407 ALLOCATE (coeff(diis_env%buffer_length + 1))
408 tmp1(:) = -1.0_dp*m_b_copy(1, :)/eigenvalues(:)
409 coeff(:) = matmul(m_b_copy, tmp1)
414 IF (diis_env%diis_env_type == diis_env_dbcsr)
THEN
416 DO im = 1, diis_env%buffer_length
417 CALL dbcsr_add(extr_var, diis_env%m_var(im), &
418 1.0_dp, coeff(im + 1))
419 checksum = checksum + coeff(im + 1)
421 ELSE IF (diis_env%diis_env_type == diis_env_domain)
THEN
423 d_extr_var(idomain), &
426 DO im = 1, diis_env%buffer_length
428 coeff(im + 1), diis_env%d_var(im, idomain), &
430 checksum = checksum + coeff(im + 1)
440 DEALLOCATE (eigenvalues)
441 DEALLOCATE (m_b_copy)
443 CALL timestop(handle)
Subroutines to handle submatrices.
Types to handle submatrices.