(git:e966546)
Loading...
Searching...
No Matches
qs_tddfpt2_forces.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
9 USE admm_types, ONLY: admm_type,&
14 USE bibliography, ONLY: sertcan2024,&
15 cite_reference
18 USE cp_dbcsr_api, ONLY: &
20 dbcsr_release, dbcsr_scale, dbcsr_set, dbcsr_type, dbcsr_type_antisymmetric
49 USE hfx_ri, ONLY: hfx_ri_update_ks
50 USE hfx_types, ONLY: hfx_type
53 oe_shift,&
62 USE kinds, ONLY: default_string_length,&
63 dp
65 USE mulliken, ONLY: ao_charges
68 USE pw_env_types, ONLY: pw_env_get,&
70 USE pw_methods, ONLY: pw_axpy,&
71 pw_scale,&
77 USE pw_types, ONLY: pw_c1d_gs_type,&
91 USE qs_fxc, ONLY: qs_fxc_analytic,&
94 USE qs_integrate_potential, ONLY: integrate_v_rspace
96 USE qs_kind_types, ONLY: get_qs_kind,&
99 USE qs_ks_atom, ONLY: update_ks_atom
102 USE qs_ks_types, ONLY: qs_ks_env_type
106 USE qs_mo_types, ONLY: get_mo_set,&
113 USE qs_rho0_methods, ONLY: init_rho0
118 USE qs_rho_types, ONLY: qs_rho_create,&
119 qs_rho_get,&
120 qs_rho_set,&
130 USE xtb_types, ONLY: get_xtb_atom_param,&
132#include "./base/base_uses.f90"
133
134 IMPLICIT NONE
135
136 PRIVATE
137
138 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_tddfpt2_forces'
139
140 PUBLIC :: tddfpt_forces_main
141
142! **************************************************************************************************
143
144CONTAINS
145
146! **************************************************************************************************
147!> \brief Perform TDDFPT gradient calculation. This routine calculates the response vector R of Eq. 49
148!> in J. Chem. Theory Comput. 2022, 18, 4186−4202 (https://doi.org/10.1021/acs.jctc.2c00144)
149!> in ex_env%cpmos and a few contributions to the gradient.
150!> \param qs_env Quickstep environment
151!> \param gs_mos ...
152!> \param ex_env Holds: Response vector ex_env%cpmos = R
153!> Difference density ex_env%matrix_pe = T
154!> Matrix ex_env%matrix_hz = H_munu[T]
155!> \param kernel_env ...
156!> \param sub_env ...
157!> \param work_matrices ...
158!> \par History
159!> * 10.2022 created JHU
160! **************************************************************************************************
161 SUBROUTINE tddfpt_forces_main(qs_env, gs_mos, ex_env, kernel_env, sub_env, work_matrices)
162 TYPE(qs_environment_type), POINTER :: qs_env
163 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
164 POINTER :: gs_mos
165 TYPE(excited_energy_type), POINTER :: ex_env
166 TYPE(kernel_env_type) :: kernel_env
167 TYPE(tddfpt_subgroup_env_type) :: sub_env
168 TYPE(tddfpt_work_matrices) :: work_matrices
169
170 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_forces_main'
171
172 INTEGER :: handle, ispin, nspins, spin
173 LOGICAL :: do_sf
174 TYPE(admm_type), POINTER :: admm_env
175 TYPE(cp_fm_struct_type), POINTER :: matrix_struct
176 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_pe_asymm, matrix_pe_symm, &
177 matrix_s, matrix_s_aux_fit
178 TYPE(dft_control_type), POINTER :: dft_control
179 TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
180
181 CALL timeset(routinen, handle)
182
183 CALL get_qs_env(qs_env, dft_control=dft_control)
184
185 IF (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc) CALL cite_reference(sertcan2024)
186
187 nspins = dft_control%nspins
188 tddfpt_control => dft_control%tddfpt2_control
189 IF (tddfpt_control%spinflip .EQ. no_sf_tddfpt) THEN
190 do_sf = .false.
191 ELSE
192 do_sf = .true.
193 END IF
194 ! rhs of linres equation
195 IF (ASSOCIATED(ex_env%cpmos)) THEN
196 DO ispin = 1, SIZE(ex_env%cpmos)
197 CALL cp_fm_release(ex_env%cpmos(ispin))
198 END DO
199 DEALLOCATE (ex_env%cpmos)
200 END IF
201 ALLOCATE (ex_env%cpmos(nspins))
202 ! Create and initialize rectangular matrices of nao*occ dimension for alpha and beta R vectors
203 ! for the Z-vector equation system: AZ=-R
204 DO ispin = 1, nspins
205 CALL cp_fm_get_info(gs_mos(ispin)%mos_occ, matrix_struct=matrix_struct)
206 CALL cp_fm_create(ex_env%cpmos(ispin), matrix_struct)
207 CALL cp_fm_set_all(ex_env%cpmos(ispin), 0.0_dp)
208 END DO
209 CALL get_qs_env(qs_env=qs_env, matrix_s=matrix_s)
210 NULLIFY (matrix_pe_asymm, matrix_pe_symm)
211
212 ! Build difference density matrix_pe = X*X^T - (C*X^T*S*X*C^T + (C*X^T*S*X*C^T)^T)/2
213 !
214 CALL dbcsr_allocate_matrix_set(ex_env%matrix_pe, nspins)
215 CALL dbcsr_allocate_matrix_set(matrix_pe_symm, nspins)
216 CALL dbcsr_allocate_matrix_set(matrix_pe_asymm, nspins)
217 DO ispin = 1, nspins
218
219 ! Initialize matrix_pe as a sparse matrix with zeros
220 ALLOCATE (ex_env%matrix_pe(ispin)%matrix)
221 CALL dbcsr_create(ex_env%matrix_pe(ispin)%matrix, template=matrix_s(1)%matrix)
222 CALL dbcsr_copy(ex_env%matrix_pe(ispin)%matrix, matrix_s(1)%matrix)
223 CALL dbcsr_set(ex_env%matrix_pe(ispin)%matrix, 0.0_dp)
224
225 ALLOCATE (matrix_pe_symm(ispin)%matrix)
226 CALL dbcsr_create(matrix_pe_symm(ispin)%matrix, template=matrix_s(1)%matrix)
227 CALL dbcsr_copy(matrix_pe_symm(ispin)%matrix, ex_env%matrix_pe(ispin)%matrix)
228
229 ALLOCATE (matrix_pe_asymm(ispin)%matrix)
230 CALL dbcsr_create(matrix_pe_asymm(ispin)%matrix, template=matrix_s(1)%matrix, &
231 matrix_type=dbcsr_type_antisymmetric)
232 CALL dbcsr_complete_redistribute(ex_env%matrix_pe(ispin)%matrix, matrix_pe_asymm(ispin)%matrix)
233
234 IF (do_sf) THEN
235 spin = 1
236 ELSE
237 spin = ispin
238 END IF
239 ! Add difference density to matrix_pe
240 CALL tddfpt_resvec1(ex_env%evect(spin), gs_mos(spin)%mos_occ, &
241 matrix_s(1)%matrix, ex_env%matrix_pe(ispin)%matrix, ispin, do_sf)
242 END DO
243 !
244 ! Project the difference density into auxiliary basis for ADMM
245 IF (dft_control%do_admm) THEN
246 CALL get_qs_env(qs_env, admm_env=admm_env)
247 CALL get_admm_env(admm_env, matrix_s_aux_fit=matrix_s_aux_fit)
248 CALL dbcsr_allocate_matrix_set(ex_env%matrix_pe_admm, nspins)
249 DO ispin = 1, nspins
250 ALLOCATE (ex_env%matrix_pe_admm(ispin)%matrix)
251 CALL dbcsr_create(ex_env%matrix_pe_admm(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix)
252 CALL dbcsr_copy(ex_env%matrix_pe_admm(ispin)%matrix, matrix_s_aux_fit(1)%matrix)
253 CALL dbcsr_set(ex_env%matrix_pe_admm(ispin)%matrix, 0.0_dp)
254 CALL tddfpt_resvec1_admm(ex_env%matrix_pe(ispin)%matrix, &
255 admm_env, ex_env%matrix_pe_admm(ispin)%matrix)
256 END DO
257 END IF
258 !
259
260 CALL dbcsr_allocate_matrix_set(ex_env%matrix_hz, nspins)
261 DO ispin = 1, nspins
262 ALLOCATE (ex_env%matrix_hz(ispin)%matrix)
263 CALL dbcsr_create(ex_env%matrix_hz(ispin)%matrix, template=matrix_s(1)%matrix)
264 CALL dbcsr_copy(ex_env%matrix_hz(ispin)%matrix, matrix_s(1)%matrix)
265 CALL dbcsr_set(ex_env%matrix_hz(ispin)%matrix, 0.0_dp)
266 END DO
267 ! Calculate first term of R vector: H_{\mu i\sigma}[T]
268 IF (dft_control%qs_control%xtb) THEN
269 CALL tddfpt_resvec2_xtb(qs_env, ex_env%matrix_pe, gs_mos, ex_env%matrix_hz, ex_env%cpmos)
270 ELSE
271 CALL tddfpt_resvec2(qs_env, ex_env%matrix_pe, ex_env%matrix_pe_admm, &
272 gs_mos, ex_env%matrix_hz, ex_env%cpmos)
273 END IF
274 !
275 CALL dbcsr_allocate_matrix_set(ex_env%matrix_px1, SIZE(ex_env%evect, 1))
276 CALL dbcsr_allocate_matrix_set(ex_env%matrix_px1_asymm, SIZE(ex_env%evect, 1))
277 DO ispin = 1, SIZE(ex_env%evect, 1)
278 ALLOCATE (ex_env%matrix_px1(ispin)%matrix)
279 CALL dbcsr_create(ex_env%matrix_px1(ispin)%matrix, template=matrix_s(1)%matrix)
280 CALL dbcsr_copy(ex_env%matrix_px1(ispin)%matrix, matrix_s(1)%matrix)
281 CALL dbcsr_set(ex_env%matrix_px1(ispin)%matrix, 0.0_dp)
282
283 ALLOCATE (ex_env%matrix_px1_asymm(ispin)%matrix)
284 CALL dbcsr_create(ex_env%matrix_px1_asymm(ispin)%matrix, template=matrix_s(1)%matrix, &
285 matrix_type=dbcsr_type_antisymmetric)
286 CALL dbcsr_complete_redistribute(ex_env%matrix_px1(ispin)%matrix, ex_env%matrix_px1_asymm(ispin)%matrix)
287 END DO
288 ! Kernel ADMM
289 IF (tddfpt_control%do_admm) THEN
290 CALL get_qs_env(qs_env, admm_env=admm_env)
291 CALL get_admm_env(admm_env, matrix_s_aux_fit=matrix_s_aux_fit)
292 CALL dbcsr_allocate_matrix_set(ex_env%matrix_px1_admm, SIZE(ex_env%evect, 1))
293 CALL dbcsr_allocate_matrix_set(ex_env%matrix_px1_admm_asymm, SIZE(ex_env%evect, 1))
294 DO ispin = 1, SIZE(ex_env%evect, 1)
295 ALLOCATE (ex_env%matrix_px1_admm(ispin)%matrix)
296 CALL dbcsr_create(ex_env%matrix_px1_admm(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix)
297 CALL dbcsr_copy(ex_env%matrix_px1_admm(ispin)%matrix, matrix_s_aux_fit(1)%matrix)
298 CALL dbcsr_set(ex_env%matrix_px1_admm(ispin)%matrix, 0.0_dp)
299
300 ALLOCATE (ex_env%matrix_px1_admm_asymm(ispin)%matrix)
301 CALL dbcsr_create(ex_env%matrix_px1_admm_asymm(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix, &
302 matrix_type=dbcsr_type_antisymmetric)
303 CALL dbcsr_complete_redistribute(ex_env%matrix_px1_admm(ispin)%matrix, &
304 ex_env%matrix_px1_admm_asymm(ispin)%matrix)
305 END DO
306 END IF
307 ! TDA forces. Calculates and adds all missing terms for the response vector, Eq. 49.
308 CALL tddfpt_forces(qs_env, ex_env, gs_mos, kernel_env, sub_env, work_matrices)
309 ! Rotate res vector cpmos into original frame of occupied orbitals. Why do we need this?
310 CALL tddfpt_resvec3(qs_env, ex_env%cpmos, work_matrices)
311
312 CALL dbcsr_deallocate_matrix_set(matrix_pe_symm)
313 CALL dbcsr_deallocate_matrix_set(matrix_pe_asymm)
314
315 CALL timestop(handle)
316
317 END SUBROUTINE tddfpt_forces_main
318
319! **************************************************************************************************
320!> \brief Calculate direct tddft forces
321!> \param qs_env ...
322!> \param ex_env ...
323!> \param gs_mos ...
324!> \param kernel_env ...
325!> \param sub_env ...
326!> \param work_matrices ...
327!> \par History
328!> * 01.2020 screated [JGH]
329! **************************************************************************************************
330 SUBROUTINE tddfpt_forces(qs_env, ex_env, gs_mos, kernel_env, sub_env, work_matrices)
331
332 TYPE(qs_environment_type), POINTER :: qs_env
333 TYPE(excited_energy_type), POINTER :: ex_env
334 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
335 POINTER :: gs_mos
336 TYPE(kernel_env_type), INTENT(IN) :: kernel_env
337 TYPE(tddfpt_subgroup_env_type) :: sub_env
338 TYPE(tddfpt_work_matrices) :: work_matrices
339
340 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_forces'
341
342 INTEGER :: handle
343 INTEGER, ALLOCATABLE, DIMENSION(:) :: natom_of_kind
344 LOGICAL :: debug_forces
345 REAL(kind=dp) :: ehartree, exc
346 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
347 TYPE(dft_control_type), POINTER :: dft_control
348 TYPE(qs_force_type), DIMENSION(:), POINTER :: ks_force, td_force
349
350 CALL timeset(routinen, handle)
351
352 ! for extended debug output
353 debug_forces = ex_env%debug_forces
354 ! prepare force array
355 CALL get_qs_env(qs_env, dft_control=dft_control, force=ks_force, &
356 atomic_kind_set=atomic_kind_set)
357 CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, natom_of_kind=natom_of_kind)
358 NULLIFY (td_force)
359 CALL allocate_qs_force(td_force, natom_of_kind)
360 DEALLOCATE (natom_of_kind)
361 CALL zero_qs_force(td_force)
362 CALL set_qs_env(qs_env, force=td_force)
363 !
364 IF (dft_control%qs_control%xtb) THEN
365 CALL tddfpt_force_direct(qs_env, ex_env, gs_mos, kernel_env, sub_env, &
366 work_matrices, debug_forces)
367 ELSE
368 !
369 CALL exstate_potential_release(ex_env)
370 ! Build the values of hartree, fock and exchange-correlation potential on the grid
371 CALL ks_ref_potential(qs_env, ex_env%vh_rspace, ex_env%vxc_rspace, &
372 ex_env%vtau_rspace, ex_env%vadmm_rspace, ehartree, exc)
373 CALL ks_ref_potential_atom(qs_env, ex_env%local_rho_set, ex_env%local_rho_set_admm, &
374 ex_env%vh_rspace)
375 CALL tddfpt_force_direct(qs_env, ex_env, gs_mos, kernel_env, sub_env, &
376 work_matrices, debug_forces)
377 END IF
378 !
379 ! add TD and KS forces
380 CALL get_qs_env(qs_env, force=td_force)
381 CALL sum_qs_force(ks_force, td_force)
382 CALL set_qs_env(qs_env, force=ks_force)
383 CALL deallocate_qs_force(td_force)
384 !
385 CALL timestop(handle)
386
387 END SUBROUTINE tddfpt_forces
388
389! **************************************************************************************************
390!> \brief Calculate direct tddft forces.
391!> J. Chem. Theory Comput. 2022, 18, 7, 4186–4202 (https://doi.org/10.1021/acs.jctc.2c00144)
392!> \param qs_env ...
393!> \param ex_env Holds on exit
394!> cpmos = R, Response vector, Eq. 49.
395!> matrix_pe = T, Difference density, Eq. 44.
396!> matrix_wx1 = CK[D^X]X^T, Third term of Eq. 51.
397!> matrix_wz = CX^T(\omegaS - K)XC^T, Last term of Eq. 51.
398!> \param gs_mos ...
399!> \param kernel_env ...
400!> \param sub_env ...
401!> \param work_matrices ...
402!> \param debug_forces ...
403!> \par History
404!> * 01.2020 screated [JGH]
405! **************************************************************************************************
406 SUBROUTINE tddfpt_force_direct(qs_env, ex_env, gs_mos, kernel_env, sub_env, work_matrices, &
407 debug_forces)
408
409 TYPE(qs_environment_type), POINTER :: qs_env
410 TYPE(excited_energy_type), POINTER :: ex_env
411 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
412 POINTER :: gs_mos
413 TYPE(kernel_env_type), INTENT(IN) :: kernel_env
414 TYPE(tddfpt_subgroup_env_type) :: sub_env
415 TYPE(tddfpt_work_matrices) :: work_matrices
416 LOGICAL :: debug_forces
417
418 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_force_direct'
419
420 INTEGER :: handle, iounit, ispin, natom, norb, &
421 nspins, spin
422 LOGICAL :: do_sf
423 REAL(kind=dp) :: evalue
424 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: ftot1, ftot2
425 REAL(kind=dp), DIMENSION(3) :: fodeb
426 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
427 TYPE(cp_fm_type), DIMENSION(:), POINTER :: evect
428 TYPE(cp_logger_type), POINTER :: logger
429 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks, matrix_s, matrix_wx1, &
430 matrix_wz, scrm
431 TYPE(dft_control_type), POINTER :: dft_control
432 TYPE(mp_para_env_type), POINTER :: para_env
433 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
434 POINTER :: sab_orb
435 TYPE(qs_force_type), DIMENSION(:), POINTER :: force
436 TYPE(qs_ks_env_type), POINTER :: ks_env
437 TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
438
439 CALL timeset(routinen, handle)
440
441 logger => cp_get_default_logger()
442 IF (logger%para_env%is_source()) THEN
443 iounit = cp_logger_get_default_unit_nr(logger, local=.true.)
444 ELSE
445 iounit = -1
446 END IF
447
448 evect => ex_env%evect
449
450 CALL get_qs_env(qs_env=qs_env, ks_env=ks_env, para_env=para_env, &
451 sab_orb=sab_orb, dft_control=dft_control, force=force)
452 NULLIFY (tddfpt_control)
453 tddfpt_control => dft_control%tddfpt2_control
454 IF (tddfpt_control%spinflip .EQ. no_sf_tddfpt) THEN
455 do_sf = .false.
456 ELSE
457 do_sf = .true.
458 END IF
459 nspins = dft_control%nspins
460
461 IF (debug_forces) THEN
462 CALL get_qs_env(qs_env, natom=natom, atomic_kind_set=atomic_kind_set)
463 ALLOCATE (ftot1(3, natom))
464 CALL total_qs_force(ftot1, force, atomic_kind_set)
465 END IF
466
467 ! Build last terms of the response vector, Eq. 49, and third term of Lambda_munu, Eq. 51.
468 ! the response vector is in ex_env%cpmos and Lambda is in ex_env%matrix_wx1
469 CALL tddfpt_kernel_force(qs_env, ex_env, gs_mos, kernel_env, sub_env, work_matrices, debug_forces)
470
471 ! Overlap matrix, build the Lambda matrix, Eq. 51.
472 NULLIFY (matrix_wx1, matrix_wz)
473 CALL dbcsr_allocate_matrix_set(matrix_wz, nspins)
474 matrix_wx1 => ex_env%matrix_wx1
475 CALL get_qs_env(qs_env=qs_env, matrix_s=matrix_s, matrix_ks=matrix_ks)
476 DO ispin = 1, nspins
477 IF (do_sf) THEN
478 spin = 1
479 ELSE
480 spin = ispin
481 END IF
482 ! Create and initialize the Lambda matrix as a sparse matrix
483 ALLOCATE (matrix_wz(ispin)%matrix)
484 CALL dbcsr_create(matrix=matrix_wz(ispin)%matrix, template=matrix_s(1)%matrix)
485 CALL cp_dbcsr_alloc_block_from_nbl(matrix_wz(ispin)%matrix, sab_orb)
486 CALL dbcsr_set(matrix_wz(ispin)%matrix, 0.0_dp)
487 ! For spin-flip excitations only the beta component of the Lambda matrix
488 ! contains the excitation energy term
489 IF (.NOT. (do_sf .AND. (ispin == 1))) THEN
490 CALL cp_fm_get_info(gs_mos(spin)%mos_occ, ncol_global=norb)
491 CALL cp_dbcsr_plus_fm_fm_t(matrix_wz(ispin)%matrix, matrix_v=evect(spin), ncol=norb)
492 evalue = ex_env%evalue
493 IF (tddfpt_control%oe_corr == oe_shift) THEN
494 evalue = ex_env%evalue - tddfpt_control%ev_shift
495 END IF
496 CALL dbcsr_scale(matrix_wz(ispin)%matrix, evalue)
497 END IF
498 ! For spin-flip excitations only the alpha component of the Lambda matrix
499 ! contains the occupied MO energy term
500 IF (.NOT. (do_sf .AND. (ispin == 2))) THEN
501 CALL calculate_wx_matrix(gs_mos(ispin)%mos_occ, evect(spin), matrix_ks(ispin)%matrix, &
502 matrix_wz(ispin)%matrix)
503 END IF
504 END DO
505 IF (nspins == 2) THEN
506 CALL dbcsr_add(matrix_wz(1)%matrix, matrix_wz(2)%matrix, &
507 alpha_scalar=1.0_dp, beta_scalar=1.0_dp)
508 END IF
509 NULLIFY (scrm)
510 IF (debug_forces) fodeb(1:3) = force(1)%overlap(1:3, 1)
511 ! Calculate the force contribution of matrix_xz into the force in ks_env.
512 ! force%overlap = Tr(dS*matrix_wz), last term of Eq. 51.
513 CALL build_overlap_matrix(ks_env, matrix_s=scrm, &
514 matrix_name="OVERLAP MATRIX", &
515 basis_type_a="ORB", basis_type_b="ORB", &
516 sab_nl=sab_orb, calculate_forces=.true., &
517 matrix_p=matrix_wz(1)%matrix)
519 CALL dbcsr_deallocate_matrix_set(matrix_wz)
520 IF (debug_forces) THEN
521 fodeb(1:3) = force(1)%overlap(1:3, 1) - fodeb(1:3)
522 CALL para_env%sum(fodeb)
523 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Wx*dS ", fodeb
524 END IF
525
526 ! Overlap matrix. Build a part of the first term of Lamda, Eq. 51, corresponding to
527 ! the second term of Eq. 41. matrix_wz = C*X^T*(omega*S - K)*X*C^T
528 CALL get_qs_env(qs_env=qs_env, matrix_s=matrix_s, matrix_ks=matrix_ks)
529 NULLIFY (matrix_wz)
530 CALL dbcsr_allocate_matrix_set(matrix_wz, nspins)
531 DO ispin = 1, nspins
532 ALLOCATE (matrix_wz(ispin)%matrix)
533 CALL dbcsr_create(matrix=matrix_wz(ispin)%matrix, template=matrix_s(1)%matrix)
534 CALL cp_dbcsr_alloc_block_from_nbl(matrix_wz(ispin)%matrix, sab_orb)
535 CALL dbcsr_set(matrix_wz(ispin)%matrix, 0.0_dp)
536 ! For spin-flip excitations only the alpha component of Lambda has contributions
537 ! of this term, so skip beta
538 IF (.NOT. (do_sf .AND. (ispin == 2))) THEN
539 CALL cp_fm_get_info(gs_mos(ispin)%mos_occ, ncol_global=norb)
540 evalue = ex_env%evalue
541 IF (tddfpt_control%oe_corr == oe_shift) THEN
542 evalue = ex_env%evalue - tddfpt_control%ev_shift
543 END IF
544 IF (do_sf) THEN
545 spin = 2
546 ELSE
547 spin = ispin
548 END IF
549 CALL calculate_xwx_matrix(gs_mos(ispin)%mos_occ, evect(ispin), matrix_s(1)%matrix, &
550 matrix_ks(spin)%matrix, matrix_wz(ispin)%matrix, evalue)
551 END IF
552 END DO
553 IF (nspins == 2) THEN
554 CALL dbcsr_add(matrix_wz(1)%matrix, matrix_wz(2)%matrix, &
555 alpha_scalar=1.0_dp, beta_scalar=1.0_dp)
556 END IF
557 NULLIFY (scrm)
558 IF (debug_forces) fodeb(1:3) = force(1)%overlap(1:3, 1)
559 CALL build_overlap_matrix(ks_env, matrix_s=scrm, &
560 matrix_name="OVERLAP MATRIX", &
561 basis_type_a="ORB", basis_type_b="ORB", &
562 sab_nl=sab_orb, calculate_forces=.true., &
563 matrix_p=matrix_wz(1)%matrix)
565 CALL dbcsr_deallocate_matrix_set(matrix_wz)
566 IF (debug_forces) THEN
567 fodeb(1:3) = force(1)%overlap(1:3, 1) - fodeb(1:3)
568 CALL para_env%sum(fodeb)
569 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: xWx*dS ", fodeb
570 END IF
571
572 ! Compute force contribution of the first term of Eq. 41 in the first term of Eq. 51
573 ! that was calculated in tddfpt_kernel_force,
574 ! force%overlap = 0.5C*H[T]*C^T
575 IF (ASSOCIATED(matrix_wx1)) THEN
576 IF (nspins == 2 .AND. .NOT. do_sf) THEN
577 CALL dbcsr_add(matrix_wx1(1)%matrix, matrix_wx1(2)%matrix, &
578 alpha_scalar=0.5_dp, beta_scalar=0.5_dp)
579 ELSE IF (nspins == 2 .AND. do_sf) THEN
580 CALL dbcsr_add(matrix_wx1(1)%matrix, matrix_wx1(2)%matrix, &
581 alpha_scalar=1.0_dp, beta_scalar=1.0_dp)
582 END IF
583 NULLIFY (scrm)
584 IF (debug_forces) fodeb(1:3) = force(1)%overlap(1:3, 1)
585 CALL build_overlap_matrix(ks_env, matrix_s=scrm, &
586 matrix_name="OVERLAP MATRIX", &
587 basis_type_a="ORB", basis_type_b="ORB", &
588 sab_nl=sab_orb, calculate_forces=.true., &
589 matrix_p=matrix_wx1(1)%matrix)
591 IF (debug_forces) THEN
592 fodeb(1:3) = force(1)%overlap(1:3, 1) - fodeb(1:3)
593 CALL para_env%sum(fodeb)
594 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: D^XKP*dS ", fodeb
595 END IF
596 END IF
597
598 IF (debug_forces) THEN
599 ALLOCATE (ftot2(3, natom))
600 CALL total_qs_force(ftot2, force, atomic_kind_set)
601 fodeb(1:3) = ftot2(1:3, 1) - ftot1(1:3, 1)
602 CALL para_env%sum(fodeb)
603 IF (iounit > 0) WRITE (iounit, "(T3,A,T30,3F16.8)") "DEBUG:: Excitation Force", fodeb
604 DEALLOCATE (ftot1, ftot2)
605 END IF
606
607 CALL timestop(handle)
608
609 END SUBROUTINE tddfpt_force_direct
610
611! **************************************************************************************************
612!> \brief Build the spin difference density,
613!> matrix_pe = matrix_pe + X*X^T - (C*X^T*S*X*C^T + (C*X^T*S*X*C^T)^T)/2
614!> \param evect ...
615!> \param mos_occ ...
616!> \param matrix_s ...
617!> \param matrix_pe ...
618!> \param spin ...
619!> \param do_sf ...
620! **************************************************************************************************
621 SUBROUTINE tddfpt_resvec1(evect, mos_occ, matrix_s, matrix_pe, spin, do_sf)
622
623 TYPE(cp_fm_type), INTENT(IN) :: evect, mos_occ
624 TYPE(dbcsr_type), POINTER :: matrix_s, matrix_pe
625 INTEGER, INTENT(IN) :: spin
626 LOGICAL, INTENT(IN) :: do_sf
627
628 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_resvec1'
629
630 INTEGER :: handle, iounit, nao, norb
631 REAL(kind=dp) :: tmp
632 TYPE(cp_fm_struct_type), POINTER :: fmstruct, fmstruct2
633 TYPE(cp_fm_type) :: cxmat, xxmat
634 TYPE(cp_logger_type), POINTER :: logger
635
636 CALL timeset(routinen, handle)
637 CALL cp_fm_get_info(mos_occ, nrow_global=nao, ncol_global=norb)
638
639 ! matrix_pe = X*X^T
640 IF (.NOT. do_sf .OR. (do_sf .AND. (spin .EQ. 2))) THEN
641 CALL cp_dbcsr_plus_fm_fm_t(matrix_pe, matrix_v=evect, ncol=norb)
642 END IF
643
644 ! matrix_pe = matrix_pe - (C*X^T*S*X*C^T + (C*X^T*S*X*C^T)^T)/2
645 IF (.NOT. do_sf .OR. (do_sf .AND. (spin .EQ. 1))) THEN
646 CALL cp_fm_get_info(evect, matrix_struct=fmstruct)
647 NULLIFY (fmstruct2)
648 CALL cp_fm_struct_create(fmstruct=fmstruct2, template_fmstruct=fmstruct, &
649 nrow_global=norb, ncol_global=norb)
650 CALL cp_fm_create(xxmat, matrix_struct=fmstruct2)
651 CALL cp_fm_struct_release(fmstruct2)
652 CALL cp_fm_create(cxmat, matrix_struct=fmstruct)
653 ! S*X
654 CALL cp_dbcsr_sm_fm_multiply(matrix_s, evect, cxmat, norb, alpha=1.0_dp, beta=0.0_dp)
655 ! (S*X)^T*X
656 CALL parallel_gemm('T', 'N', norb, norb, nao, 1.0_dp, cxmat, evect, 0.0_dp, xxmat)
657 ! C*X^T*S*X
658 CALL parallel_gemm('N', 'N', nao, norb, norb, 1.0_dp, mos_occ, xxmat, 0.0_dp, cxmat)
659 CALL cp_fm_release(xxmat)
660 ! matrix_pe = matrix_pe - (C*(C^T*X^T*S*X)^T + C^T*(C^T*X^T*S*X))/2
661 CALL cp_dbcsr_plus_fm_fm_t(matrix_pe, matrix_v=mos_occ, matrix_g=cxmat, &
662 ncol=norb, alpha=-1.0_dp, symmetry_mode=1)
663 CALL cp_fm_release(cxmat)
664 END IF
665 !
666 ! Test for Tr(Pe*S)=0
667 CALL dbcsr_dot(matrix_pe, matrix_s, tmp)
668 IF (.NOT. do_sf) THEN
669 IF (abs(tmp) > 1.e-08_dp) THEN
670 logger => cp_get_default_logger()
671 IF (logger%para_env%is_source()) THEN
672 iounit = cp_logger_get_default_unit_nr(logger, local=.true.)
673 ELSE
674 iounit = -1
675 END IF
676 cpwarn("Electron count of excitation density matrix is non-zero.")
677 IF (iounit > 0) THEN
678 WRITE (iounit, "(T2,A,T61,G20.10)") "Measured electron count is ", tmp
679 WRITE (iounit, "(T2,A,/)") repeat("*", 79)
680 END IF
681 END IF
682 ELSE IF (spin .EQ. 1) THEN
683 IF (abs(tmp + 1) > 1.e-08_dp) THEN
684 logger => cp_get_default_logger()
685 IF (logger%para_env%is_source()) THEN
686 iounit = cp_logger_get_default_unit_nr(logger, local=.true.)
687 ELSE
688 iounit = -1
689 END IF
690 cpwarn("Count of occupied occupation number change is not -1.")
691 IF (iounit > 0) THEN
692 WRITE (iounit, "(T2,A,T61,G20.10)") "Measured electron count is ", tmp
693 WRITE (iounit, "(T2,A,/)") repeat("*", 79)
694 END IF
695 END IF
696 ELSE IF (spin .EQ. 2) THEN
697 IF (abs(tmp - 1) > 1.e-08_dp) THEN
698 logger => cp_get_default_logger()
699 IF (logger%para_env%is_source()) THEN
700 iounit = cp_logger_get_default_unit_nr(logger, local=.true.)
701 ELSE
702 iounit = -1
703 END IF
704 cpwarn("Count of unoccupied occupation number change is not 1.")
705 IF (iounit > 0) THEN
706 WRITE (iounit, "(T2,A,T61,G20.10)") "Measured electron count is ", tmp
707 WRITE (iounit, "(T2,A,/)") repeat("*", 79)
708 END IF
709 END IF
710 END IF
711 !
712
713 CALL timestop(handle)
714
715 END SUBROUTINE tddfpt_resvec1
716
717! **************************************************************************************************
718!> \brief PA = A * P * A(T)
719!> \param matrix_pe ...
720!> \param admm_env ...
721!> \param matrix_pe_admm ...
722! **************************************************************************************************
723 SUBROUTINE tddfpt_resvec1_admm(matrix_pe, admm_env, matrix_pe_admm)
724
725 TYPE(dbcsr_type), POINTER :: matrix_pe
726 TYPE(admm_type), POINTER :: admm_env
727 TYPE(dbcsr_type), POINTER :: matrix_pe_admm
728
729 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_resvec1_admm'
730
731 INTEGER :: handle, nao, nao_aux
732
733 CALL timeset(routinen, handle)
734 !
735 nao_aux = admm_env%nao_aux_fit
736 nao = admm_env%nao_orb
737 !
738 CALL copy_dbcsr_to_fm(matrix_pe, admm_env%work_orb_orb)
739 CALL parallel_gemm('N', 'N', nao_aux, nao, nao, &
740 1.0_dp, admm_env%A, admm_env%work_orb_orb, 0.0_dp, &
741 admm_env%work_aux_orb)
742 CALL parallel_gemm('N', 'T', nao_aux, nao_aux, nao, &
743 1.0_dp, admm_env%work_aux_orb, admm_env%A, 0.0_dp, &
744 admm_env%work_aux_aux)
745 CALL copy_fm_to_dbcsr(admm_env%work_aux_aux, matrix_pe_admm, keep_sparsity=.true.)
746 !
747 CALL timestop(handle)
748
749 END SUBROUTINE tddfpt_resvec1_admm
750
751! **************************************************************************************************
752!> \brief Calculates the action of the H operator as in the first term of equation 49 in
753!> https://doi.org/10.1021/acs.jctc.2c00144 (J. Chem. Theory Comput. 2022, 18, 4186−4202)
754!> cpmos = H_{\mu i\sigma}[matrix_pe]
755!> \param qs_env ...
756!> \param matrix_pe Input square matrix with the size of the number of atomic orbitals squared nao^2
757!> \param matrix_pe_admm ...
758!> \param gs_mos ...
759!> \param matrix_hz Holds H_{\mu\nu\sigma}[matrix_pe] on exit
760!> \param cpmos ...
761! **************************************************************************************************
762 SUBROUTINE tddfpt_resvec2(qs_env, matrix_pe, matrix_pe_admm, gs_mos, matrix_hz, cpmos)
763
764 TYPE(qs_environment_type), POINTER :: qs_env
765 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_pe, matrix_pe_admm
766 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
767 POINTER :: gs_mos
768 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_hz
769 TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: cpmos
770
771 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_resvec2'
772
773 CHARACTER(LEN=default_string_length) :: basis_type
774 INTEGER :: handle, iounit, ispin, mspin, n_rep_hf, &
775 nao, nao_aux, natom, norb, nspins
776 LOGICAL :: deriv2_analytic, distribute_fock_matrix, &
777 do_hfx, gapw, gapw_xc, &
778 hfx_treat_lsd_in_core, &
779 s_mstruct_changed
780 REAL(kind=dp) :: eh1, focc, rhotot, thartree
781 REAL(kind=dp), DIMENSION(2) :: total_rho
782 REAL(kind=dp), DIMENSION(:), POINTER :: qlm_tot
783 TYPE(admm_type), POINTER :: admm_env
784 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
785 TYPE(cp_fm_type), POINTER :: mos
786 TYPE(cp_logger_type), POINTER :: logger
787 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: msaux
788 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: mhz, mpe
789 TYPE(dbcsr_type), POINTER :: dbwork
790 TYPE(dft_control_type), POINTER :: dft_control
791 TYPE(hartree_local_type), POINTER :: hartree_local
792 TYPE(hfx_type), DIMENSION(:, :), POINTER :: x_data
793 TYPE(local_rho_type), POINTER :: local_rho_set, local_rho_set_admm
794 TYPE(mp_para_env_type), POINTER :: para_env
795 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
796 POINTER :: sab, sab_aux_fit
797 TYPE(oce_matrix_type), POINTER :: oce
798 TYPE(pw_c1d_gs_type) :: rho_tot_gspace, v_hartree_gspace
799 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g, rho_g_aux, rhoz_g_aux, trho_g, &
800 trho_xc_g
801 TYPE(pw_env_type), POINTER :: pw_env
802 TYPE(pw_poisson_type), POINTER :: poisson_env
803 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
804 TYPE(pw_r3d_rs_type) :: v_hartree_rspace
805 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, rho_r_aux, rhoz_r_aux, tau_r, &
806 trho_r, trho_xc_r, v_xc, v_xc_tau
807 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
808 TYPE(qs_ks_env_type), POINTER :: ks_env
809 TYPE(qs_rho_type), POINTER :: rho, rho_aux_fit, rho_xc, rhoz_aux, trho
810 TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho1_atom_set, rho_atom_set
811 TYPE(section_vals_type), POINTER :: hfx_section, input, xc_section
812 TYPE(task_list_type), POINTER :: task_list
813
814 CALL timeset(routinen, handle)
815
816 NULLIFY (pw_env)
817 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, ks_env=ks_env, &
818 dft_control=dft_control, para_env=para_env)
819 cpassert(ASSOCIATED(pw_env))
820 nspins = dft_control%nspins
821 gapw = dft_control%qs_control%gapw
822 gapw_xc = dft_control%qs_control%gapw_xc
823
824 cpassert(.NOT. dft_control%tddfpt2_control%do_exck)
825 cpassert(.NOT. dft_control%tddfpt2_control%do_hfxsr)
826 cpassert(.NOT. dft_control%tddfpt2_control%do_hfxlr)
827
828 NULLIFY (auxbas_pw_pool, poisson_env)
829 ! gets the tmp grids
830 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
831 poisson_env=poisson_env)
832
833 CALL auxbas_pw_pool%create_pw(v_hartree_gspace)
834 CALL auxbas_pw_pool%create_pw(rho_tot_gspace)
835 CALL auxbas_pw_pool%create_pw(v_hartree_rspace)
836
837 ALLOCATE (trho_r(nspins), trho_g(nspins))
838 DO ispin = 1, nspins
839 CALL auxbas_pw_pool%create_pw(trho_r(ispin))
840 CALL auxbas_pw_pool%create_pw(trho_g(ispin))
841 END DO
842 IF (gapw_xc) THEN
843 ALLOCATE (trho_xc_r(nspins), trho_xc_g(nspins))
844 DO ispin = 1, nspins
845 CALL auxbas_pw_pool%create_pw(trho_xc_r(ispin))
846 CALL auxbas_pw_pool%create_pw(trho_xc_g(ispin))
847 END DO
848 END IF
849
850 ! GAPW/GAPW_XC initializations
851 NULLIFY (hartree_local, local_rho_set)
852 IF (gapw) THEN
853 CALL get_qs_env(qs_env, &
854 atomic_kind_set=atomic_kind_set, &
855 natom=natom, &
856 qs_kind_set=qs_kind_set)
857 CALL local_rho_set_create(local_rho_set)
858 CALL allocate_rho_atom_internals(local_rho_set%rho_atom_set, atomic_kind_set, &
859 qs_kind_set, dft_control, para_env)
860 CALL init_rho0(local_rho_set, qs_env, dft_control%qs_control%gapw_control, &
861 zcore=0.0_dp)
862 CALL rho0_s_grid_create(pw_env, local_rho_set%rho0_mpole)
863 CALL hartree_local_create(hartree_local)
864 CALL init_coulomb_local(hartree_local, natom)
865 ELSEIF (gapw_xc) THEN
866 CALL get_qs_env(qs_env, &
867 atomic_kind_set=atomic_kind_set, &
868 qs_kind_set=qs_kind_set)
869 CALL local_rho_set_create(local_rho_set)
870 CALL allocate_rho_atom_internals(local_rho_set%rho_atom_set, atomic_kind_set, &
871 qs_kind_set, dft_control, para_env)
872 END IF
873
874 total_rho = 0.0_dp
875 CALL pw_zero(rho_tot_gspace)
876 DO ispin = 1, nspins
877 CALL calculate_rho_elec(ks_env=ks_env, matrix_p=matrix_pe(ispin)%matrix, &
878 rho=trho_r(ispin), &
879 rho_gspace=trho_g(ispin), &
880 soft_valid=gapw, &
881 total_rho=total_rho(ispin))
882 CALL pw_axpy(trho_g(ispin), rho_tot_gspace)
883 IF (gapw_xc) THEN
884 CALL calculate_rho_elec(ks_env=ks_env, matrix_p=matrix_pe(ispin)%matrix, &
885 rho=trho_xc_r(ispin), &
886 rho_gspace=trho_xc_g(ispin), &
887 soft_valid=gapw_xc, &
888 total_rho=rhotot)
889 END IF
890 END DO
891
892 ! GAPW o GAPW_XC require the calculation of hard and soft local densities
893 IF (gapw .OR. gapw_xc) THEN
894 CALL get_qs_env(qs_env=qs_env, oce=oce, sab_orb=sab)
895 CALL calculate_rho_atom_coeff(qs_env, matrix_pe, local_rho_set%rho_atom_set, &
896 qs_kind_set, oce, sab, para_env)
897 CALL prepare_gapw_den(qs_env, local_rho_set, do_rho0=gapw)
898 END IF
899 rhotot = sum(total_rho)
900 IF (gapw) THEN
901 CALL get_rho0_mpole(local_rho_set%rho0_mpole, qlm_tot=qlm_tot)
902 rhotot = rhotot + local_rho_set%rho0_mpole%total_rho0_h
903 CALL pw_axpy(local_rho_set%rho0_mpole%rho0_s_gs, rho_tot_gspace)
904 IF (ASSOCIATED(local_rho_set%rho0_mpole%rhoz_cneo_s_gs)) THEN
905 CALL pw_axpy(local_rho_set%rho0_mpole%rhoz_cneo_s_gs, rho_tot_gspace)
906 END IF
907 END IF
908
909 IF (abs(rhotot) > 1.e-05_dp) THEN
910 logger => cp_get_default_logger()
911 IF (logger%para_env%is_source()) THEN
912 iounit = cp_logger_get_default_unit_nr(logger, local=.true.)
913 ELSE
914 iounit = -1
915 END IF
916 cpwarn("Real space electron count of excitation density is non-zero.")
917 IF (iounit > 0) THEN
918 WRITE (iounit, "(T2,A,T61,G20.10)") "Measured electron count is ", rhotot
919 WRITE (iounit, "(T2,A,/)") repeat("*", 79)
920 END IF
921 END IF
922
923 ! calculate associated hartree potential
924 CALL pw_poisson_solve(poisson_env, rho_tot_gspace, thartree, &
925 v_hartree_gspace)
926 CALL pw_transfer(v_hartree_gspace, v_hartree_rspace)
927 CALL pw_scale(v_hartree_rspace, v_hartree_rspace%pw_grid%dvol)
928 IF (gapw) THEN
929 CALL vh_1c_gg_integrals(qs_env, thartree, hartree_local%ecoul_1c, &
930 local_rho_set, para_env, tddft=.true.)
931 CALL integrate_vhg0_rspace(qs_env, v_hartree_rspace, para_env, &
932 calculate_forces=.false., &
933 local_rho_set=local_rho_set)
934 END IF
935
936 ! Fxc*drho term
937 CALL get_qs_env(qs_env, rho=rho)
938 CALL qs_rho_get(rho, rho_r=rho_r, rho_g=rho_g)
939 !
940 CALL get_qs_env(qs_env, input=input)
941 IF (dft_control%do_admm) THEN
942 CALL get_qs_env(qs_env, admm_env=admm_env)
943 xc_section => admm_env%xc_section_primary
944 ELSE
945 xc_section => section_vals_get_subs_vals(input, "DFT%XC")
946 END IF
947 !
948 deriv2_analytic = section_get_lval(xc_section, "2ND_DERIV_ANALYTICAL")
949 IF (deriv2_analytic) THEN
950 NULLIFY (v_xc, v_xc_tau, tau_r)
951 IF (gapw_xc) THEN
952 CALL get_qs_env(qs_env=qs_env, rho_xc=rho_xc)
953 CALL qs_fxc_analytic(rho_xc, trho_xc_r, tau_r, xc_section, auxbas_pw_pool, .false., v_xc, v_xc_tau)
954 ELSE
955 CALL qs_fxc_analytic(rho, trho_r, tau_r, xc_section, auxbas_pw_pool, .false., v_xc, v_xc_tau)
956 END IF
957 IF (gapw .OR. gapw_xc) THEN
958 CALL get_qs_env(qs_env, rho_atom_set=rho_atom_set)
959 rho1_atom_set => local_rho_set%rho_atom_set
960 CALL calculate_xc_2nd_deriv_atom(rho_atom_set, rho1_atom_set, qs_env, xc_section, para_env, &
961 do_triplet=.false.)
962 END IF
963 ELSE
964 cpabort("NYA 00006")
965 NULLIFY (v_xc, trho)
966 ALLOCATE (trho)
967 CALL qs_rho_create(trho)
968 CALL qs_rho_set(trho, rho_r=trho_r, rho_g=trho_g)
969 CALL qs_fxc_fdiff(ks_env, rho, trho, xc_section, 6, .false., v_xc, v_xc_tau)
970 DEALLOCATE (trho)
971 END IF
972
973 DO ispin = 1, nspins
974 CALL dbcsr_set(matrix_hz(ispin)%matrix, 0.0_dp)
975 CALL pw_scale(v_xc(ispin), v_xc(ispin)%pw_grid%dvol)
976 END DO
977 IF (gapw_xc) THEN
978 DO ispin = 1, nspins
979 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=v_hartree_rspace, &
980 hmat=matrix_hz(ispin), &
981 calculate_forces=.false.)
982 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=v_xc(ispin), &
983 hmat=matrix_hz(ispin), &
984 gapw=gapw_xc, calculate_forces=.false.)
985 END DO
986 ELSE
987 ! vtot = v_xc(ispin) + v_hartree
988 DO ispin = 1, nspins
989 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=v_xc(ispin), &
990 hmat=matrix_hz(ispin), &
991 gapw=gapw, calculate_forces=.false.)
992 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=v_hartree_rspace, &
993 hmat=matrix_hz(ispin), &
994 gapw=gapw, calculate_forces=.false.)
995 END DO
996 END IF
997 IF (gapw .OR. gapw_xc) THEN
998 mhz(1:nspins, 1:1) => matrix_hz(1:nspins)
999 mpe(1:nspins, 1:1) => matrix_pe(1:nspins)
1000 CALL update_ks_atom(qs_env, mhz, mpe, forces=.false., &
1001 rho_atom_external=local_rho_set%rho_atom_set)
1002 END IF
1003
1004 CALL auxbas_pw_pool%give_back_pw(v_hartree_gspace)
1005 CALL auxbas_pw_pool%give_back_pw(v_hartree_rspace)
1006 CALL auxbas_pw_pool%give_back_pw(rho_tot_gspace)
1007 DO ispin = 1, nspins
1008 CALL auxbas_pw_pool%give_back_pw(trho_r(ispin))
1009 CALL auxbas_pw_pool%give_back_pw(trho_g(ispin))
1010 CALL auxbas_pw_pool%give_back_pw(v_xc(ispin))
1011 END DO
1012 DEALLOCATE (trho_r, trho_g, v_xc)
1013 IF (gapw_xc) THEN
1014 DO ispin = 1, nspins
1015 CALL auxbas_pw_pool%give_back_pw(trho_xc_r(ispin))
1016 CALL auxbas_pw_pool%give_back_pw(trho_xc_g(ispin))
1017 END DO
1018 DEALLOCATE (trho_xc_r, trho_xc_g)
1019 END IF
1020 IF (ASSOCIATED(v_xc_tau)) THEN
1021 DO ispin = 1, nspins
1022 CALL auxbas_pw_pool%give_back_pw(v_xc_tau(ispin))
1023 END DO
1024 DEALLOCATE (v_xc_tau)
1025 END IF
1026 IF (dft_control%do_admm) THEN
1027 IF (qs_env%admm_env%aux_exch_func /= do_admm_aux_exch_func_none) THEN
1028 ! add ADMM xc_section_aux terms: f_x[rhoz_ADMM]
1029 CALL get_qs_env(qs_env, admm_env=admm_env)
1030 CALL get_admm_env(admm_env, rho_aux_fit=rho_aux_fit, matrix_s_aux_fit=msaux, &
1031 task_list_aux_fit=task_list)
1032 basis_type = "AUX_FIT"
1033 !
1034 NULLIFY (mpe, mhz)
1035 ALLOCATE (mpe(nspins, 1))
1036 CALL dbcsr_allocate_matrix_set(mhz, nspins, 1)
1037 DO ispin = 1, nspins
1038 ALLOCATE (mhz(ispin, 1)%matrix)
1039 CALL dbcsr_create(mhz(ispin, 1)%matrix, template=msaux(1)%matrix)
1040 CALL dbcsr_copy(mhz(ispin, 1)%matrix, msaux(1)%matrix)
1041 CALL dbcsr_set(mhz(ispin, 1)%matrix, 0.0_dp)
1042 mpe(ispin, 1)%matrix => matrix_pe_admm(ispin)%matrix
1043 END DO
1044 !
1045 ! GAPW/GAPW_XC initializations
1046 NULLIFY (local_rho_set_admm)
1047 IF (admm_env%do_gapw) THEN
1048 basis_type = "AUX_FIT_SOFT"
1049 task_list => admm_env%admm_gapw_env%task_list
1050 CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set)
1051 CALL get_admm_env(admm_env, sab_aux_fit=sab_aux_fit)
1052 CALL local_rho_set_create(local_rho_set_admm)
1053 CALL allocate_rho_atom_internals(local_rho_set_admm%rho_atom_set, atomic_kind_set, &
1054 admm_env%admm_gapw_env%admm_kind_set, dft_control, para_env)
1055 CALL calculate_rho_atom_coeff(qs_env, matrix_pe_admm, &
1056 rho_atom_set=local_rho_set_admm%rho_atom_set, &
1057 qs_kind_set=admm_env%admm_gapw_env%admm_kind_set, &
1058 oce=admm_env%admm_gapw_env%oce, sab=sab_aux_fit, para_env=para_env)
1059 CALL prepare_gapw_den(qs_env, local_rho_set=local_rho_set_admm, &
1060 do_rho0=.false., kind_set_external=admm_env%admm_gapw_env%admm_kind_set)
1061 END IF
1062 !
1063 xc_section => admm_env%xc_section_aux
1064 !
1065 NULLIFY (rho_g_aux, rho_r_aux, rhoz_g_aux, rhoz_r_aux)
1066 CALL qs_rho_get(rho_aux_fit, rho_r=rho_r_aux, rho_g=rho_g_aux)
1067 ! rhoz_aux
1068 ALLOCATE (rhoz_r_aux(nspins), rhoz_g_aux(nspins))
1069 DO ispin = 1, nspins
1070 CALL auxbas_pw_pool%create_pw(rhoz_r_aux(ispin))
1071 CALL auxbas_pw_pool%create_pw(rhoz_g_aux(ispin))
1072 END DO
1073 DO ispin = 1, nspins
1074 CALL calculate_rho_elec(ks_env=ks_env, matrix_p=mpe(ispin, 1)%matrix, &
1075 rho=rhoz_r_aux(ispin), rho_gspace=rhoz_g_aux(ispin), &
1076 basis_type=basis_type, &
1077 task_list_external=task_list)
1078 END DO
1079 !
1080 NULLIFY (v_xc)
1081 deriv2_analytic = section_get_lval(xc_section, "2ND_DERIV_ANALYTICAL")
1082 IF (deriv2_analytic) THEN
1083 NULLIFY (tau_r)
1084 CALL qs_fxc_analytic(rho_aux_fit, rhoz_r_aux, tau_r, xc_section, auxbas_pw_pool, .false., v_xc, v_xc_tau)
1085 ELSE
1086 cpabort("NYA 00007")
1087 NULLIFY (rhoz_aux)
1088 ALLOCATE (rhoz_aux)
1089 CALL qs_rho_create(rhoz_aux)
1090 CALL qs_rho_set(rhoz_aux, rho_r=rhoz_r_aux, rho_g=rhoz_g_aux)
1091 CALL qs_fxc_fdiff(ks_env, rho_aux_fit, rhoz_aux, xc_section, 6, .false., v_xc, v_xc_tau)
1092 DEALLOCATE (rhoz_aux)
1093 END IF
1094 !
1095 DO ispin = 1, nspins
1096 CALL pw_scale(v_xc(ispin), v_xc(ispin)%pw_grid%dvol)
1097 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=v_xc(ispin), &
1098 hmat=mhz(ispin, 1), basis_type=basis_type, &
1099 calculate_forces=.false., &
1100 task_list_external=task_list)
1101 END DO
1102 DO ispin = 1, nspins
1103 CALL auxbas_pw_pool%give_back_pw(v_xc(ispin))
1104 CALL auxbas_pw_pool%give_back_pw(rhoz_r_aux(ispin))
1105 CALL auxbas_pw_pool%give_back_pw(rhoz_g_aux(ispin))
1106 END DO
1107 DEALLOCATE (v_xc, rhoz_r_aux, rhoz_g_aux)
1108 !
1109 IF (admm_env%do_gapw) THEN
1110 rho_atom_set => admm_env%admm_gapw_env%local_rho_set%rho_atom_set
1111 rho1_atom_set => local_rho_set_admm%rho_atom_set
1112 CALL calculate_xc_2nd_deriv_atom(rho_atom_set, rho1_atom_set, qs_env, xc_section, &
1113 para_env, kind_set_external=admm_env%admm_gapw_env%admm_kind_set)
1114 CALL update_ks_atom(qs_env, mhz(:, 1), matrix_pe_admm, forces=.false., tddft=.false., &
1115 rho_atom_external=rho1_atom_set, &
1116 kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
1117 oce_external=admm_env%admm_gapw_env%oce, &
1118 sab_external=sab_aux_fit)
1119 END IF
1120 !
1121 nao = admm_env%nao_orb
1122 nao_aux = admm_env%nao_aux_fit
1123 ALLOCATE (dbwork)
1124 CALL dbcsr_create(dbwork, template=matrix_hz(1)%matrix)
1125 DO ispin = 1, nspins
1126 CALL cp_dbcsr_sm_fm_multiply(mhz(ispin, 1)%matrix, admm_env%A, &
1127 admm_env%work_aux_orb, nao)
1128 CALL parallel_gemm('T', 'N', nao, nao, nao_aux, &
1129 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
1130 admm_env%work_orb_orb)
1131 CALL dbcsr_copy(dbwork, matrix_hz(1)%matrix)
1132 CALL dbcsr_set(dbwork, 0.0_dp)
1133 CALL copy_fm_to_dbcsr(admm_env%work_orb_orb, dbwork, keep_sparsity=.true.)
1134 CALL dbcsr_add(matrix_hz(ispin)%matrix, dbwork, 1.0_dp, 1.0_dp)
1135 END DO
1136 CALL dbcsr_release(dbwork)
1137 DEALLOCATE (dbwork)
1139 DEALLOCATE (mpe)
1140 IF (admm_env%do_gapw) THEN
1141 IF (ASSOCIATED(local_rho_set_admm)) CALL local_rho_set_release(local_rho_set_admm)
1142 END IF
1143 END IF
1144 END IF
1145 IF (gapw .OR. gapw_xc) THEN
1146 IF (ASSOCIATED(local_rho_set)) CALL local_rho_set_release(local_rho_set)
1147 IF (ASSOCIATED(hartree_local)) CALL hartree_local_release(hartree_local)
1148 END IF
1149
1150 ! HFX
1151 hfx_section => section_vals_get_subs_vals(xc_section, "HF")
1152 CALL section_vals_get(hfx_section, explicit=do_hfx)
1153 IF (do_hfx) THEN
1154 CALL section_vals_get(hfx_section, n_repetition=n_rep_hf)
1155 cpassert(n_rep_hf == 1)
1156 CALL section_vals_val_get(hfx_section, "TREAT_LSD_IN_CORE", l_val=hfx_treat_lsd_in_core, &
1157 i_rep_section=1)
1158 mspin = 1
1159 IF (hfx_treat_lsd_in_core) mspin = nspins
1160 !
1161 CALL get_qs_env(qs_env=qs_env, rho=rho, x_data=x_data, para_env=para_env, &
1162 s_mstruct_changed=s_mstruct_changed)
1163 distribute_fock_matrix = .true.
1164 IF (dft_control%do_admm) THEN
1165 CALL get_qs_env(qs_env, admm_env=admm_env)
1166 CALL get_admm_env(admm_env, matrix_s_aux_fit=msaux)
1167 NULLIFY (mpe, mhz)
1168 ALLOCATE (mpe(nspins, 1))
1169 CALL dbcsr_allocate_matrix_set(mhz, nspins, 1)
1170 DO ispin = 1, nspins
1171 ALLOCATE (mhz(ispin, 1)%matrix)
1172 CALL dbcsr_create(mhz(ispin, 1)%matrix, template=msaux(1)%matrix)
1173 CALL dbcsr_copy(mhz(ispin, 1)%matrix, msaux(1)%matrix)
1174 CALL dbcsr_set(mhz(ispin, 1)%matrix, 0.0_dp)
1175 mpe(ispin, 1)%matrix => matrix_pe_admm(ispin)%matrix
1176 END DO
1177 IF (x_data(1, 1)%do_hfx_ri) THEN
1178 eh1 = 0.0_dp
1179 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhz, eh1, rho_ao=mpe, &
1180 geometry_did_change=s_mstruct_changed, nspins=nspins, &
1181 hf_fraction=x_data(1, 1)%general_parameter%fraction)
1182 ELSE
1183 DO ispin = 1, mspin
1184 eh1 = 0.0
1185 CALL integrate_four_center(qs_env, x_data, mhz, eh1, mpe, hfx_section, &
1186 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
1187 ispin=ispin)
1188 END DO
1189 END IF
1190 !
1191 cpassert(ASSOCIATED(admm_env%work_aux_orb))
1192 cpassert(ASSOCIATED(admm_env%work_orb_orb))
1193 nao = admm_env%nao_orb
1194 nao_aux = admm_env%nao_aux_fit
1195 ALLOCATE (dbwork)
1196 CALL dbcsr_create(dbwork, template=matrix_hz(1)%matrix)
1197 DO ispin = 1, nspins
1198 CALL cp_dbcsr_sm_fm_multiply(mhz(ispin, 1)%matrix, admm_env%A, &
1199 admm_env%work_aux_orb, nao)
1200 CALL parallel_gemm('T', 'N', nao, nao, nao_aux, &
1201 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
1202 admm_env%work_orb_orb)
1203 CALL dbcsr_copy(dbwork, matrix_hz(ispin)%matrix)
1204 CALL dbcsr_set(dbwork, 0.0_dp)
1205 CALL copy_fm_to_dbcsr(admm_env%work_orb_orb, dbwork, keep_sparsity=.true.)
1206 CALL dbcsr_add(matrix_hz(ispin)%matrix, dbwork, 1.0_dp, 1.0_dp)
1207 END DO
1208 CALL dbcsr_release(dbwork)
1209 DEALLOCATE (dbwork)
1211 DEALLOCATE (mpe)
1212 ELSE
1213 NULLIFY (mpe, mhz)
1214 ALLOCATE (mpe(nspins, 1), mhz(nspins, 1))
1215 DO ispin = 1, nspins
1216 mhz(ispin, 1)%matrix => matrix_hz(ispin)%matrix
1217 mpe(ispin, 1)%matrix => matrix_pe(ispin)%matrix
1218 END DO
1219 IF (x_data(1, 1)%do_hfx_ri) THEN
1220 eh1 = 0.0_dp
1221 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhz, eh1, rho_ao=mpe, &
1222 geometry_did_change=s_mstruct_changed, nspins=nspins, &
1223 hf_fraction=x_data(1, 1)%general_parameter%fraction)
1224 ELSE
1225 DO ispin = 1, mspin
1226 eh1 = 0.0
1227 CALL integrate_four_center(qs_env, x_data, mhz, eh1, mpe, hfx_section, &
1228 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
1229 ispin=ispin)
1230 END DO
1231 END IF
1232 DEALLOCATE (mpe, mhz)
1233 END IF
1234 END IF
1235
1236 focc = 4.0_dp
1237 IF (nspins == 2) focc = 2.0_dp
1238 DO ispin = 1, nspins
1239 mos => gs_mos(ispin)%mos_occ
1240 CALL cp_fm_get_info(mos, ncol_global=norb)
1241 CALL cp_dbcsr_sm_fm_multiply(matrix_hz(ispin)%matrix, mos, cpmos(ispin), &
1242 norb, alpha=focc, beta=0.0_dp)
1243 END DO
1244
1245 CALL timestop(handle)
1246
1247 END SUBROUTINE tddfpt_resvec2
1248
1249! **************************************************************************************************
1250!> \brief ...
1251!> \param qs_env ...
1252!> \param matrix_pe ...
1253!> \param gs_mos ...
1254!> \param matrix_hz ...
1255!> \param cpmos ...
1256! **************************************************************************************************
1257 SUBROUTINE tddfpt_resvec2_xtb(qs_env, matrix_pe, gs_mos, matrix_hz, cpmos)
1258
1259 TYPE(qs_environment_type), POINTER :: qs_env
1260 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_pe
1261 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
1262 POINTER :: gs_mos
1263 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_hz
1264 TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: cpmos
1265
1266 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_resvec2_xtb'
1267
1268 INTEGER :: atom_a, handle, iatom, ikind, is, ispin, &
1269 na, natom, natorb, nkind, norb, ns, &
1270 nsgf, nspins
1271 INTEGER, DIMENSION(25) :: lao
1272 INTEGER, DIMENSION(5) :: occ
1273 REAL(dp), ALLOCATABLE, DIMENSION(:) :: mcharge, mcharge1
1274 REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: aocg, aocg1, charges, charges1
1275 REAL(kind=dp) :: focc
1276 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1277 TYPE(cp_fm_type), POINTER :: mos
1278 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: p_matrix
1279 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_p, matrix_s
1280 TYPE(dbcsr_type), POINTER :: s_matrix
1281 TYPE(dft_control_type), POINTER :: dft_control
1282 TYPE(mp_para_env_type), POINTER :: para_env
1283 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1284 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1285 TYPE(qs_rho_type), POINTER :: rho
1286 TYPE(xtb_atom_type), POINTER :: xtb_kind
1287
1288 CALL timeset(routinen, handle)
1289
1290 cpassert(ASSOCIATED(matrix_pe))
1291
1292 CALL get_qs_env(qs_env=qs_env, dft_control=dft_control)
1293 nspins = dft_control%nspins
1294
1295 DO ispin = 1, nspins
1296 CALL dbcsr_set(matrix_hz(ispin)%matrix, 0.0_dp)
1297 END DO
1298
1299 IF (dft_control%qs_control%xtb_control%coulomb_interaction) THEN
1300 ! Mulliken charges
1301 CALL get_qs_env(qs_env, rho=rho, particle_set=particle_set, &
1302 matrix_s_kp=matrix_s, para_env=para_env)
1303 natom = SIZE(particle_set)
1304 CALL qs_rho_get(rho, rho_ao_kp=matrix_p)
1305 ALLOCATE (mcharge(natom), charges(natom, 5))
1306 ALLOCATE (mcharge1(natom), charges1(natom, 5))
1307 charges = 0.0_dp
1308 charges1 = 0.0_dp
1309 CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set)
1310 nkind = SIZE(atomic_kind_set)
1311 CALL get_qs_kind_set(qs_kind_set, maxsgf=nsgf)
1312 ALLOCATE (aocg(nsgf, natom))
1313 aocg = 0.0_dp
1314 ALLOCATE (aocg1(nsgf, natom))
1315 aocg1 = 0.0_dp
1316 p_matrix => matrix_p(:, 1)
1317 s_matrix => matrix_s(1, 1)%matrix
1318 CALL ao_charges(p_matrix, s_matrix, aocg, para_env)
1319 CALL ao_charges(matrix_pe, s_matrix, aocg1, para_env)
1320 DO ikind = 1, nkind
1321 CALL get_atomic_kind(atomic_kind_set(ikind), natom=na)
1322 CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_kind)
1323 CALL get_xtb_atom_param(xtb_kind, natorb=natorb, lao=lao, occupation=occ)
1324 DO iatom = 1, na
1325 atom_a = atomic_kind_set(ikind)%atom_list(iatom)
1326 charges(atom_a, :) = real(occ(:), kind=dp)
1327 DO is = 1, natorb
1328 ns = lao(is) + 1
1329 charges(atom_a, ns) = charges(atom_a, ns) - aocg(is, atom_a)
1330 charges1(atom_a, ns) = charges1(atom_a, ns) - aocg1(is, atom_a)
1331 END DO
1332 END DO
1333 END DO
1334 DEALLOCATE (aocg, aocg1)
1335 DO iatom = 1, natom
1336 mcharge(iatom) = sum(charges(iatom, :))
1337 mcharge1(iatom) = sum(charges1(iatom, :))
1338 END DO
1339 ! Coulomb Kernel
1340 CALL xtb_coulomb_hessian(qs_env, matrix_hz, charges1, mcharge1, mcharge)
1341 !
1342 DEALLOCATE (charges, mcharge, charges1, mcharge1)
1343 END IF
1344
1345 focc = 2.0_dp
1346 IF (nspins == 2) focc = 1.0_dp
1347 DO ispin = 1, nspins
1348 mos => gs_mos(ispin)%mos_occ
1349 CALL cp_fm_get_info(mos, ncol_global=norb)
1350 CALL cp_dbcsr_sm_fm_multiply(matrix_hz(ispin)%matrix, mos, cpmos(ispin), &
1351 norb, alpha=focc, beta=0.0_dp)
1352 END DO
1353
1354 CALL timestop(handle)
1355
1356 END SUBROUTINE tddfpt_resvec2_xtb
1357
1358! **************************************************************************************************
1359!> \brief ...
1360!> \param qs_env ...
1361!> \param cpmos ...
1362!> \param work ...
1363! **************************************************************************************************
1364 SUBROUTINE tddfpt_resvec3(qs_env, cpmos, work)
1365
1366 TYPE(qs_environment_type), POINTER :: qs_env
1367 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: cpmos
1368 TYPE(tddfpt_work_matrices) :: work
1369
1370 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_resvec3'
1371
1372 INTEGER :: handle, ispin, nao, norb, nspins
1373 TYPE(cp_fm_struct_type), POINTER :: fmstruct
1374 TYPE(cp_fm_type) :: cvec, umat
1375 TYPE(cp_fm_type), POINTER :: omos
1376 TYPE(dft_control_type), POINTER :: dft_control
1377 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
1378
1379 CALL timeset(routinen, handle)
1380
1381 CALL get_qs_env(qs_env, mos=mos, dft_control=dft_control)
1382 nspins = dft_control%nspins
1383
1384 DO ispin = 1, nspins
1385 CALL get_mo_set(mos(ispin), mo_coeff=omos)
1386 associate(rvecs => cpmos(ispin))
1387 CALL cp_fm_get_info(rvecs, nrow_global=nao, ncol_global=norb)
1388 CALL cp_fm_create(cvec, rvecs%matrix_struct, "cvec")
1389 CALL cp_fm_struct_create(fmstruct, context=rvecs%matrix_struct%context, nrow_global=norb, &
1390 ncol_global=norb, para_env=rvecs%matrix_struct%para_env)
1391 CALL cp_fm_create(umat, fmstruct, "umat")
1392 CALL cp_fm_struct_release(fmstruct)
1393 !
1394 CALL parallel_gemm("T", "N", norb, norb, nao, 1.0_dp, omos, work%S_C0(ispin), 0.0_dp, umat)
1395 CALL cp_fm_copy_general(rvecs, cvec, rvecs%matrix_struct%para_env)
1396 CALL parallel_gemm("N", "T", nao, norb, norb, 1.0_dp, cvec, umat, 0.0_dp, rvecs)
1397 END associate
1398 CALL cp_fm_release(cvec)
1399 CALL cp_fm_release(umat)
1400 END DO
1401
1402 CALL timestop(handle)
1403
1404 END SUBROUTINE tddfpt_resvec3
1405
1406! **************************************************************************************************
1407!> \brief Calculate direct tddft forces
1408!> \param qs_env ...
1409!> \param ex_env ...
1410!> \param gs_mos ...
1411!> \param kernel_env ...
1412!> \param sub_env ...
1413!> \param work_matrices ...
1414!> \param debug_forces ...
1415!> \par History
1416!> * 01.2020 screated [JGH]
1417! **************************************************************************************************
1418 SUBROUTINE tddfpt_kernel_force(qs_env, ex_env, gs_mos, kernel_env, sub_env, work_matrices, debug_forces)
1419
1420 TYPE(qs_environment_type), POINTER :: qs_env
1421 TYPE(excited_energy_type), POINTER :: ex_env
1422 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
1423 POINTER :: gs_mos
1424 TYPE(kernel_env_type), INTENT(IN) :: kernel_env
1425 TYPE(tddfpt_subgroup_env_type) :: sub_env
1426 TYPE(tddfpt_work_matrices) :: work_matrices
1427 LOGICAL, INTENT(IN) :: debug_forces
1428
1429 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_kernel_force'
1430
1431 INTEGER :: handle
1432 TYPE(dft_control_type), POINTER :: dft_control
1433 TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
1434
1435 mark_used(work_matrices)
1436
1437 CALL timeset(routinen, handle)
1438
1439 CALL get_qs_env(qs_env, dft_control=dft_control)
1440 tddfpt_control => dft_control%tddfpt2_control
1441
1442 IF (tddfpt_control%kernel == tddfpt_kernel_full) THEN
1443 ! full Kernel
1444 CALL fhxc_force(qs_env, ex_env, gs_mos, kernel_env%full_kernel, debug_forces)
1445 ELSE IF (tddfpt_control%kernel == tddfpt_kernel_stda) THEN
1446 ! sTDA Kernel
1447 CALL stda_force(qs_env, ex_env, gs_mos, kernel_env%stda_kernel, sub_env, work_matrices, debug_forces)
1448 ELSE IF (tddfpt_control%kernel == tddfpt_kernel_none) THEN
1449 ! nothing to be done here
1450 ex_env%matrix_wx1 => null()
1451 ELSE
1452 cpabort('Unknown kernel type')
1453 END IF
1454
1455 CALL timestop(handle)
1456
1457 END SUBROUTINE tddfpt_kernel_force
1458
1459END MODULE qs_tddfpt2_forces
Types and set/get functions for auxiliary density matrix methods.
Definition admm_types.F:15
subroutine, public get_admm_env(admm_env, mo_derivs_aux_fit, mos_aux_fit, sab_aux_fit, sab_aux_fit_asymm, sab_aux_fit_vs_orb, matrix_s_aux_fit, matrix_s_aux_fit_kp, matrix_s_aux_fit_vs_orb, matrix_s_aux_fit_vs_orb_kp, task_list_aux_fit, matrix_ks_aux_fit, matrix_ks_aux_fit_kp, matrix_ks_aux_fit_im, matrix_ks_aux_fit_dft, matrix_ks_aux_fit_hfx, matrix_ks_aux_fit_dft_kp, matrix_ks_aux_fit_hfx_kp, rho_aux_fit, rho_aux_fit_buffer, admm_dm)
Get routine for the ADMM env.
Definition admm_types.F:593
Define the atomic kind types and their sub types.
subroutine, public get_atomic_kind_set(atomic_kind_set, atom_of_kind, kind_of, natom_of_kind, maxatom, natom, nshell, fist_potential_present, shell_present, shell_adiabatic, shell_check_distance, damping_present)
Get attributes of an atomic kind set.
subroutine, public get_atomic_kind(atomic_kind, fist_potential, element_symbol, name, mass, kind_number, natom, atom_list, rcov, rvdw, z, qeff, apol, cpol, mm_radius, shell, shell_active, damping)
Get attributes of an atomic kind.
collects all references to literature in CP2K as new algorithms / method are included from literature...
integer, save, public sertcan2024
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
subroutine, public dbcsr_scale(matrix, alpha_scalar)
...
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_set(matrix, alpha)
...
subroutine, public dbcsr_release(matrix)
...
subroutine, public dbcsr_complete_redistribute(matrix, redist)
...
subroutine, public dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
...
subroutine, public dbcsr_dot(matrix_a, matrix_b, trace)
Computes the dot product of two matrices, also known as the trace of their matrix product.
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
subroutine, public copy_dbcsr_to_fm(matrix, fm)
Copy a DBCSR matrix to a BLACS matrix.
subroutine, public cp_dbcsr_plus_fm_fm_t(sparse_matrix, matrix_v, matrix_g, ncol, alpha, keep_sparsity, symmetry_mode)
performs the multiplication sparse_matrix+dense_mat*dens_mat^T if matrix_g is not explicitly given,...
subroutine, public copy_fm_to_dbcsr(fm, matrix, keep_sparsity)
Copy a BLACS matrix to a dbcsr matrix.
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_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_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 ...
recursive integer function, public cp_logger_get_default_unit_nr(logger, local, skip_not_ionode)
asks the default unit number of the given logger. try to use cp_logger_get_unit_nr
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Types for excited states potential energies.
subroutine, public exstate_potential_release(ex_env)
...
subroutine, public init_coulomb_local(hartree_local, natom)
...
subroutine, public vh_1c_gg_integrals(qs_env, energy_hartree_1c, ecoul_1c, local_rho_set, para_env, tddft, local_rho_set_2nd, core_2nd)
Calculates one center GAPW Hartree energies and matrix elements Hartree potentials are input Takes po...
subroutine, public hartree_local_release(hartree_local)
...
subroutine, public hartree_local_create(hartree_local)
...
Routines to calculate HFX energy and potential.
subroutine, public integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_section, para_env, geometry_did_change, irep, distribute_fock_matrix, ispin, nspins)
computes four center integrals for a full basis set and updates the Kohn-Sham-Matrix and energy....
RI-methods for HFX.
Definition hfx_ri.F:12
subroutine, public hfx_ri_update_ks(qs_env, ri_data, ks_matrix, ehfx, mos, rho_ao, geometry_did_change, nspins, hf_fraction)
...
Definition hfx_ri.F:1041
Types and set/get functions for HFX.
Definition hfx_types.F:15
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public tddfpt_kernel_none
integer, parameter, public oe_shift
integer, parameter, public do_admm_aux_exch_func_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
recursive type(section_vals_type) function, pointer, public section_vals_get_subs_vals(section_vals, subsection_name, i_rep_section, can_return_null)
returns the values of the requested subsection
subroutine, public section_vals_get(section_vals, ref_count, n_repetition, n_subs_vals_rep, section, explicit)
returns various attributes about the section_vals
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
logical function, public section_get_lval(section_vals, keyword_name)
...
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
integer, parameter, public default_string_length
Definition kinds.F:57
Interface to the message passing library MPI.
compute mulliken charges we (currently) define them as c_i = 1/2 [ (PS)_{ii} + (SP)_{ii} ]
Definition mulliken.F:13
basic linear algebra operations for full matrixes
Define the data structure for the particle information.
container for various plainwaves related things
subroutine, public pw_env_get(pw_env, pw_pools, cube_info, gridlevel_info, auxbas_pw_pool, auxbas_grid, auxbas_rs_desc, auxbas_rs_grid, rs_descs, rs_grids, xc_pw_pool, vdw_pw_pool, poisson_env, interp_section)
returns the various attributes of the pw env
functions related to the poisson solver on regular grids
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Calculate the plane wave density by collocating the primitive Gaussian functions (pgf).
subroutine, public calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, ks_env, soft_valid, compute_tau, compute_grad, basis_type, der_type, idir, task_list_external, pw_env_external)
computes the density corresponding to a given density matrix on the grid
collects routines that calculate density matrices
subroutine, public calculate_wx_matrix(mos_occ, xvec, ks_matrix, w_matrix)
Calculate the excited state W matrix from the MO eigenvectors, KS matrix.
subroutine, public calculate_xwx_matrix(mos_occ, xvec, s_matrix, ks_matrix, w_matrix, eval)
Calculate the excited state W matrix from the MO eigenvectors, KS matrix.
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.
subroutine, public set_qs_env(qs_env, super_cell, mos, qmmm, qmmm_periodic, ewald_env, ewald_pw, mpools, rho_external, external_vxc, mask, scf_control, rel_control, qs_charges, ks_env, ks_qmmm_env, wf_history, scf_env, active_space, input, oce, rho_atom_set, rho0_atom_set, rho0_mpole, run_rtp, rtp, rhoz_set, rhoz_tot, ecoul_1c, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, efield, rhoz_cneo_set, linres_control, xas_env, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, ls_scf_env, do_transport, transport_env, lri_env, lri_density, exstate_env, ec_env, dispersion_env, harris_env, gcp_env, mp2_env, bs_env, kg_env, force, kpoints, wanniercentres, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Set the QUICKSTEP environment.
subroutine, public sum_qs_force(qs_force_out, qs_force_in)
Sum up two qs_force entities qs_force_out = qs_force_out + qs_force_in.
subroutine, public deallocate_qs_force(qs_force)
Deallocate a Quickstep force data structure.
subroutine, public zero_qs_force(qs_force)
Initialize a Quickstep force data structure.
subroutine, public allocate_qs_force(qs_force, natom_of_kind)
Allocate a Quickstep force data structure.
subroutine, public total_qs_force(force, qs_force, atomic_kind_set)
Get current total force.
https://en.wikipedia.org/wiki/Finite_difference_coefficient
Definition qs_fxc.F:27
subroutine, public qs_fxc_fdiff(ks_env, rho0_struct, rho1_struct, xc_section, accuracy, is_triplet, fxc_rho, fxc_tau)
...
Definition qs_fxc.F:161
subroutine, public qs_fxc_analytic(rho0, rho1_r, tau1_r, xc_section, auxbas_pw_pool, is_triplet, v_xc, v_xc_tau, spinflip)
...
Definition qs_fxc.F:94
subroutine, public prepare_gapw_den(qs_env, local_rho_set, do_rho0, kind_set_external, pw_env_sub)
...
Integrate single or product functions over a potential on a RS grid.
Define the quickstep kind type and their sub types.
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, cneo_potential, se_parameter, dftb_parameter, xtb_parameter, dftb3_param, zatom, zeff, elec_conf, mao, lmax_dftb, alpha_core_charge, ccore_charge, core_charge, core_charge_radius, paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, covalent_radius, vdw_radius, gpw_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, ngrid_ang, ngrid_rad, lmax_rho0, dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, u_minus_j, u_of_dft_plus_u, j_of_dft_plus_u, alpha_of_dft_plus_u, beta_of_dft_plus_u, j0_of_dft_plus_u, occupation_of_dft_plus_u, dispersion, bs_occupation, magnetization, no_optimize, addel, laddel, naddel, orbitals, max_scf, eps_scf, smear, u_ramping, u_minus_j_target, eps_u_ramping, init_u_ramping_each_scf, reltmat, ghost, floating, name, element_symbol, pao_basis_size, pao_model_file, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
subroutine, public get_qs_kind_set(qs_kind_set, all_potential_present, tnadd_potential_present, gth_potential_present, sgp_potential_present, paw_atom_present, dft_plus_u_atom_present, maxcgf, maxsgf, maxco, maxco_proj, maxgtops, maxlgto, maxlprj, maxnset, maxsgf_set, ncgf, npgf, nset, nsgf, nshell, maxpol, maxlppl, maxlppnl, maxppnl, nelectron, maxder, max_ngrid_rad, max_sph_harm, maxg_iso_not0, lmax_rho0, basis_rcut, basis_type, total_zeff_corr, npgf_seg, cneo_potential_present, nkind_q, natom_q)
Get attributes of an atomic kind set.
routines that build the Kohn-Sham matrix contributions coming from local atomic densities
Definition qs_ks_atom.F:12
subroutine, public update_ks_atom(qs_env, ksmat, pmat, forces, tddft, rho_atom_external, kind_set_external, oce_external, sab_external, kscale, kintegral, kforce, fscale)
The correction to the KS matrix due to the GAPW local terms to the hartree and XC contributions is he...
Definition qs_ks_atom.F:110
Calculate the KS reference potentials.
subroutine, public ks_ref_potential(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspace, ehartree, exc, h_stress)
calculate the Kohn-Sham reference potential
subroutine, public ks_ref_potential_atom(qs_env, local_rho_set, local_rho_set_admm, v_hartree_rspace)
calculate the Kohn-Sham GAPW reference potentials
subroutine, public local_rho_set_create(local_rho_set)
...
subroutine, public local_rho_set_release(local_rho_set)
...
Definition and initialisation of the mo data type.
Definition qs_mo_types.F:22
subroutine, public get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, uniform_occupation, kts, mu, flexible_electron_count)
Get the components of a MO set data structure.
Define the neighbor list data types and the corresponding functionality.
Calculation of overlap matrix, its derivatives and forces.
Definition qs_overlap.F:19
subroutine, public build_overlap_matrix(ks_env, matrix_s, matrixkp_s, matrix_name, nderivative, basis_type_a, basis_type_b, sab_nl, calculate_forces, matrix_p, matrixkp_p)
Calculation of the overlap matrix over Cartesian Gaussian functions.
Definition qs_overlap.F:120
subroutine, public rho0_s_grid_create(pw_env, rho0_mpole)
...
subroutine, public integrate_vhg0_rspace(qs_env, v_rspace, para_env, calculate_forces, local_rho_set, local_rho_set_2nd, atener, kforce, my_pools, my_rs_descs)
...
subroutine, public init_rho0(local_rho_set, qs_env, gapw_control, zcore)
...
subroutine, public get_rho0_mpole(rho0_mpole, g0_h, vg0_h, iat, ikind, lmax_0, l0_ikind, mp_gau_ikind, mp_rho, norm_g0l_h, qlm_gg, qlm_car, qlm_tot, zet0_h, igrid_zet0_s, rpgf0_h, rpgf0_s, max_rpgf0_s, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs)
...
subroutine, public allocate_rho_atom_internals(rho_atom_set, atomic_kind_set, qs_kind_set, dft_control, para_env)
...
subroutine, public calculate_rho_atom_coeff(qs_env, rho_ao, rho_atom_set, qs_kind_set, oce, sab, para_env)
...
superstucture that hold various representations of the density and keeps track of which ones are vali...
subroutine, public qs_rho_set(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rho_r, drho_r, rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, drho_g_valid, tau_r_valid, tau_g_valid, tot_rho_r, tot_rho_g, rho_r_sccs, soft_valid, complex_rho_ao)
...
subroutine, public qs_rho_get(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rho_r, drho_r, rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, drho_g_valid, tau_r_valid, tau_g_valid, tot_rho_r, tot_rho_g, rho_r_sccs, soft_valid, complex_rho_ao)
returns info about the density described by this object. If some representation is not available an e...
subroutine, public qs_rho_create(rho)
Allocates a new instance of rho.
subroutine, public stda_force(qs_env, ex_env, gs_mos, stda_env, sub_env, work, debug_forces)
Simplified Tamm Dancoff approach (sTDA). Kernel contribution to forces.
subroutine, public fhxc_force(qs_env, ex_env, gs_mos, full_kernel, debug_forces)
Calculate direct tddft forces. Calculate the three last terms of the response vector in equation 49 a...
subroutine, public tddfpt_forces_main(qs_env, gs_mos, ex_env, kernel_env, sub_env, work_matrices)
Perform TDDFPT gradient calculation. This routine calculates the response vector R of Eq....
routines that build the integrals of the Vxc potential calculated for the atomic density in the basis...
Definition qs_vxc_atom.F:12
subroutine, public calculate_xc_2nd_deriv_atom(rho_atom_set, rho1_atom_set, qs_env, xc_section, para_env, do_tddfpt2, do_triplet, do_sf, kind_set_external)
...
types for task lists
Calculation of Coulomb Hessian contributions in xTB.
Definition xtb_ehess.F:12
subroutine, public xtb_coulomb_hessian(qs_env, ks_matrix, charges1, mcharge1, mcharge)
...
Definition xtb_ehess.F:77
Definition of the xTB parameter types.
Definition xtb_types.F:20
subroutine, public get_xtb_atom_param(xtb_parameter, symbol, aname, typ, defined, z, zeff, natorb, lmax, nao, lao, rcut, rcov, kx, eta, xgamma, alpha, zneff, nshell, nval, lval, kpoly, kappa, hen, zeta, xi, kappa0, alpg, occupation, electronegativity, chmax, en, kqat2, kcn, kq)
...
Definition xtb_types.F:199
stores some data used in wavefunction fitting
Definition admm_types.F:120
Provides all information about an atomic kind.
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...
Contains information on the excited states energy.
stores some data used in construction of Kohn-Sham matrix
Definition hfx_types.F:510
stores all the informations relevant to an mpi environment
contained for different pw related things
environment for the poisson solver
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Type to hold environments for the different kernels.
Provides all information about a quickstep kind.
calculation environment to calculate the ks matrix, holds all the needed vars. assumes that the core ...
keeps the density in various representations, keeping track of which ones are valid.
Ground state molecular orbitals.
Set of temporary ("work") matrices.