(git:44e3845)
Loading...
Searching...
No Matches
qs_tddfpt2_eigensolver.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
11 USE cp_dbcsr_api, ONLY: dbcsr_get_info,&
25 USE cp_fm_types, ONLY: &
30 USE input_constants, ONLY: no_sf_tddfpt,&
35 USE kinds, ONLY: dp,&
36 int_8
37 USE machine, ONLY: m_flush,&
42 USE physcon, ONLY: evolt
50 USE qs_tddfpt2_fhxc, ONLY: fhxc_kernel,&
64#include "./base/base_uses.f90"
65
66 IMPLICIT NONE
67
68 PRIVATE
69
70 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_tddfpt2_eigensolver'
71
72 LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .false.
73 ! number of first derivative components (3: d/dx, d/dy, d/dz)
74 INTEGER, PARAMETER, PRIVATE :: nderivs = 3
75 INTEGER, PARAMETER, PRIVATE :: maxspins = 2
76
79
80! **************************************************************************************************
81
82CONTAINS
83
84! **************************************************************************************************
85!> \brief Make TDDFPT trial vectors orthogonal to all occupied molecular orbitals.
86!> \param evects trial vectors distributed across all processors (modified on exit)
87!> \param S_C0_C0T matrix product S * C_0 * C_0^T, where C_0 is the ground state
88!> wave function for each spin expressed in atomic basis set,
89!> and S is the corresponding overlap matrix
90!> \param qs_env ...
91!> \param gs_mos ...
92!> \param evals ...
93!> \param tddfpt_control ...
94!> \param S_C0 ...
95!> \par History
96!> * 05.2016 created [Sergey Chulkov]
97!> * 05.2019 use a temporary work matrix [JHU]
98!> \note Based on the subroutine p_preortho() which was created by Thomas Chassaing on 09.2002.
99!> Should be useless when ground state MOs are computed with extremely high accuracy,
100!> as all virtual orbitals are already orthogonal to the occupied ones by design.
101!> However, when the norm of residual vectors is relatively small (e.g. less then SCF_EPS),
102!> new Krylov's vectors seem to be random and should be orthogonalised even with respect to
103!> the occupied MOs.
104! **************************************************************************************************
105 SUBROUTINE tddfpt_orthogonalize_psi1_psi0(evects, S_C0_C0T, qs_env, gs_mos, evals, &
106 tddfpt_control, S_C0)
107 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: evects
108 TYPE(cp_fm_type), DIMENSION(:), INTENT(in) :: s_c0_c0t
109 TYPE(qs_environment_type), POINTER :: qs_env
110 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
111 INTENT(in) :: gs_mos
112 REAL(kind=dp), DIMENSION(:), INTENT(in) :: evals
113 TYPE(tddfpt2_control_type), INTENT(in), POINTER :: tddfpt_control
114 TYPE(cp_fm_type), DIMENSION(:), INTENT(in) :: s_c0
115
116 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_orthogonalize_psi1_psi0'
117
118 INTEGER :: handle, ispin, ivect, nactive, nao, &
119 nspins, nvects, spin
120 TYPE(cp_fm_struct_type), POINTER :: matrix_struct
121 TYPE(cp_fm_type) :: evortho
122 TYPE(cp_fm_type), DIMENSION(:), POINTER :: mos
123 TYPE(mp_para_env_type), POINTER :: para_env
124
125 CALL timeset(routinen, handle)
126
127 nspins = SIZE(evects, 1)
128 nvects = SIZE(evects, 2)
129
130 IF (nvects > 0) THEN
131 IF (.NOT. tddfpt_control%do_smearing) THEN
132 DO ispin = 1, nspins
133 IF (tddfpt_control%spinflip == no_sf_tddfpt) THEN
134 spin = ispin
135 ELSE
136 spin = 2
137 END IF
138 CALL cp_fm_get_info(matrix=evects(ispin, 1), matrix_struct=matrix_struct, &
139 nrow_global=nao, ncol_global=nactive)
140 CALL cp_fm_create(evortho, matrix_struct)
141 DO ivect = 1, nvects
142 ! evortho: C0 * C0^T * S * C1 == (S * C0 * C0^T)^T * C1
143 CALL parallel_gemm('T', 'N', nao, nactive, nao, 1.0_dp, s_c0_c0t(spin), &
144 evects(ispin, ivect), 0.0_dp, evortho)
145 CALL cp_fm_scale_and_add(1.0_dp, evects(ispin, ivect), -1.0_dp, evortho)
146 END DO
147 CALL cp_fm_release(evortho)
148 END DO
149 ELSE
150 NULLIFY (para_env)
151 CALL get_qs_env(qs_env, para_env=para_env)
152 NULLIFY (mos)
153 ALLOCATE (mos(nspins))
154 DO ispin = 1, nspins
155 CALL cp_fm_get_info(matrix=evects(ispin, 1), matrix_struct=matrix_struct, &
156 nrow_global=nao, ncol_global=nactive)
157 CALL cp_fm_create(mos(ispin), matrix_struct)
158 CALL cp_fm_copy_general(gs_mos(ispin)%mos_occ, mos(ispin), para_env)
159 END DO
160 DO ivect = 1, nvects
161 CALL compute_fermib(qs_env, gs_mos, evals(ivect))
162 CALL orthogonalize_smeared_occupation(evects(:, ivect), qs_env, mos, s_c0)
163 END DO
164 DO ispin = 1, nspins
165 CALL cp_fm_release(mos(ispin))
166 END DO
167 DEALLOCATE (mos)
168 END IF
169 END IF
170
171 CALL timestop(handle)
172
173 END SUBROUTINE tddfpt_orthogonalize_psi1_psi0
174
175! **************************************************************************************************
176!> \brief Check that orthogonalised TDDFPT trial vectors remain orthogonal to
177!> occupied molecular orbitals.
178!> \param evects trial vectors
179!> \param S_C0 matrix product S * C_0, where C_0 is the ground state wave function
180!> for each spin in atomic basis set, and S is the corresponding overlap matrix
181!> \param max_norm the largest possible overlap between the ground state and
182!> excited state wave functions
183!> \param spinflip ...
184!> \return true if trial vectors are non-orthogonal to occupied molecular orbitals
185!> \par History
186!> * 07.2016 created [Sergey Chulkov]
187!> * 05.2019 use temporary work matrices [JHU]
188! **************************************************************************************************
189 FUNCTION tddfpt_is_nonorthogonal_psi1_psi0(evects, S_C0, max_norm, spinflip) &
190 result(is_nonortho)
191 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: evects
192 TYPE(cp_fm_type), DIMENSION(:), INTENT(in) :: s_c0
193 REAL(kind=dp), INTENT(in) :: max_norm
194 INTEGER, INTENT(in) :: spinflip
195 LOGICAL :: is_nonortho
196
197 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_is_nonorthogonal_psi1_psi0'
198
199 INTEGER :: handle, ispin, ivect, nactive, nao, &
200 nocc, nspins, nvects, spin
201 REAL(kind=dp) :: maxabs_val
202 TYPE(cp_fm_struct_type), POINTER :: matrix_struct, matrix_struct_tmp
203 TYPE(cp_fm_type) :: aortho
204
205 CALL timeset(routinen, handle)
206
207 nspins = SIZE(evects, 1)
208 nvects = SIZE(evects, 2)
209
210 is_nonortho = .false.
211
212 loop: DO ispin = 1, nspins
213
214 IF (spinflip == no_sf_tddfpt) THEN
215 spin = ispin
216 ELSE
217 spin = 2
218 END IF
219
220 CALL cp_fm_get_info(matrix=s_c0(spin), ncol_global=nocc)
221 CALL cp_fm_get_info(matrix=evects(ispin, 1), matrix_struct=matrix_struct, &
222 nrow_global=nao, ncol_global=nactive)
223 CALL cp_fm_struct_create(matrix_struct_tmp, nrow_global=nocc, &
224 ncol_global=nactive, template_fmstruct=matrix_struct)
225 CALL cp_fm_create(aortho, matrix_struct_tmp)
226 CALL cp_fm_struct_release(matrix_struct_tmp)
227 DO ivect = 1, nvects
228 ! aortho = S_C0^T * S * C_1
229 CALL parallel_gemm('T', 'N', nocc, nactive, nao, 1.0_dp, s_c0(spin), &
230 evects(ispin, ivect), 0.0_dp, aortho)
231 CALL cp_fm_maxabsval(aortho, maxabs_val)
232 is_nonortho = maxabs_val > max_norm
233 IF (is_nonortho) THEN
234 CALL cp_fm_release(aortho)
235 EXIT loop
236 END IF
237 END DO
238 CALL cp_fm_release(aortho)
239 END DO loop
240
241 CALL timestop(handle)
242
243 END FUNCTION tddfpt_is_nonorthogonal_psi1_psi0
244
245! **************************************************************************************************
246!> \brief Make new TDDFPT trial vectors orthonormal to all previous trial vectors.
247!> \param evects trial vectors (modified on exit)
248!> \param nvects_new number of new trial vectors to orthogonalise
249!> \param S_evects set of matrices to store matrix product S * evects (modified on exit)
250!> \param matrix_s overlap matrix
251!> \par History
252!> * 05.2016 created [Sergey Chulkov]
253!> * 02.2017 caching the matrix product S * evects [Sergey Chulkov]
254!> \note \parblock
255!> Based on the subroutines reorthogonalize() and normalize() which were originally created
256!> by Thomas Chassaing on 03.2003.
257!>
258!> In order to orthogonalise a trial vector C3 = evects(:,3) with respect to previously
259!> orthogonalised vectors C1 = evects(:,1) and C2 = evects(:,2) we need to compute the
260!> quantity C3'' using the following formulae:
261!> C3' = C3 - Tr(C3^T * S * C1) * C1,
262!> C3'' = C3' - Tr(C3'^T * S * C2) * C2,
263!> which can be expanded as:
264!> C3'' = C3 - Tr(C3^T * S * C1) * C1 - Tr(C3^T * S * C2) * C2 +
265!> Tr(C3^T * S * C1) * Tr(C2^T * S * C1) * C2 .
266!> In case of unlimited float-point precision, the last term in above expression is exactly 0,
267!> due to orthogonality condition between C1 and C2. In this case the expression could be
268!> simplified as (taking into account the identity: Tr(A * S * B) = Tr(B * S * A)):
269!> C3'' = C3 - Tr(C1^T * S * C3) * C1 - Tr(C2^T * S * C3) * C2 ,
270!> which means we do not need the variable S_evects to keep the matrix products S * Ci .
271!>
272!> In reality, however, we deal with limited float-point precision arithmetic meaning that
273!> the trace Tr(C2^T * S * C1) is close to 0 but does not equal to 0 exactly. The term
274!> Tr(C3^T * S * C1) * Tr(C2^T * S * C1) * C2
275!> can not be ignored anymore. Ignorance of this term will lead to numerical instability
276!> when the trace Tr(C3^T * S * C1) is large enough.
277!> \endparblock
278! **************************************************************************************************
279 SUBROUTINE tddfpt_orthonormalize_psi1_psi1(evects, nvects_new, S_evects, matrix_s)
280 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: evects
281 INTEGER, INTENT(in) :: nvects_new
282 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: s_evects
283 TYPE(dbcsr_type), POINTER :: matrix_s
284
285 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_orthonormalize_psi1_psi1'
286
287 INTEGER :: handle, ispin, ivect, jvect, nspins, &
288 nvects_old, nvects_total
289 INTEGER, DIMENSION(maxspins) :: nactive
290 REAL(kind=dp) :: norm
291 REAL(kind=dp), DIMENSION(maxspins) :: weights
292
293 CALL timeset(routinen, handle)
294
295 nspins = SIZE(evects, 1)
296 nvects_total = SIZE(evects, 2)
297 nvects_old = nvects_total - nvects_new
298
299 IF (debug_this_module) THEN
300 cpassert(SIZE(s_evects, 1) == nspins)
301 cpassert(SIZE(s_evects, 2) == nvects_total)
302 cpassert(nvects_old >= 0)
303 END IF
304
305 DO ispin = 1, nspins
306 CALL cp_fm_get_info(matrix=evects(ispin, 1), ncol_global=nactive(ispin))
307 END DO
308
309 DO jvect = nvects_old + 1, nvects_total
310 ! Orthogonalization <psi1_i | psi1_j>
311 DO ivect = 1, jvect - 1
312 CALL cp_fm_trace(evects(:, jvect), s_evects(:, ivect), weights(1:nspins), accurate=.false.)
313 norm = sum(weights(1:nspins))
314
315 DO ispin = 1, nspins
316 CALL cp_fm_scale_and_add(1.0_dp, evects(ispin, jvect), -norm, evects(ispin, ivect))
317 END DO
318 END DO
319
320 ! Normalization <psi1_j | psi1_j> = 1
321 DO ispin = 1, nspins
322 CALL cp_dbcsr_sm_fm_multiply(matrix_s, evects(ispin, jvect), s_evects(ispin, jvect), &
323 ncol=nactive(ispin), alpha=1.0_dp, beta=0.0_dp)
324 END DO
325
326 CALL cp_fm_trace(evects(:, jvect), s_evects(:, jvect), weights(1:nspins), accurate=.false.)
327
328 norm = sum(weights(1:nspins))
329 norm = 1.0_dp/sqrt(norm)
330
331 DO ispin = 1, nspins
332 CALL cp_fm_scale(norm, evects(ispin, jvect))
333 CALL cp_fm_scale(norm, s_evects(ispin, jvect))
334 END DO
335 END DO
336
337 CALL timestop(handle)
338
340
341! **************************************************************************************************
342!> \brief Compute action matrix-vector products.
343!> \param Aop_evects action of TDDFPT operator on trial vectors (modified on exit)
344!> \param evects TDDFPT trial vectors
345!> \param S_evects cached matrix product S * evects where S is the overlap matrix
346!> in primary basis set
347!> \param gs_mos molecular orbitals optimised for the ground state
348!> \param tddfpt_control control section for tddfpt
349!> \param matrix_ks Kohn-Sham matrix
350!> \param qs_env Quickstep environment
351!> \param kernel_env kernel environment
352!> \param sub_env parallel (sub)group environment
353!> \param work_matrices collection of work matrices (modified on exit)
354!> \param matrix_s ...
355!> \par History
356!> * 06.2016 created [Sergey Chulkov]
357!> * 03.2017 refactored [Sergey Chulkov]
358! **************************************************************************************************
359 SUBROUTINE tddfpt_compute_aop_evects(Aop_evects, evects, S_evects, gs_mos, tddfpt_control, &
360 matrix_ks, qs_env, kernel_env, &
361 sub_env, work_matrices, matrix_s)
362 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: aop_evects
363 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: evects, s_evects
364 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
365 INTENT(in) :: gs_mos
366 TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
367 TYPE(dbcsr_p_type), DIMENSION(:), INTENT(in) :: matrix_ks
368 TYPE(qs_environment_type), POINTER :: qs_env
369 TYPE(kernel_env_type), INTENT(in) :: kernel_env
370 TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
371 TYPE(tddfpt_work_matrices), INTENT(inout) :: work_matrices
372 TYPE(dbcsr_type), POINTER :: matrix_s
373
374 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_compute_Aop_evects'
375
376 INTEGER :: handle, ispin, ivect, nspins, nvects
377 INTEGER, DIMENSION(maxspins) :: nmo_occ
378 LOGICAL :: do_admm, do_bse, do_hfx, &
379 do_lri_response, is_rks_triplets, &
380 re_int
381 REAL(kind=dp) :: rcut, scale
382 TYPE(cp_fm_type) :: fm_dummy
383 TYPE(full_kernel_env_type), POINTER :: kernel_env_admm_aux
384 TYPE(mp_para_env_type), POINTER :: para_env
385
386 CALL timeset(routinen, handle)
387
388 nspins = SIZE(gs_mos, 1)
389 nvects = SIZE(evects, 2)
390 do_hfx = tddfpt_control%do_hfx
391 do_admm = tddfpt_control%do_admm
392 IF (do_admm) THEN
393 kernel_env_admm_aux => kernel_env%admm_kernel
394 ELSE
395 NULLIFY (kernel_env_admm_aux)
396 END IF
397 is_rks_triplets = tddfpt_control%rks_triplets
398 do_lri_response = tddfpt_control%do_lrigpw
399 do_bse = tddfpt_control%do_bse
400 IF (do_bse) do_hfx = .false.
401
402 IF (debug_this_module) THEN
403 cpassert(nspins > 0)
404 cpassert(SIZE(aop_evects, 1) == SIZE(evects, 1))
405 cpassert(SIZE(s_evects, 1) == SIZE(evects, 1))
406 cpassert(SIZE(aop_evects, 2) == nvects)
407 cpassert(SIZE(s_evects, 2) == nvects)
408 cpassert(SIZE(gs_mos) == nspins)
409 END IF
410
411 DO ispin = 1, nspins
412 nmo_occ(ispin) = SIZE(gs_mos(ispin)%evals_occ)
413 END DO
414
415 IF (nvects > 0) THEN
416 CALL cp_fm_get_info(evects(1, 1), para_env=para_env)
417 IF (ALLOCATED(work_matrices%evects_sub)) THEN
418 DO ivect = 1, nvects
419 DO ispin = 1, SIZE(evects, 1)
420 associate(evect => evects(ispin, ivect), work_matrix => work_matrices%evects_sub(ispin, ivect))
421 IF (ASSOCIATED(evect%matrix_struct)) THEN
422 IF (ASSOCIATED(work_matrix%matrix_struct)) THEN
423 CALL cp_fm_copy_general(evect, work_matrix, para_env)
424 ELSE
425 CALL cp_fm_copy_general(evect, fm_dummy, para_env)
426 END IF
427 ELSE IF (ASSOCIATED(work_matrix%matrix_struct)) THEN
428 CALL cp_fm_copy_general(fm_dummy, work_matrix, para_env)
429 ELSE
430 CALL cp_fm_copy_general(fm_dummy, fm_dummy, para_env)
431 END IF
432 END associate
433 END DO
434 END DO
435 END IF
436
437 IF (tddfpt_control%kernel == tddfpt_kernel_full) THEN
438 ! full TDDFPT kernel
439 CALL fhxc_kernel(aop_evects, evects, is_rks_triplets, do_hfx, do_admm, qs_env, &
440 kernel_env%full_kernel, kernel_env_admm_aux, sub_env, work_matrices, &
441 tddfpt_control%admm_symm, tddfpt_control%admm_xc_correction, &
442 do_lri_response, tddfpt_mgrid=tddfpt_control%mgrid_is_explicit)
443 ELSE IF (tddfpt_control%kernel == tddfpt_kernel_stda) THEN
444 ! sTDA kernel
445 CALL stda_kernel(aop_evects, evects, is_rks_triplets, qs_env, tddfpt_control%stda_control, &
446 kernel_env%stda_kernel, sub_env, work_matrices)
447 ELSE IF (tddfpt_control%kernel == tddfpt_kernel_none) THEN
448 ! No kernel
449 DO ivect = 1, nvects
450 DO ispin = 1, SIZE(evects, 1)
451 CALL cp_fm_set_all(aop_evects(ispin, ivect), 0.0_dp)
452 END DO
453 END DO
454 ELSE
455 cpabort("Kernel type not implemented")
456 END IF
457
458 IF (ALLOCATED(work_matrices%evects_sub)) THEN
459 DO ivect = 1, nvects
460 DO ispin = 1, SIZE(evects, 1)
461 associate(aop_evect => aop_evects(ispin, ivect), &
462 work_matrix => work_matrices%Aop_evects_sub(ispin, ivect))
463 IF (ASSOCIATED(aop_evect%matrix_struct)) THEN
464 IF (ASSOCIATED(work_matrix%matrix_struct)) THEN
465 CALL cp_fm_copy_general(work_matrix, aop_evect, para_env)
466 ELSE
467 CALL cp_fm_copy_general(fm_dummy, aop_evect, para_env)
468 END IF
469 ELSE IF (ASSOCIATED(work_matrix%matrix_struct)) THEN
470 CALL cp_fm_copy_general(work_matrix, fm_dummy, para_env)
471 ELSE
472 CALL cp_fm_copy_general(fm_dummy, fm_dummy, para_env)
473 END IF
474 END associate
475 END DO
476 END DO
477 END IF
478
479 ! orbital energy difference term
480 IF (.NOT. do_bse) THEN
481 CALL tddfpt_apply_energy_diff(aop_evects=aop_evects, evects=evects, s_evects=s_evects, &
482 gs_mos=gs_mos, matrix_ks=matrix_ks, tddfpt_control=tddfpt_control)
483 ELSE
484 CALL zeroth_order_gw(qs_env=qs_env, aop_evects=aop_evects, evects=evects, s_evects=s_evects, &
485 gs_mos=gs_mos, matrix_s=matrix_s, matrix_ks=matrix_ks)
486 END IF
487
488 ! if smeared occupation, then add aCCSX here
489 IF (tddfpt_control%do_smearing) THEN
490 DO ivect = 1, nvects
491 DO ispin = 1, nspins
492 CALL add_smearing_aterm(qs_env, aop_evects(ispin, ivect), evects(ispin, ivect), &
493 s_evects(ispin, ivect), gs_mos(ispin)%mos_occ, &
494 tddfpt_control%smeared_occup(ispin)%fermia, matrix_s)
495 END DO
496 END DO
497 END IF
498
499 IF (do_hfx) THEN
500 IF (tddfpt_control%kernel == tddfpt_kernel_full) THEN
501 ! full TDDFPT kernel
502 CALL tddfpt_apply_hfx(aop_evects=aop_evects, evects=evects, gs_mos=gs_mos, do_admm=do_admm, &
503 qs_env=qs_env, wfm_rho_orb=work_matrices%hfx_fm_ao_ao, &
504 work_hmat_symm=work_matrices%hfx_hmat_symm, &
505 work_hmat_asymm=work_matrices%hfx_hmat_asymm, &
506 work_rho_ia_ao_symm=work_matrices%hfx_rho_ao_symm, &
507 work_rho_ia_ao_asymm=work_matrices%hfx_rho_ao_asymm)
508 ELSE IF (tddfpt_control%kernel == tddfpt_kernel_stda) THEN
509 ! sTDA kernel
510 ! special treatment of HFX term
511 ELSE IF (tddfpt_control%kernel == tddfpt_kernel_none) THEN
512 ! No kernel
513 ! drop kernel contribution of HFX term
514 ELSE
515 cpabort("Kernel type not implemented")
516 END IF
517 END IF
518 ! short/long range HFX
519 IF (tddfpt_control%kernel == tddfpt_kernel_full) THEN
520 IF (tddfpt_control%do_hfxsr) THEN
521 re_int = tddfpt_control%hfxsr_re_int
522 ! symmetric dmat
523 CALL tddfpt_apply_hfxsr_kernel(aop_evects, evects, gs_mos, qs_env, &
524 kernel_env%full_kernel%admm_env, &
525 kernel_env%full_kernel%hfxsr_section, &
526 kernel_env%full_kernel%x_data, 1, re_int, &
527 work_rho_ia_ao=work_matrices%hfxsr_rho_ao_symm, &
528 work_hmat=work_matrices%hfxsr_hmat_symm, &
529 wfm_rho_orb=work_matrices%hfxsr_fm_ao_ao)
530 ! antisymmetric dmat
531 CALL tddfpt_apply_hfxsr_kernel(aop_evects, evects, gs_mos, qs_env, &
532 kernel_env%full_kernel%admm_env, &
533 kernel_env%full_kernel%hfxsr_section, &
534 kernel_env%full_kernel%x_data, -1, .false., &
535 work_rho_ia_ao=work_matrices%hfxsr_rho_ao_asymm, &
536 work_hmat=work_matrices%hfxsr_hmat_asymm, &
537 wfm_rho_orb=work_matrices%hfxsr_fm_ao_ao)
538 tddfpt_control%hfxsr_re_int = .false.
539 END IF
540 IF (tddfpt_control%do_hfxlr) THEN
541 rcut = tddfpt_control%hfxlr_rcut
542 scale = tddfpt_control%hfxlr_scale
543 DO ivect = 1, nvects
544 IF (ALLOCATED(work_matrices%evects_sub)) THEN
545 IF (ASSOCIATED(work_matrices%evects_sub(1, ivect)%matrix_struct)) THEN
546 CALL tddfpt_apply_hfxlr_kernel(qs_env, sub_env, rcut, scale, work_matrices, &
547 work_matrices%evects_sub(:, ivect), &
548 work_matrices%Aop_evects_sub(:, ivect))
549 ELSE
550 ! skip trial vectors which are assigned to different parallel groups
551 cycle
552 END IF
553 ELSE
554 CALL tddfpt_apply_hfxlr_kernel(qs_env, sub_env, rcut, scale, work_matrices, &
555 evects(:, ivect), aop_evects(:, ivect))
556 END IF
557 END DO
558 END IF
559 END IF
560 IF (do_bse) THEN
561 ! add dynamical screening
562 CALL tddfpt_apply_bse(aop_evects=aop_evects, evects=evects, gs_mos=gs_mos, qs_env=qs_env)
563 END IF
564
565 END IF
566
567 CALL timestop(handle)
568
569 END SUBROUTINE tddfpt_compute_aop_evects
570
571! **************************************************************************************************
572!> \brief Solve eigenproblem for the reduced action matrix and find new Ritz eigenvectors and
573!> eigenvalues.
574!> \param ritz_vects Ritz eigenvectors (initialised on exit)
575!> \param Aop_ritz approximate action of TDDFPT operator on Ritz vectors (initialised on exit)
576!> \param evals Ritz eigenvalues (initialised on exit)
577!> \param krylov_vects Krylov's vectors
578!> \param Aop_krylov action of TDDFPT operator on Krylov's vectors
579!> \param Atilde TDDFPT matrix projected into the Krylov's vectors subspace
580!> \param nkvo ...
581!> \param nkvn ...
582!> \par History
583!> * 06.2016 created [Sergey Chulkov]
584!> * 03.2017 altered prototype, OpenMP parallelisation [Sergey Chulkov]
585! **************************************************************************************************
586 SUBROUTINE tddfpt_compute_ritz_vects(ritz_vects, Aop_ritz, evals, krylov_vects, Aop_krylov, &
587 Atilde, nkvo, nkvn)
588 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: ritz_vects, aop_ritz
589 REAL(kind=dp), DIMENSION(:), INTENT(out) :: evals
590 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: krylov_vects, aop_krylov
591 REAL(kind=dp), DIMENSION(:, :), POINTER :: atilde
592 INTEGER, INTENT(IN) :: nkvo, nkvn
593
594 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_compute_ritz_vects'
595
596 INTEGER :: handle, ikv, irv, ispin, nkvs, nrvs, &
597 nspins
598 REAL(kind=dp) :: act
599 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: at12, at21, at22, evects_atilde
600 TYPE(cp_blacs_env_type), POINTER :: blacs_env_global
601 TYPE(cp_fm_struct_type), POINTER :: fm_struct
602 TYPE(cp_fm_type) :: atilde_fm, evects_atilde_fm
603
604 CALL timeset(routinen, handle)
605
606 nspins = SIZE(krylov_vects, 1)
607 nkvs = SIZE(krylov_vects, 2)
608 nrvs = SIZE(ritz_vects, 2)
609 cpassert(nkvs == nkvo + nkvn)
610
611 CALL cp_fm_get_info(krylov_vects(1, 1), context=blacs_env_global)
612
613 CALL cp_fm_struct_create(fm_struct, nrow_global=nkvs, ncol_global=nkvs, context=blacs_env_global)
614 CALL cp_fm_create(atilde_fm, fm_struct)
615 CALL cp_fm_create(evects_atilde_fm, fm_struct)
616 CALL cp_fm_struct_release(fm_struct)
617
618 ! *** compute upper-diagonal reduced action matrix ***
619 CALL reallocate(atilde, 1, nkvs, 1, nkvs)
620 ! TO DO: the subroutine 'cp_fm_contracted_trace' will compute all elements of
621 ! the matrix 'Atilde', however only upper-triangular elements are actually needed
622 !
623 IF (nkvo == 0) THEN
624 CALL cp_fm_contracted_trace(aop_krylov(:, 1:nkvs), krylov_vects(:, 1:nkvs), &
625 atilde(1:nkvs, 1:nkvs), accurate=.false.)
626 ELSE
627 ALLOCATE (at12(nkvn, nkvo), at21(nkvo, nkvn), at22(nkvn, nkvn))
628 CALL cp_fm_contracted_trace(aop_krylov(:, nkvo + 1:nkvs), krylov_vects(:, 1:nkvo), &
629 at12, accurate=.false.)
630 atilde(nkvo + 1:nkvs, 1:nkvo) = at12(1:nkvn, 1:nkvo)
631 CALL cp_fm_contracted_trace(aop_krylov(:, 1:nkvo), krylov_vects(:, nkvo + 1:nkvs), &
632 at21, accurate=.false.)
633 atilde(1:nkvo, nkvo + 1:nkvs) = at21(1:nkvo, 1:nkvn)
634 CALL cp_fm_contracted_trace(aop_krylov(:, nkvo + 1:nkvs), krylov_vects(:, nkvo + 1:nkvs), &
635 at22, accurate=.false.)
636 atilde(nkvo + 1:nkvs, nkvo + 1:nkvs) = at22(1:nkvn, 1:nkvn)
637 DEALLOCATE (at12, at21, at22)
638 END IF
639 atilde = 0.5_dp*(atilde + transpose(atilde))
640 CALL cp_fm_set_submatrix(atilde_fm, atilde)
641
642 ! *** solve an eigenproblem for the reduced matrix ***
643 CALL choose_eigv_solver(atilde_fm, evects_atilde_fm, evals(1:nkvs))
644
645 ALLOCATE (evects_atilde(nkvs, nrvs))
646 CALL cp_fm_get_submatrix(evects_atilde_fm, evects_atilde, start_row=1, start_col=1, n_rows=nkvs, n_cols=nrvs)
647 CALL cp_fm_release(evects_atilde_fm)
648 CALL cp_fm_release(atilde_fm)
649
650!$OMP PARALLEL DO DEFAULT(NONE), &
651!$OMP PRIVATE(act, ikv, irv, ispin), &
652!$OMP SHARED(Aop_krylov, Aop_ritz, krylov_vects, evects_Atilde, nkvs, nrvs, nspins, ritz_vects)
653 DO irv = 1, nrvs
654 DO ispin = 1, nspins
655 CALL cp_fm_set_all(ritz_vects(ispin, irv), 0.0_dp)
656 CALL cp_fm_set_all(aop_ritz(ispin, irv), 0.0_dp)
657 END DO
658
659 DO ikv = 1, nkvs
660 act = evects_atilde(ikv, irv)
661 DO ispin = 1, nspins
662 CALL cp_fm_scale_and_add(1.0_dp, ritz_vects(ispin, irv), &
663 act, krylov_vects(ispin, ikv))
664 CALL cp_fm_scale_and_add(1.0_dp, aop_ritz(ispin, irv), &
665 act, aop_krylov(ispin, ikv))
666 END DO
667 END DO
668 END DO
669!$OMP END PARALLEL DO
670
671 DEALLOCATE (evects_atilde)
672
673 CALL timestop(handle)
674
675 END SUBROUTINE tddfpt_compute_ritz_vects
676
677! **************************************************************************************************
678!> \brief Expand Krylov space by computing residual vectors.
679!> \param residual_vects residual vectors (modified on exit)
680!> \param evals Ritz eigenvalues (modified on exit)
681!> \param ritz_vects Ritz eigenvectors
682!> \param Aop_ritz approximate action of TDDFPT operator on Ritz vectors
683!> \param gs_mos molecular orbitals optimised for the ground state
684!> \param matrix_s overlap matrix
685!> \param tddfpt_control ...
686!> \par History
687!> * 06.2016 created [Sergey Chulkov]
688!> * 03.2017 refactored to achieve significant performance gain [Sergey Chulkov]
689! **************************************************************************************************
690 SUBROUTINE tddfpt_compute_residual_vects(residual_vects, evals, ritz_vects, Aop_ritz, gs_mos, &
691 matrix_s, tddfpt_control)
692 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: residual_vects
693 REAL(kind=dp), DIMENSION(:), INTENT(in) :: evals
694 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: ritz_vects, aop_ritz
695 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
696 INTENT(in) :: gs_mos
697 TYPE(dbcsr_type), POINTER :: matrix_s
698 TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
699
700 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_compute_residual_vects'
701 REAL(kind=dp), PARAMETER :: eref_scale = 0.99_dp, threshold = 16.0_dp*epsilon(1.0_dp)
702
703 INTEGER :: handle, icol_local, irow_local, irv, &
704 ispin, nao, ncols_local, nrows_local, &
705 nrvs, nspins, spin2, spinflip
706 INTEGER, DIMENSION(:), POINTER :: col_indices_local, row_indices_local
707 INTEGER, DIMENSION(maxspins) :: nactive, nmo_virt
708 REAL(kind=dp) :: e_occ_plus_lambda, eref, lambda
709 REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :), &
710 POINTER :: weights_ldata
711 TYPE(cp_fm_struct_type), POINTER :: ao_mo_struct, virt_mo_struct
712 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: awork, vomat
713
714 CALL timeset(routinen, handle)
715
716 nspins = SIZE(residual_vects, 1)
717 nrvs = SIZE(residual_vects, 2)
718 spinflip = tddfpt_control%spinflip
719
720 IF (nrvs > 0) THEN
721 CALL dbcsr_get_info(matrix_s, nfullrows_total=nao)
722 ALLOCATE (awork(nspins), vomat(nspins))
723 DO ispin = 1, nspins
724 IF (spinflip == no_sf_tddfpt) THEN
725 spin2 = ispin
726 ELSE
727 spin2 = 2
728 END IF
729 nmo_virt(spin2) = SIZE(gs_mos(spin2)%evals_virt)
730 !
731 CALL cp_fm_get_info(matrix=ritz_vects(ispin, 1), matrix_struct=ao_mo_struct, &
732 ncol_global=nactive(ispin))
733 CALL cp_fm_create(awork(ispin), ao_mo_struct)
734 !
735 CALL cp_fm_struct_create(virt_mo_struct, nrow_global=nmo_virt(spin2), &
736 ncol_global=nactive(ispin), template_fmstruct=ao_mo_struct)
737 CALL cp_fm_create(vomat(ispin), virt_mo_struct)
738 CALL cp_fm_struct_release(virt_mo_struct)
739 END DO
740
741 ! *** actually compute residual vectors ***
742 DO irv = 1, nrvs
743 lambda = evals(irv)
744
745 DO ispin = 1, nspins
746 IF (spinflip == no_sf_tddfpt) THEN
747 spin2 = ispin
748 ELSE
749 spin2 = 2
750 END IF
751 CALL cp_fm_get_info(vomat(ispin), nrow_local=nrows_local, &
752 ncol_local=ncols_local, row_indices=row_indices_local, &
753 col_indices=col_indices_local, local_data=weights_ldata)
754
755 ! awork := Ab(ispin, irv) - evals(irv) b(ispin, irv), where 'b' is a Ritz vector
756 CALL cp_dbcsr_sm_fm_multiply(matrix_s, ritz_vects(ispin, irv), awork(ispin), &
757 ncol=nactive(ispin), alpha=-lambda, beta=0.0_dp)
758 CALL cp_fm_scale_and_add(1.0_dp, awork(ispin), 1.0_dp, aop_ritz(ispin, irv))
759 !
760 CALL parallel_gemm('T', 'N', nmo_virt(spin2), nactive(ispin), nao, 1.0_dp, gs_mos(spin2)%mos_virt, &
761 awork(ispin), 0.0_dp, vomat(ispin))
762
763 ! Apply Davidson preconditioner to the residue vectors vomat to obtain new directions
764 DO icol_local = 1, ncols_local
765 e_occ_plus_lambda = gs_mos(ispin)%evals_occ(col_indices_local(icol_local)) + lambda
766
767 DO irow_local = 1, nrows_local
768 eref = gs_mos(spin2)%evals_virt(row_indices_local(irow_local)) - e_occ_plus_lambda
769
770 ! eref = e_virt - e_occ - lambda = e_virt - e_occ - (eref_scale*lambda + (1-eref_scale)*lambda);
771 ! eref_new = e_virt - e_occ - eref_scale*lambda = eref + (1 - eref_scale)*lambda
772 IF (abs(eref) < threshold) &
773 eref = eref + (1.0_dp - eref_scale)*lambda
774
775 weights_ldata(irow_local, icol_local) = weights_ldata(irow_local, icol_local)/eref
776 END DO
777 END DO
778
779 CALL parallel_gemm('N', 'N', nao, nactive(ispin), nmo_virt(spin2), 1.0_dp, gs_mos(spin2)%mos_virt, &
780 vomat(ispin), 0.0_dp, residual_vects(ispin, irv))
781 END DO
782 END DO
783 !
784 CALL cp_fm_release(awork)
785 CALL cp_fm_release(vomat)
786 END IF
787
788 CALL timestop(handle)
789
790 END SUBROUTINE tddfpt_compute_residual_vects
791
792! **************************************************************************************************
793!> \brief Perform Davidson iterations.
794!> \param evects TDDFPT trial vectors (modified on exit)
795!> \param evals TDDFPT eigenvalues (modified on exit)
796!> \param S_evects cached matrix product S * evects (modified on exit)
797!> \param gs_mos molecular orbitals optimised for the ground state
798!> \param tddfpt_control TDDFPT control parameters
799!> \param matrix_ks Kohn-Sham matrix
800!> \param qs_env Quickstep environment
801!> \param kernel_env kernel environment
802!> \param sub_env parallel (sub)group environment
803!> \param logger CP2K logger
804!> \param iter_unit I/O unit to write basic iteration information
805!> \param energy_unit I/O unit to write detailed energy information
806!> \param tddfpt_print_section TDDFPT print input section (need to write TDDFPT restart files)
807!> \param work_matrices collection of work matrices (modified on exit)
808!> \return energy convergence achieved (in Hartree)
809!> \par History
810!> * 03.2017 code related to Davidson eigensolver has been moved here from the main subroutine
811!> tddfpt() [Sergey Chulkov]
812!> \note Based on the subroutines apply_op() and iterative_solver() originally created by
813!> Thomas Chassaing in 2002.
814! **************************************************************************************************
815 FUNCTION tddfpt_davidson_solver(evects, evals, S_evects, gs_mos, tddfpt_control, &
816 matrix_ks, qs_env, kernel_env, &
817 sub_env, logger, iter_unit, energy_unit, &
818 tddfpt_print_section, work_matrices) RESULT(conv)
819 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(inout) :: evects
820 REAL(kind=dp), DIMENSION(:), INTENT(inout) :: evals
821 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(inout) :: s_evects
822 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
823 INTENT(in) :: gs_mos
824 TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
825 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks
826 TYPE(qs_environment_type), POINTER :: qs_env
827 TYPE(kernel_env_type), INTENT(in) :: kernel_env
828 TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
829 TYPE(cp_logger_type), POINTER :: logger
830 INTEGER, INTENT(in) :: iter_unit, energy_unit
831 TYPE(section_vals_type), POINTER :: tddfpt_print_section
832 TYPE(tddfpt_work_matrices), INTENT(inout) :: work_matrices
833 REAL(kind=dp) :: conv
834
835 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_davidson_solver'
836
837 INTEGER :: handle, ispin, istate, iter, &
838 max_krylov_vects, nspins, nstates, &
839 nstates_conv, nvects_exist, nvects_new
840 INTEGER(kind=int_8) :: nstates_total
841 LOGICAL :: is_nonortho
842 REAL(kind=dp) :: t1, t2
843 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: evals_last
844 REAL(kind=dp), DIMENSION(:, :), POINTER :: atilde
845 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:, :) :: aop_krylov, aop_ritz, krylov_vects, &
846 s_krylov
847 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
848
849 CALL timeset(routinen, handle)
850
851 nspins = SIZE(evects, 1)
852 nstates = tddfpt_control%nstates
853 nstates_total = tddfpt_total_number_of_states(tddfpt_control, gs_mos)
854
855 IF (debug_this_module) THEN
856 cpassert(SIZE(evects, 1) == nspins)
857 cpassert(SIZE(evects, 2) == nstates)
858 cpassert(SIZE(evals) == nstates)
859 END IF
860
861 CALL get_qs_env(qs_env, matrix_s=matrix_s)
862
863 ! adjust the number of Krylov vectors
864 max_krylov_vects = min(max(tddfpt_control%nkvs, nstates), int(nstates_total))
865
866 ALLOCATE (aop_ritz(nspins, nstates))
867 DO istate = 1, nstates
868 DO ispin = 1, nspins
869 CALL fm_pool_create_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, aop_ritz(ispin, istate))
870 END DO
871 END DO
872
873 ALLOCATE (evals_last(max_krylov_vects))
874 ALLOCATE (aop_krylov(nspins, max_krylov_vects), krylov_vects(nspins, max_krylov_vects), &
875 s_krylov(nspins, max_krylov_vects))
876
877 DO istate = 1, nstates
878 DO ispin = 1, nspins
879 CALL fm_pool_create_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, krylov_vects(ispin, istate))
880 CALL cp_fm_to_fm(evects(ispin, istate), krylov_vects(ispin, istate))
881
882 CALL fm_pool_create_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, s_krylov(ispin, istate))
883 CALL cp_fm_to_fm(s_evects(ispin, istate), s_krylov(ispin, istate))
884
885 CALL fm_pool_create_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, aop_krylov(ispin, istate))
886 END DO
887 END DO
888
889 nvects_exist = 0
890 nvects_new = nstates
891
892 t1 = m_walltime()
893
894 ALLOCATE (atilde(1, 1))
895
896 DO
897 ! davidson iteration
898 CALL cp_iterate(logger%iter_info, iter_nr_out=iter)
899
900 ! Matrix-vector operations
901 CALL tddfpt_compute_aop_evects(aop_evects=aop_krylov(:, nvects_exist + 1:nvects_exist + nvects_new), &
902 evects=krylov_vects(:, nvects_exist + 1:nvects_exist + nvects_new), &
903 s_evects=s_krylov(:, nvects_exist + 1:nvects_exist + nvects_new), &
904 gs_mos=gs_mos, tddfpt_control=tddfpt_control, &
905 matrix_ks=matrix_ks, &
906 qs_env=qs_env, kernel_env=kernel_env, &
907 sub_env=sub_env, &
908 work_matrices=work_matrices, &
909 matrix_s=matrix_s(1)%matrix)
910
911 CALL tddfpt_compute_ritz_vects(ritz_vects=evects, aop_ritz=aop_ritz, &
912 evals=evals_last(1:nvects_exist + nvects_new), &
913 krylov_vects=krylov_vects(:, 1:nvects_exist + nvects_new), &
914 aop_krylov=aop_krylov(:, 1:nvects_exist + nvects_new), &
915 atilde=atilde, nkvo=nvects_exist, nkvn=nvects_new)
916
917 CALL tddfpt_write_restart(evects=evects, evals=evals_last(1:nstates), gs_mos=gs_mos, &
918 logger=logger, tddfpt_print_section=tddfpt_print_section)
919
920 conv = maxval(abs(evals_last(1:nstates) - evals(1:nstates)))
921
922 nvects_exist = nvects_exist + nvects_new
923 IF (nvects_exist + nvects_new > max_krylov_vects) &
924 nvects_new = max_krylov_vects - nvects_exist
925 IF (iter >= tddfpt_control%niters) nvects_new = 0
926
927 IF (conv > tddfpt_control%conv .AND. nvects_new > 0) THEN
928 ! compute residual vectors for the next iteration
929 DO istate = 1, nvects_new
930 DO ispin = 1, nspins
931 CALL fm_pool_create_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, &
932 krylov_vects(ispin, nvects_exist + istate))
933 CALL fm_pool_create_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, &
934 s_krylov(ispin, nvects_exist + istate))
935 CALL fm_pool_create_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, &
936 aop_krylov(ispin, nvects_exist + istate))
937 END DO
938 END DO
939
940 CALL tddfpt_compute_residual_vects(residual_vects=krylov_vects(:, nvects_exist + 1:nvects_exist + nvects_new), &
941 evals=evals_last(1:nvects_new), &
942 ritz_vects=evects(:, 1:nvects_new), aop_ritz=aop_ritz(:, 1:nvects_new), &
943 gs_mos=gs_mos, matrix_s=matrix_s(1)%matrix, tddfpt_control=tddfpt_control)
944
945 CALL tddfpt_orthogonalize_psi1_psi0(krylov_vects(:, nvects_exist + 1:nvects_exist + nvects_new), &
946 work_matrices%S_C0_C0T, qs_env, &
947 gs_mos, evals(1:nstates), tddfpt_control, work_matrices%S_C0)
948
949 CALL tddfpt_orthonormalize_psi1_psi1(krylov_vects(:, 1:nvects_exist + nvects_new), nvects_new, &
950 s_krylov(:, 1:nvects_exist + nvects_new), matrix_s(1)%matrix)
951
952 is_nonortho = tddfpt_is_nonorthogonal_psi1_psi0(krylov_vects(:, nvects_exist + 1:nvects_exist + nvects_new), &
953 work_matrices%S_C0, tddfpt_control%orthogonal_eps, &
954 tddfpt_control%spinflip)
955 ELSE
956 ! convergence or the maximum number of Krylov vectors have been achieved
957 nvects_new = 0
958 is_nonortho = .false.
959 END IF
960
961 t2 = m_walltime()
962 IF (energy_unit > 0) THEN
963 WRITE (energy_unit, '(/,4X,A,T14,A,T36,A)') "State", "Exc. energy (eV)", "Convergence (eV)"
964 DO istate = 1, nstates
965 WRITE (energy_unit, '(1X,I8,T12,F14.7,T38,ES11.4)') istate, &
966 evals_last(istate)*evolt, (evals_last(istate) - evals(istate))*evolt
967 END DO
968 WRITE (energy_unit, *)
969 CALL m_flush(energy_unit)
970 END IF
971
972 IF (iter_unit > 0) THEN
973 nstates_conv = 0
974 DO istate = 1, nstates
975 IF (abs(evals_last(istate) - evals(istate)) <= tddfpt_control%conv) &
976 nstates_conv = nstates_conv + 1
977 END DO
978
979 WRITE (iter_unit, '(T7,I8,T24,F7.1,T40,ES11.4,T66,I8)') iter, t2 - t1, conv, nstates_conv
980 CALL m_flush(iter_unit)
981 END IF
982
983 t1 = t2
984 evals(1:nstates) = evals_last(1:nstates)
985
986 ! nvects_new == 0 if iter >= tddfpt_control%niters
987 IF (nvects_new == 0 .OR. is_nonortho) THEN
988 ! restart Davidson iterations
989 CALL tddfpt_orthogonalize_psi1_psi0(evects, work_matrices%S_C0_C0T, qs_env, &
990 gs_mos, &
991 evals(1:nstates), tddfpt_control, work_matrices%S_C0)
992 CALL tddfpt_orthonormalize_psi1_psi1(evects, nstates, s_evects, matrix_s(1)%matrix)
993
994 EXIT
995 END IF
996 END DO
997
998 DEALLOCATE (atilde)
999
1000 DO istate = nvects_exist + nvects_new, 1, -1
1001 DO ispin = nspins, 1, -1
1002 CALL fm_pool_give_back_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, aop_krylov(ispin, istate))
1003 CALL fm_pool_give_back_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, s_krylov(ispin, istate))
1004 CALL fm_pool_give_back_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, krylov_vects(ispin, istate))
1005 END DO
1006 END DO
1007 DEALLOCATE (aop_krylov, krylov_vects, s_krylov)
1008 DEALLOCATE (evals_last)
1009
1010 DO istate = nstates, 1, -1
1011 DO ispin = nspins, 1, -1
1012 CALL fm_pool_give_back_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, aop_ritz(ispin, istate))
1013 END DO
1014 END DO
1015 DEALLOCATE (aop_ritz)
1016
1017 CALL timestop(handle)
1018
1019 END FUNCTION tddfpt_davidson_solver
1020
1021END MODULE qs_tddfpt2_eigensolver
methods related to the blacs parallel environment
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
subroutine, public dbcsr_get_info(matrix, nblkrows_total, nblkcols_total, nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, nfullrows_local, nfullcols_local, my_prow, my_pcol, local_rows, local_cols, proc_row_dist, proc_col_dist, row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, distribution, name, matrix_type, group)
...
DBCSR operations in CP2K.
subroutine, public cp_dbcsr_sm_fm_multiply(matrix, fm_in, fm_out, ncol, alpha, beta)
multiply a dbcsr with a fm matrix
Basic linear algebra operations for full matrices.
subroutine, public cp_fm_scale_and_add(alpha, matrix_a, beta, matrix_b)
calc A <- alpha*A + beta*B optimized for alpha == 1.0 (just add beta*B) and beta == 0....
subroutine, public cp_fm_scale(alpha, matrix_a)
scales a matrix matrix_a = alpha * matrix_b
used for collecting some of the diagonalization schemes available for cp_fm_type. cp_fm_power also mo...
Definition cp_fm_diag.F:17
subroutine, public choose_eigv_solver(matrix, eigenvectors, eigenvalues, info)
Choose the Eigensolver depending on which library is available ELPA seems to be unstable for small sy...
Definition cp_fm_diag.F:234
pool for for elements that are retained and released
subroutine, public fm_pool_create_fm(pool, element, name)
returns an element, allocating it if none is in the pool
subroutine, public fm_pool_give_back_fm(pool, element)
returns the element to the pool
represent the structure of a full matrix
subroutine, public cp_fm_struct_create(fmstruct, para_env, context, nrow_global, ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, local_leading_dimension, template_fmstruct, square_blocks, force_block)
allocates and initializes a full matrix structure
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
subroutine, public cp_fm_copy_general(source, destination, para_env)
General copy of a fm matrix to another fm matrix. Uses non-blocking MPI rather than ScaLAPACK.
subroutine, public cp_fm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, nrow_locals, ncol_locals, matrix_struct, para_env)
returns all kind of information about the full matrix
subroutine, public cp_fm_set_submatrix(fm, new_values, start_row, start_col, n_rows, n_cols, alpha, beta, transpose)
sets a submatrix of a full matrix fm(start_row:start_row+n_rows,start_col:start_col+n_cols) = alpha*o...
subroutine, public cp_fm_maxabsval(matrix, a_max, ir_max, ic_max)
find the maximum absolute value of the matrix element maxval(abs(matrix))
subroutine, public cp_fm_set_all(matrix, alpha, beta)
set all elements of a matrix to the same value, and optionally the diagonal to a different one
subroutine, public cp_fm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_cols, transpose)
gets a submatrix of a full matrix op(target_m)(1:n_rows,1:n_cols) =fm(start_row:start_row+n_rows,...
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp)
creates a new full matrix with the given structure
various routines to log and control the output. The idea is that decisions about where to log should ...
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
subroutine, public cp_iterate(iteration_info, last, iter_nr, increment, iter_nr_out)
adds one to the actual iteration
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public tddfpt_kernel_none
integer, parameter, public tddfpt_kernel_full
integer, parameter, public tddfpt_kernel_stda
integer, parameter, public no_sf_tddfpt
objects that represent the structure of input sections and the data contained in an input section
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public int_8
Definition kinds.F:54
integer, parameter, public dp
Definition kinds.F:34
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition machine.F:136
real(kind=dp) function, public m_walltime()
returns time from a real-time clock, protected against rolling early/easily
Definition machine.F:153
Utility routines for the memory handling.
Interface to the message passing library MPI.
basic linear algebra operations for full matrixes
Definition of physical constants:
Definition physcon.F:68
real(kind=dp), parameter, public evolt
Definition physcon.F:183
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
groups fairly general SCF methods, so that modules other than qs_scf can use them too split off from ...
subroutine, public eigensolver(matrix_ks_fm, mo_set, ortho, work, cholesky_method, do_level_shift, level_shift, matrix_u_fm, use_jacobi)
Diagonalise the Kohn-Sham matrix to get a new set of MO eigen- vectors and MO eigenvalues....
subroutine, public zeroth_order_gw(qs_env, aop_evects, evects, s_evects, gs_mos, matrix_s, matrix_ks)
...
subroutine, public tddfpt_apply_bse(aop_evects, evects, gs_mos, qs_env)
Update action of TDDFPT operator on trial vectors by adding BSE W term.
subroutine, public tddfpt_orthonormalize_psi1_psi1(evects, nvects_new, s_evects, matrix_s)
Make new TDDFPT trial vectors orthonormal to all previous trial vectors.
subroutine, public tddfpt_orthogonalize_psi1_psi0(evects, s_c0_c0t, qs_env, gs_mos, evals, tddfpt_control, s_c0)
Make TDDFPT trial vectors orthogonal to all occupied molecular orbitals.
real(kind=dp) function, public tddfpt_davidson_solver(evects, evals, s_evects, gs_mos, tddfpt_control, matrix_ks, qs_env, kernel_env, sub_env, logger, iter_unit, energy_unit, tddfpt_print_section, work_matrices)
Perform Davidson iterations.
subroutine, public fhxc_kernel(aop_evects, evects, is_rks_triplets, do_hfx, do_admm, qs_env, kernel_env, kernel_env_admm_aux, sub_env, work_matrices, admm_symm, admm_xc_correction, do_lrigpw, tddfpt_mgrid)
Compute action matrix-vector products with the FHxc Kernel.
subroutine, public stda_kernel(aop_evects, evects, is_rks_triplets, qs_env, stda_control, stda_env, sub_env, work_matrices)
Compute action matrix-vector products with the sTDA Kernel.
subroutine, public tddfpt_apply_hfx(aop_evects, evects, gs_mos, do_admm, qs_env, work_rho_ia_ao_symm, work_hmat_symm, work_rho_ia_ao_asymm, work_hmat_asymm, wfm_rho_orb)
Update action of TDDFPT operator on trial vectors by adding exact-exchange term.
subroutine, public tddfpt_apply_energy_diff(aop_evects, evects, s_evects, gs_mos, matrix_ks, tddfpt_control)
Apply orbital energy difference term: Aop_evects(spin,state) += KS(spin) * evects(spin,...
subroutine, public tddfpt_apply_hfxlr_kernel(qs_env, sub_env, rcut, hfx_scale, work, x, res)
...Calculate the HFXLR kernel contribution by contracting the Lowdin MO coefficients – transition cha...
subroutine, public tddfpt_apply_hfxsr_kernel(aop_evects, evects, gs_mos, qs_env, admm_env, hfx_section, x_data, symmetry, recalc_integrals, work_rho_ia_ao, work_hmat, wfm_rho_orb)
Update action of TDDFPT operator on trial vectors by adding exact-exchange term.
subroutine, public tddfpt_write_restart(evects, evals, gs_mos, logger, tddfpt_print_section)
Write Ritz vectors to a binary restart file.
subroutine, public add_smearing_aterm(qs_env, aop_evects, evects, s_evects, mos_occ, fermia, matrix_s)
...
subroutine, public compute_fermib(qs_env, gs_mos, evals)
...
subroutine, public orthogonalize_smeared_occupation(evects, qs_env, mos_occ, s_c0)
...
pure integer(kind=int_8) function, public tddfpt_total_number_of_states(tddfpt_control, gs_mos)
Compute the number of possible singly excited states (occ -> virt)
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
keeps the information about the structure of a full matrix
represent a full matrix
type of a logger, at the moment it contains just a print level starting at which level it should be l...
stores all the informations relevant to an mpi environment
Collection of variables required to evaluate adiabatic TDDFPT kernel.
Type to hold environments for the different kernels.
Ground state molecular orbitals.
Set of temporary ("work") matrices.