(git:07c9450)
Loading...
Searching...
No Matches
qs_tddfpt2_fhxc_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
10 USE admm_types, ONLY: admm_type,&
14 USE cell_types, ONLY: cell_type,&
15 pbc
19 USE cp_dbcsr_api, ONLY: &
24 dbcsr_type_antisymmetric, dbcsr_type_no_symmetry
41 USE cp_fm_types, ONLY: cp_fm_create,&
63 USE hfx_ri, ONLY: hfx_ri_update_forces,&
65 USE hfx_types, ONLY: hfx_type
78 USE kinds, ONLY: default_string_length,&
79 dp
80 USE mathconstants, ONLY: oorootpi
85 USE pw_env_types, ONLY: pw_env_get,&
87 USE pw_methods, ONLY: pw_axpy,&
88 pw_scale,&
94 USE pw_types, ONLY: pw_c1d_gs_type,&
101 USE qs_fxc, ONLY: qs_fgxc_analytic,&
106 USE qs_integrate_potential, ONLY: integrate_v_rspace
108 USE qs_kind_types, ONLY: qs_kind_type
109 USE qs_ks_atom, ONLY: update_ks_atom
110 USE qs_ks_types, ONLY: qs_ks_env_type
116 USE qs_oce_types, ONLY: allocate_oce_set,&
122 USE qs_rho0_methods, ONLY: init_rho0
126 USE qs_rho_types, ONLY: qs_rho_create,&
127 qs_rho_get,&
128 qs_rho_set,&
139 USE util, ONLY: get_limit
140 USE virial_types, ONLY: virial_type
141#include "./base/base_uses.f90"
142
143 IMPLICIT NONE
144
145 PRIVATE
146
147 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_tddfpt2_fhxc_forces'
148
149 PUBLIC :: fhxc_force, stda_force
150
151! **************************************************************************************************
152
153CONTAINS
154
155! **************************************************************************************************
156!> \brief Calculate direct tddft forces. Calculate the three last terms of the response vector
157!> in equation 49 and the first term of \Lambda_munu in equation 51 in
158!> J. Chem. Theory Comput. 2022, 18, 7, 4186–4202 (https://doi.org/10.1021/acs.jctc.2c00144)
159!> \param qs_env Holds all system information relevant for the calculation.
160!> \param ex_env Holds the response vector ex_env%cpmos and Lambda ex_env%matrix_wx1.
161!> \param gs_mos MO coefficients of the ground state.
162!> \param full_kernel ...
163!> \param debug_forces ...
164!> \par History
165!> * 01.2020 screated [JGH]
166! **************************************************************************************************
167 SUBROUTINE fhxc_force(qs_env, ex_env, gs_mos, full_kernel, debug_forces)
168
169 TYPE(qs_environment_type), POINTER :: qs_env
170 TYPE(excited_energy_type), POINTER :: ex_env
171 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
172 POINTER :: gs_mos
173 TYPE(full_kernel_env_type), INTENT(IN) :: full_kernel
174 LOGICAL, INTENT(IN) :: debug_forces
175
176 CHARACTER(LEN=*), PARAMETER :: routinen = 'fhxc_force'
177
178 CHARACTER(LEN=default_string_length) :: basis_type
179 INTEGER :: handle, ia, ib, iounit, ispin, mspin, &
180 myfun, n_rep_hf, nactive(2), nao, &
181 nao_aux, natom, nkind, norb(2), nsev, &
182 nspins, order, spin
183 LOGICAL :: distribute_fock_matrix, do_admm, do_analytic, do_hfx, do_hfxlr, do_hfxsr, &
184 do_numeric, do_res, do_sf, gapw, gapw_xc, hfx_treat_lsd_in_core, is_rks_triplets, &
185 s_mstruct_changed, use_virial
186 REAL(kind=dp) :: eh1, eh1c, eps_delta, eps_fit, focc, &
187 fscal, fval, kval, xehartree
188 REAL(kind=dp), DIMENSION(3) :: fodeb
189 TYPE(admm_type), POINTER :: admm_env
190 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
191 TYPE(cp_fm_struct_type), POINTER :: fm_struct
192 TYPE(cp_fm_type) :: avamat, avcmat, cpscr, cvcmat, vavec, &
193 vcvec
194 TYPE(cp_fm_type), DIMENSION(:), POINTER :: cpmos, evect
195 TYPE(cp_fm_type), POINTER :: mos, mos2, mosa, mosa2
196 TYPE(cp_logger_type), POINTER :: logger
197 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_fx, matrix_gx, matrix_hfx, &
198 matrix_hfx_admm, matrix_hfx_admm_asymm, matrix_hfx_asymm, matrix_hx, matrix_p, &
199 matrix_p_admm, matrix_px1, matrix_px1_admm, matrix_px1_admm_asymm, matrix_px1_asymm, &
200 matrix_s, matrix_s_aux_fit, matrix_wx1, mdum, mfx, mgx
201 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: mhe, mpe, mpga
202 TYPE(dbcsr_type), POINTER :: dbwork, dbwork_asymm
203 TYPE(dft_control_type), POINTER :: dft_control
204 TYPE(hartree_local_type), POINTER :: hartree_local
205 TYPE(hfx_type), DIMENSION(:, :), POINTER :: x_data
206 TYPE(local_rho_type), POINTER :: local_rho_set, local_rho_set_admm, local_rho_set_f, &
207 local_rho_set_f_admm, local_rho_set_g, local_rho_set_g_admm
208 TYPE(mp_para_env_type), POINTER :: para_env
209 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
210 POINTER :: sab, sab_aux_fit, sab_orb, sap_oce
211 TYPE(oce_matrix_type), POINTER :: oce
212 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
213 TYPE(pw_c1d_gs_type) :: rhox_tot_gspace, xv_hartree_gspace
214 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g_aux, rhox_g, rhox_g_aux, rhoxx_g
215 TYPE(pw_env_type), POINTER :: pw_env
216 TYPE(pw_poisson_type), POINTER :: poisson_env
217 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
218 TYPE(pw_r3d_rs_type) :: xv_hartree_rspace
219 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: fxc_rho, fxc_tau, gxc_rho, gxc_tau, &
220 rho_r_aux, rhox_r, rhox_r_aux, rhoxx_r
221 TYPE(qs_force_type), DIMENSION(:), POINTER :: force
222 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
223 TYPE(qs_ks_env_type), POINTER :: ks_env
224 TYPE(qs_rho_type), POINTER :: rho, rho_aux_fit, rhox, rhox_aux
225 TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set, rho_atom_set_f, &
226 rho_atom_set_g
227 TYPE(section_vals_type), POINTER :: hfx_section, xc_section
228 TYPE(task_list_type), POINTER :: task_list
229 TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
230
231 CALL timeset(routinen, handle)
232
233 logger => cp_get_default_logger()
234 IF (logger%para_env%is_source()) THEN
235 iounit = cp_logger_get_default_unit_nr(logger, local=.true.)
236 ELSE
237 iounit = -1
238 END IF
239
240 CALL get_qs_env(qs_env, dft_control=dft_control)
241 tddfpt_control => dft_control%tddfpt2_control
242 nspins = dft_control%nspins
243 is_rks_triplets = tddfpt_control%rks_triplets .AND. (nspins == 1)
244 IF (tddfpt_control%spinflip == no_sf_tddfpt) THEN
245 do_sf = .false.
246 ELSE
247 do_sf = .true.
248 END IF
249 cpassert(tddfpt_control%kernel == tddfpt_kernel_full)
250 do_hfx = tddfpt_control%do_hfx
251 do_hfxsr = tddfpt_control%do_hfxsr
252 do_hfxlr = tddfpt_control%do_hfxlr
253 do_admm = tddfpt_control%do_admm
254 gapw = dft_control%qs_control%gapw
255 gapw_xc = dft_control%qs_control%gapw_xc
256
257 evect => ex_env%evect
258 matrix_px1 => ex_env%matrix_px1
259 matrix_px1_admm => ex_env%matrix_px1_admm
260 matrix_px1_asymm => ex_env%matrix_px1_asymm
261 matrix_px1_admm_asymm => ex_env%matrix_px1_admm_asymm
262
263 focc = 1.0_dp
264 IF (nspins == 2) focc = 0.5_dp
265 nsev = SIZE(evect, 1)
266 DO ispin = 1, nsev
267 CALL cp_fm_get_info(evect(ispin), ncol_global=nactive(ispin))
268 ! Calculate (C*X^T + X*C^T)/2
269 CALL dbcsr_set(matrix_px1(ispin)%matrix, 0.0_dp)
270 CALL cp_dbcsr_plus_fm_fm_t(matrix_px1(ispin)%matrix, &
271 matrix_v=evect(ispin), &
272 matrix_g=gs_mos(ispin)%mos_active, &
273 ncol=nactive(ispin), alpha=2.0_dp*focc, symmetry_mode=1)
274
275 ! Calculate (C*X^T - X*C^T)/2
276 CALL dbcsr_set(matrix_px1_asymm(ispin)%matrix, 0.0_dp)
277 CALL cp_dbcsr_plus_fm_fm_t(matrix_px1_asymm(ispin)%matrix, &
278 matrix_v=gs_mos(ispin)%mos_active, &
279 matrix_g=evect(ispin), &
280 ncol=nactive(ispin), alpha=2.0_dp*focc, &
281 symmetry_mode=-1)
282 END DO
283 !
284 CALL get_qs_env(qs_env, ks_env=ks_env, pw_env=pw_env, para_env=para_env)
285 !
286 NULLIFY (hartree_local, local_rho_set, local_rho_set_admm)
287 IF (gapw .OR. gapw_xc) THEN
288 IF (nspins == 2) THEN
289 DO ispin = 1, nsev
290 CALL dbcsr_scale(matrix_px1(ispin)%matrix, 2.0_dp)
291 END DO
292 END IF
293 CALL get_qs_env(qs_env, &
294 atomic_kind_set=atomic_kind_set, &
295 qs_kind_set=qs_kind_set)
296 CALL local_rho_set_create(local_rho_set)
297 CALL allocate_rho_atom_internals(local_rho_set%rho_atom_set, atomic_kind_set, &
298 qs_kind_set, dft_control, para_env)
299 IF (gapw) THEN
300 CALL get_qs_env(qs_env, natom=natom)
301 CALL init_rho0(local_rho_set, qs_env, dft_control%qs_control%gapw_control, &
302 zcore=0.0_dp)
303 CALL rho0_s_grid_create(pw_env, local_rho_set%rho0_mpole)
304 CALL hartree_local_create(hartree_local)
305 CALL init_coulomb_local(hartree_local, natom)
306 END IF
307
308 CALL get_qs_env(qs_env=qs_env, oce=oce, sap_oce=sap_oce, sab_orb=sab)
309 CALL create_oce_set(oce)
310 CALL get_qs_env(qs_env=qs_env, nkind=nkind, particle_set=particle_set)
311 CALL allocate_oce_set(oce, nkind)
312 eps_fit = dft_control%qs_control%gapw_control%eps_fit
313 CALL build_oce_matrices(oce%intac, .true., 1, qs_kind_set, particle_set, &
314 sap_oce, eps_fit)
315 CALL set_qs_env(qs_env, oce=oce)
316
317 mpga(1:nsev, 1:1) => matrix_px1(1:nsev)
318 CALL calculate_rho_atom_coeff(qs_env, mpga, local_rho_set%rho_atom_set, &
319 qs_kind_set, oce, sab, para_env)
320 CALL prepare_gapw_den(qs_env, local_rho_set, do_rho0=gapw)
321 !
322 CALL local_rho_set_create(local_rho_set_f)
323 CALL allocate_rho_atom_internals(local_rho_set_f%rho_atom_set, atomic_kind_set, &
324 qs_kind_set, dft_control, para_env)
325 CALL calculate_rho_atom_coeff(qs_env, mpga, local_rho_set_f%rho_atom_set, &
326 qs_kind_set, oce, sab, para_env)
327 CALL prepare_gapw_den(qs_env, local_rho_set_f, do_rho0=.false.)
328 !
329 CALL local_rho_set_create(local_rho_set_g)
330 CALL allocate_rho_atom_internals(local_rho_set_g%rho_atom_set, atomic_kind_set, &
331 qs_kind_set, dft_control, para_env)
332 CALL calculate_rho_atom_coeff(qs_env, mpga, local_rho_set_g%rho_atom_set, &
333 qs_kind_set, oce, sab, para_env)
334 CALL prepare_gapw_den(qs_env, local_rho_set_g, do_rho0=.false.)
335 IF (nspins == 2) THEN
336 DO ispin = 1, nsev
337 CALL dbcsr_scale(matrix_px1(ispin)%matrix, 0.5_dp)
338 END DO
339 END IF
340 END IF
341 !
342 IF (do_admm) THEN
343 CALL get_qs_env(qs_env, admm_env=admm_env)
344 nao_aux = admm_env%nao_aux_fit
345 nao = admm_env%nao_orb
346 ! Fit the symmetrized and antisymmetrized matrices
347 DO ispin = 1, nsev
348
349 CALL copy_dbcsr_to_fm(matrix_px1(ispin)%matrix, admm_env%work_orb_orb)
350 CALL parallel_gemm('N', 'N', nao_aux, nao, nao, &
351 1.0_dp, admm_env%A, admm_env%work_orb_orb, 0.0_dp, &
352 admm_env%work_aux_orb)
353 CALL parallel_gemm('N', 'T', nao_aux, nao_aux, nao, &
354 1.0_dp, admm_env%work_aux_orb, admm_env%A, 0.0_dp, &
355 admm_env%work_aux_aux)
356 CALL copy_fm_to_dbcsr(admm_env%work_aux_aux, matrix_px1_admm(ispin)%matrix, &
357 keep_sparsity=.true.)
358
359 CALL copy_dbcsr_to_fm(matrix_px1_asymm(ispin)%matrix, admm_env%work_orb_orb)
360 CALL parallel_gemm('N', 'N', nao_aux, nao, nao, &
361 1.0_dp, admm_env%A, admm_env%work_orb_orb, 0.0_dp, &
362 admm_env%work_aux_orb)
363 CALL parallel_gemm('N', 'T', nao_aux, nao_aux, nao, &
364 1.0_dp, admm_env%work_aux_orb, admm_env%A, 0.0_dp, &
365 admm_env%work_aux_aux)
366 CALL copy_fm_to_dbcsr(admm_env%work_aux_aux, matrix_px1_admm_asymm(ispin)%matrix, &
367 keep_sparsity=.true.)
368 END DO
369 !
370 IF (admm_env%do_gapw) THEN
371 IF (do_admm .AND. tddfpt_control%admm_xc_correction) THEN
372 IF (admm_env%aux_exch_func == do_admm_aux_exch_func_none) THEN
373 ! nothing to do
374 ELSE
375 CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set)
376 CALL local_rho_set_create(local_rho_set_admm)
377 CALL allocate_rho_atom_internals(local_rho_set_admm%rho_atom_set, atomic_kind_set, &
378 admm_env%admm_gapw_env%admm_kind_set, dft_control, para_env)
379 mpga(1:nsev, 1:1) => matrix_px1_admm(1:nsev)
380 CALL get_admm_env(admm_env, sab_aux_fit=sab_aux_fit)
381 CALL calculate_rho_atom_coeff(qs_env, mpga, local_rho_set_admm%rho_atom_set, &
382 admm_env%admm_gapw_env%admm_kind_set, &
383 admm_env%admm_gapw_env%oce, sab_aux_fit, para_env)
384 CALL prepare_gapw_den(qs_env, local_rho_set_admm, do_rho0=.false., &
385 kind_set_external=admm_env%admm_gapw_env%admm_kind_set)
386 !
387 CALL local_rho_set_create(local_rho_set_f_admm)
388 CALL allocate_rho_atom_internals(local_rho_set_f_admm%rho_atom_set, atomic_kind_set, &
389 admm_env%admm_gapw_env%admm_kind_set, dft_control, para_env)
390 CALL calculate_rho_atom_coeff(qs_env, mpga, local_rho_set_f_admm%rho_atom_set, &
391 admm_env%admm_gapw_env%admm_kind_set, &
392 admm_env%admm_gapw_env%oce, sab_aux_fit, para_env)
393 CALL prepare_gapw_den(qs_env, local_rho_set_f_admm, do_rho0=.false., &
394 kind_set_external=admm_env%admm_gapw_env%admm_kind_set)
395 !
396 CALL local_rho_set_create(local_rho_set_g_admm)
397 CALL allocate_rho_atom_internals(local_rho_set_g_admm%rho_atom_set, atomic_kind_set, &
398 admm_env%admm_gapw_env%admm_kind_set, dft_control, para_env)
399 CALL calculate_rho_atom_coeff(qs_env, mpga, local_rho_set_g_admm%rho_atom_set, &
400 admm_env%admm_gapw_env%admm_kind_set, &
401 admm_env%admm_gapw_env%oce, sab_aux_fit, para_env)
402 CALL prepare_gapw_den(qs_env, local_rho_set_g_admm, do_rho0=.false., &
403 kind_set_external=admm_env%admm_gapw_env%admm_kind_set)
404 END IF
405 END IF
406 END IF
407 END IF
408 !
409 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
410 poisson_env=poisson_env)
411
412 ALLOCATE (rhox_r(nsev), rhox_g(nsev))
413 DO ispin = 1, SIZE(evect, 1)
414 CALL auxbas_pw_pool%create_pw(rhox_r(ispin))
415 CALL auxbas_pw_pool%create_pw(rhox_g(ispin))
416 END DO
417 CALL auxbas_pw_pool%create_pw(rhox_tot_gspace)
418
419 CALL pw_zero(rhox_tot_gspace)
420 DO ispin = 1, nsev
421 ! Calculate gridpoint values of the density associated to 2*matrix_px1 = C*X^T + X*C^T
422 IF (nspins == 2) CALL dbcsr_scale(matrix_px1(ispin)%matrix, 2.0_dp)
423 CALL calculate_rho_elec(ks_env=ks_env, matrix_p=matrix_px1(ispin)%matrix, &
424 rho=rhox_r(ispin), rho_gspace=rhox_g(ispin), &
425 soft_valid=gapw)
426 ! rhox_tot_gspace contains the values on the grid points of rhox = sum_munu 4D^X_munu*mu(r)*nu(r)
427 CALL pw_axpy(rhox_g(ispin), rhox_tot_gspace)
428 ! Recover matrix_px1 = (C*X^T + X*C^T)/2
429 IF (nspins == 2) CALL dbcsr_scale(matrix_px1(ispin)%matrix, 0.5_dp)
430 END DO
431
432 IF (gapw_xc) THEN
433 ALLOCATE (rhoxx_r(nsev), rhoxx_g(nsev))
434 DO ispin = 1, nsev
435 CALL auxbas_pw_pool%create_pw(rhoxx_r(ispin))
436 CALL auxbas_pw_pool%create_pw(rhoxx_g(ispin))
437 END DO
438 DO ispin = 1, nsev
439 IF (nspins == 2) CALL dbcsr_scale(matrix_px1(ispin)%matrix, 2.0_dp)
440 CALL calculate_rho_elec(ks_env=ks_env, matrix_p=matrix_px1(ispin)%matrix, &
441 rho=rhoxx_r(ispin), rho_gspace=rhoxx_g(ispin), &
442 soft_valid=gapw_xc)
443 IF (nspins == 2) CALL dbcsr_scale(matrix_px1(ispin)%matrix, 0.5_dp)
444 END DO
445 END IF
446
447 CALL get_qs_env(qs_env, matrix_s=matrix_s, force=force)
448
449 IF (.NOT. (is_rks_triplets .OR. do_sf)) THEN
450 CALL auxbas_pw_pool%create_pw(xv_hartree_rspace)
451 CALL auxbas_pw_pool%create_pw(xv_hartree_gspace)
452 ! calculate associated hartree potential
453 IF (gapw) THEN
454 CALL pw_axpy(local_rho_set%rho0_mpole%rho0_s_gs, rhox_tot_gspace)
455 IF (ASSOCIATED(local_rho_set%rho0_mpole%rhoz_cneo_s_gs)) THEN
456 CALL pw_axpy(local_rho_set%rho0_mpole%rhoz_cneo_s_gs, rhox_tot_gspace)
457 END IF
458 END IF
459 CALL pw_poisson_solve(poisson_env, rhox_tot_gspace, xehartree, &
460 xv_hartree_gspace)
461 CALL pw_transfer(xv_hartree_gspace, xv_hartree_rspace)
462 CALL pw_scale(xv_hartree_rspace, xv_hartree_rspace%pw_grid%dvol)
463 !
464 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
465 NULLIFY (matrix_hx)
466 CALL dbcsr_allocate_matrix_set(matrix_hx, nspins)
467 DO ispin = 1, nspins
468 ALLOCATE (matrix_hx(ispin)%matrix)
469 CALL dbcsr_create(matrix_hx(ispin)%matrix, template=matrix_s(1)%matrix)
470 CALL dbcsr_copy(matrix_hx(ispin)%matrix, matrix_s(1)%matrix)
471 CALL dbcsr_set(matrix_hx(ispin)%matrix, 0.0_dp)
472 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=xv_hartree_rspace, &
473 pmat=matrix_px1(ispin), hmat=matrix_hx(ispin), &
474 gapw=gapw, calculate_forces=.true.)
475 END DO
476 IF (debug_forces) THEN
477 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
478 CALL para_env%sum(fodeb)
479 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Dx*dKh[Dx] ", fodeb
480 END IF
481 IF (gapw) THEN
482 IF (debug_forces) fodeb(1:3) = force(1)%g0s_Vh_elec(1:3, 1)
483 CALL vh_1c_gg_integrals(qs_env, eh1c, hartree_local%ecoul_1c, local_rho_set, para_env, tddft=.true., &
484 core_2nd=.true.)
485 IF (nspins == 1) THEN
486 kval = 1.0_dp
487 ELSE
488 kval = 0.5_dp
489 END IF
490 CALL integrate_vhg0_rspace(qs_env, xv_hartree_rspace, para_env, calculate_forces=.true., &
491 local_rho_set=local_rho_set, kforce=kval)
492 IF (debug_forces) THEN
493 fodeb(1:3) = force(1)%g0s_Vh_elec(1:3, 1) - fodeb(1:3)
494 CALL para_env%sum(fodeb)
495 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Dx*dKh[Dx]PAWg0", fodeb
496 END IF
497 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
498 CALL update_ks_atom(qs_env, matrix_hx, matrix_px1, forces=.true., &
499 rho_atom_external=local_rho_set%rho_atom_set)
500 IF (debug_forces) THEN
501 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
502 CALL para_env%sum(fodeb)
503 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Dx*dKh[Dx]PAW", fodeb
504 END IF
505 END IF
506 END IF
507
508 ! XC
509 IF (full_kernel%do_exck) THEN
510 cpabort("NYA")
511 END IF
512 NULLIFY (fxc_rho, fxc_tau, gxc_rho, gxc_tau)
513 xc_section => full_kernel%xc_section
514 CALL section_vals_val_get(xc_section, "XC_FUNCTIONAL%_SECTION_PARAMETERS_", &
515 i_val=myfun)
516 IF (.NOT. ((myfun == xc_none) .OR. (tddfpt_control%spinflip == tddfpt_sf_col))) THEN
517 SELECT CASE (ex_env%xc_kernel_method)
519 do_analytic = .true.
520 do_numeric = .true.
522 do_analytic = .true.
523 do_numeric = .false.
525 do_analytic = .false.
526 do_numeric = .true.
527 CASE DEFAULT
528 cpabort("invalid xc_kernel_method")
529 END SELECT
530 order = ex_env%diff_order
531 eps_delta = ex_env%eps_delta_rho
532
533 IF (gapw_xc) THEN
534 CALL get_qs_env(qs_env=qs_env, ks_env=ks_env, rho_xc=rho)
535 ELSE
536 CALL get_qs_env(qs_env=qs_env, ks_env=ks_env, rho=rho)
537 END IF
538 CALL qs_rho_get(rho, rho_ao=matrix_p)
539 NULLIFY (rhox)
540 ALLOCATE (rhox)
541 ! Create rhox object to collect all information on matrix_px1, including its values on the
542 ! grid points
543 CALL qs_rho_create(rhox)
544 IF (gapw_xc) THEN
545 CALL qs_rho_set(rho_struct=rhox, rho_ao=matrix_px1, rho_r=rhoxx_r, rho_g=rhoxx_g, &
546 rho_r_valid=.true., rho_g_valid=.true.)
547 ELSE
548 CALL qs_rho_set(rho_struct=rhox, rho_ao=matrix_px1, rho_r=rhox_r, rho_g=rhox_g, &
549 rho_r_valid=.true., rho_g_valid=.true.)
550 END IF
551 ! Calculate the exchange-correlation kernel derivative contribution, notice that for open-shell
552 ! rhox_r contains a factor of 2!
553 IF (do_analytic .AND. .NOT. do_numeric) THEN
554 IF (.NOT. do_sf) THEN
555 cpabort("Analytic 3rd EXC derivatives not available")
556 ELSE !TODO
557 CALL qs_fgxc_analytic(rho, rhox, xc_section, auxbas_pw_pool, &
558 fxc_rho, fxc_tau, gxc_rho, gxc_tau, spinflip=do_sf)
559 END IF
560 ELSEIF (do_numeric) THEN
561 IF (do_analytic) THEN
562 CALL qs_fgxc_gdiff(ks_env, rho, rhox, xc_section, order, eps_delta, is_rks_triplets, &
563 fxc_rho, fxc_tau, gxc_rho, gxc_tau, spinflip=do_sf)
564 ELSE
565 CALL qs_fgxc_create(ks_env, rho, rhox, xc_section, order, is_rks_triplets, &
566 fxc_rho, fxc_tau, gxc_rho, gxc_tau)
567 END IF
568 ELSE
569 cpabort("FHXC forces analytic/numeric")
570 END IF
571
572 ! Well, this is a hack :-(
573 ! When qs_rho_set() was called on rhox it assumed ownership of the passed arrays.
574 ! However, these arrays actually belong to ex_env. Hence, we can not call qs_rho_release()
575 ! because this would release the arrays. Instead we're simply going to deallocate rhox.
576 DEALLOCATE (rhox)
577
578 IF (nspins == 2) THEN
579 DO ispin = 1, nspins
580 CALL pw_scale(gxc_rho(ispin), 0.5_dp)
581 IF (ASSOCIATED(gxc_tau)) CALL pw_scale(gxc_tau(ispin), 0.5_dp)
582 END DO
583 END IF
584 IF (gapw .OR. gapw_xc) THEN
585 IF (do_analytic .AND. .NOT. do_numeric) THEN
586 cpabort("Analytic 3rd EXC derivatives not available")
587 ELSEIF (do_numeric) THEN
588 IF (do_analytic) THEN
589 CALL gfxc_atom_diff(qs_env, ex_env%local_rho_set%rho_atom_set, &
590 local_rho_set_f%rho_atom_set, local_rho_set_g%rho_atom_set, &
591 qs_kind_set, xc_section, is_rks_triplets, order, eps_delta)
592 ELSE
593 CALL calculate_gfxc_atom(qs_env, ex_env%local_rho_set%rho_atom_set, &
594 local_rho_set_f%rho_atom_set, local_rho_set_g%rho_atom_set, &
595 qs_kind_set, xc_section, is_rks_triplets, order)
596 END IF
597 ELSE
598 cpabort("FHXC forces analytic/numeric")
599 END IF
600 END IF
601
602 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
603 NULLIFY (matrix_fx)
604 CALL dbcsr_allocate_matrix_set(matrix_fx, SIZE(fxc_rho))
605 DO ispin = 1, SIZE(fxc_rho, 1)
606 ALLOCATE (matrix_fx(ispin)%matrix)
607 CALL dbcsr_create(matrix_fx(ispin)%matrix, template=matrix_s(1)%matrix)
608 CALL dbcsr_copy(matrix_fx(ispin)%matrix, matrix_s(1)%matrix)
609 CALL dbcsr_set(matrix_fx(ispin)%matrix, 0.0_dp)
610 CALL pw_scale(fxc_rho(ispin), fxc_rho(ispin)%pw_grid%dvol)
611 ! Calculate 2sum_sigmatau<munu|fxc|sigmatau>D^X_sigmatau
612 ! fxc_rho here containes a factor of 2
613 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=fxc_rho(ispin), &
614 pmat=matrix_px1(ispin), hmat=matrix_fx(ispin), &
615 gapw=(gapw .OR. gapw_xc), calculate_forces=.true.)
616 END DO
617 IF (debug_forces) THEN
618 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
619 CALL para_env%sum(fodeb)
620 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Dx*dfxc[Dx] ", fodeb
621 END IF
622
623 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
624 NULLIFY (matrix_gx)
625 CALL dbcsr_allocate_matrix_set(matrix_gx, nspins)
626 ! Calculate exchange-correlation kernel derivative 2<D^X D^X|gxc|mu nu>
627 ! gxc comes with a factor of 4, so a factor of 1/2 is introduced
628 DO ispin = 1, nspins
629 ALLOCATE (matrix_gx(ispin)%matrix)
630 CALL dbcsr_create(matrix_gx(ispin)%matrix, template=matrix_s(1)%matrix)
631 CALL dbcsr_copy(matrix_gx(ispin)%matrix, matrix_s(1)%matrix)
632 CALL dbcsr_set(matrix_gx(ispin)%matrix, 0.0_dp)
633 CALL pw_scale(gxc_rho(ispin), gxc_rho(ispin)%pw_grid%dvol)
634 CALL pw_scale(gxc_rho(ispin), 0.5_dp)
635 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=gxc_rho(ispin), &
636 pmat=matrix_p(ispin), hmat=matrix_gx(ispin), &
637 gapw=(gapw .OR. gapw_xc), calculate_forces=.true.)
638 CALL dbcsr_scale(matrix_gx(ispin)%matrix, 2.0_dp)
639 END DO
640 IF (debug_forces) THEN
641 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
642 CALL para_env%sum(fodeb)
643 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Dx*dgxc[Dx]", fodeb
644 END IF
645 CALL qs_fgxc_release(ks_env, fxc_rho, fxc_tau, gxc_rho, gxc_tau)
646
647 IF (gapw .OR. gapw_xc) THEN
648 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
649 CALL update_ks_atom(qs_env, matrix_fx, matrix_px1, forces=.true., tddft=.true., &
650 rho_atom_external=local_rho_set_f%rho_atom_set, &
651 kintegral=1.0_dp, kforce=1.0_dp)
652 IF (debug_forces) THEN
653 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
654 CALL para_env%sum(fodeb)
655 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Dx*dfxc[Dx]PAW ", fodeb
656 END IF
657 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
658 IF (nspins == 1) THEN
659 CALL update_ks_atom(qs_env, matrix_gx, matrix_p, forces=.true., tddft=.true., &
660 rho_atom_external=local_rho_set_g%rho_atom_set, &
661 kscale=0.5_dp)
662 ELSE
663 CALL update_ks_atom(qs_env, matrix_gx, matrix_p, forces=.true., &
664 rho_atom_external=local_rho_set_g%rho_atom_set, &
665 kintegral=0.5_dp, kforce=0.25_dp)
666 END IF
667 IF (debug_forces) THEN
668 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
669 CALL para_env%sum(fodeb)
670 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Dx*dgxc[Dx]PAW ", fodeb
671 END IF
672 END IF
673 END IF
674
675 ! ADMM XC correction Exc[rho_admm]
676 IF (do_admm .AND. tddfpt_control%admm_xc_correction .AND. (tddfpt_control%spinflip /= tddfpt_sf_col)) THEN
677 IF (admm_env%aux_exch_func == do_admm_aux_exch_func_none) THEN
678 ! nothing to do
679 ELSE
680 IF (.NOT. tddfpt_control%admm_symm) THEN
681 CALL cp_warn(__location__, "Forces need symmetric ADMM kernel corrections")
682 cpabort("ADMM KERNEL CORRECTION")
683 END IF
684 xc_section => admm_env%xc_section_aux
685 CALL get_admm_env(admm_env, rho_aux_fit=rho_aux_fit, matrix_s_aux_fit=matrix_s_aux_fit, &
686 task_list_aux_fit=task_list)
687 basis_type = "AUX_FIT"
688 IF (admm_env%do_gapw) THEN
689 basis_type = "AUX_FIT_SOFT"
690 task_list => admm_env%admm_gapw_env%task_list
691 END IF
692 !
693 NULLIFY (mfx, mgx)
694 CALL dbcsr_allocate_matrix_set(mfx, nsev)
695 CALL dbcsr_allocate_matrix_set(mgx, nspins)
696 DO ispin = 1, nsev
697 ALLOCATE (mfx(ispin)%matrix)
698 CALL dbcsr_create(mfx(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix)
699 CALL dbcsr_copy(mfx(ispin)%matrix, matrix_s_aux_fit(1)%matrix)
700 CALL dbcsr_set(mfx(ispin)%matrix, 0.0_dp)
701 END DO
702 DO ispin = 1, nspins
703 ALLOCATE (mgx(ispin)%matrix)
704 CALL dbcsr_create(mgx(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix)
705 CALL dbcsr_copy(mgx(ispin)%matrix, matrix_s_aux_fit(1)%matrix)
706 CALL dbcsr_set(mgx(ispin)%matrix, 0.0_dp)
707 END DO
708
709 ! ADMM density and response density
710 NULLIFY (rho_g_aux, rho_r_aux, rhox_g_aux, rhox_r_aux)
711 CALL qs_rho_get(rho_aux_fit, rho_r=rho_r_aux, rho_g=rho_g_aux)
712 CALL qs_rho_get(rho_aux_fit, rho_ao=matrix_p_admm)
713 ! rhox_aux
714 ALLOCATE (rhox_r_aux(nsev), rhox_g_aux(nsev))
715 DO ispin = 1, nsev
716 CALL auxbas_pw_pool%create_pw(rhox_r_aux(ispin))
717 CALL auxbas_pw_pool%create_pw(rhox_g_aux(ispin))
718 END DO
719 DO ispin = 1, nsev
720 CALL calculate_rho_elec(ks_env=ks_env, matrix_p=matrix_px1_admm(ispin)%matrix, &
721 rho=rhox_r_aux(ispin), rho_gspace=rhox_g_aux(ispin), &
722 basis_type=basis_type, &
723 task_list_external=task_list)
724 END DO
725 !
726 NULLIFY (rhox_aux)
727 ALLOCATE (rhox_aux)
728 CALL qs_rho_create(rhox_aux)
729 CALL qs_rho_set(rho_struct=rhox_aux, rho_ao=matrix_px1_admm, &
730 rho_r=rhox_r_aux, rho_g=rhox_g_aux, &
731 rho_r_valid=.true., rho_g_valid=.true.)
732 IF (do_analytic .AND. .NOT. do_numeric) THEN
733 cpabort("Analytic 3rd derivatives of EXC not available")
734 ELSEIF (do_numeric) THEN
735 IF (do_analytic) THEN
736 CALL qs_fgxc_gdiff(ks_env, rho_aux_fit, rhox_aux, xc_section, order, eps_delta, &
737 is_rks_triplets, fxc_rho, fxc_tau, gxc_rho, gxc_tau)
738 ELSE
739 CALL qs_fgxc_create(ks_env, rho_aux_fit, rhox_aux, xc_section, &
740 order, is_rks_triplets, fxc_rho, fxc_tau, gxc_rho, gxc_tau)
741 END IF
742 ELSE
743 cpabort("FHXC forces analytic/numeric")
744 END IF
745
746 ! Well, this is a hack :-(
747 ! When qs_rho_set() was called on rhox_aux it assumed ownership of the passed arrays.
748 ! However, these arrays actually belong to ex_env. Hence, we can not call qs_rho_release()
749 ! because this would release the arrays. Instead we're simply going to deallocate rhox_aux.
750 DEALLOCATE (rhox_aux)
751
752 DO ispin = 1, nsev
753 CALL auxbas_pw_pool%give_back_pw(rhox_r_aux(ispin))
754 CALL auxbas_pw_pool%give_back_pw(rhox_g_aux(ispin))
755 END DO
756 DEALLOCATE (rhox_r_aux, rhox_g_aux)
757 fscal = 1.0_dp
758 IF (nspins == 2) fscal = 2.0_dp
759 !
760 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
761 DO ispin = 1, nsev
762 CALL pw_scale(fxc_rho(ispin), fxc_rho(ispin)%pw_grid%dvol)
763 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=fxc_rho(ispin), &
764 hmat=mfx(ispin), &
765 pmat=matrix_px1_admm(ispin), &
766 basis_type=basis_type, &
767 calculate_forces=.true., &
768 force_adm=fscal, &
769 task_list_external=task_list)
770 END DO
771 IF (debug_forces) THEN
772 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
773 CALL para_env%sum(fodeb)
774 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Dx*dfxc[Dx]ADMM", fodeb
775 END IF
776
777 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
778 DO ispin = 1, nsev
779 CALL pw_scale(gxc_rho(ispin), gxc_rho(ispin)%pw_grid%dvol)
780 CALL pw_scale(gxc_rho(ispin), 0.5_dp)
781 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=gxc_rho(ispin), &
782 hmat=mgx(ispin), &
783 pmat=matrix_p_admm(ispin), &
784 basis_type=basis_type, &
785 calculate_forces=.true., &
786 force_adm=fscal, &
787 task_list_external=task_list)
788 CALL dbcsr_scale(mgx(ispin)%matrix, 2.0_dp)
789 END DO
790 IF (debug_forces) THEN
791 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
792 CALL para_env%sum(fodeb)
793 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Dx*dgxc[Dx]ADMM", fodeb
794 END IF
795 CALL qs_fgxc_release(ks_env, fxc_rho, fxc_tau, gxc_rho, gxc_tau)
796 !
797 IF (admm_env%do_gapw) THEN
798 CALL get_admm_env(admm_env, sab_aux_fit=sab_aux_fit)
799 rho_atom_set => admm_env%admm_gapw_env%local_rho_set%rho_atom_set
800 rho_atom_set_f => local_rho_set_f_admm%rho_atom_set
801 rho_atom_set_g => local_rho_set_g_admm%rho_atom_set
802
803 IF (do_analytic .AND. .NOT. do_numeric) THEN
804 cpabort("Analytic 3rd EXC derivatives not available")
805 ELSEIF (do_numeric) THEN
806 IF (do_analytic) THEN
807 CALL gfxc_atom_diff(qs_env, rho_atom_set, &
808 rho_atom_set_f, rho_atom_set_g, &
809 admm_env%admm_gapw_env%admm_kind_set, xc_section, &
810 is_rks_triplets, order, eps_delta)
811 ELSE
812 CALL calculate_gfxc_atom(qs_env, rho_atom_set, &
813 rho_atom_set_f, rho_atom_set_g, &
814 admm_env%admm_gapw_env%admm_kind_set, xc_section, &
815 is_rks_triplets, order)
816 END IF
817 ELSE
818 cpabort("FHXC forces analytic/numeric")
819 END IF
820
821 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
822 IF (nspins == 1) THEN
823 CALL update_ks_atom(qs_env, mfx, matrix_px1_admm, forces=.true., &
824 rho_atom_external=rho_atom_set_f, &
825 kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
826 oce_external=admm_env%admm_gapw_env%oce, sab_external=sab_aux_fit, &
827 kintegral=2.0_dp, kforce=0.5_dp)
828 ELSE
829 CALL update_ks_atom(qs_env, mfx, matrix_px1_admm, forces=.true., &
830 rho_atom_external=rho_atom_set_f, &
831 kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
832 oce_external=admm_env%admm_gapw_env%oce, sab_external=sab_aux_fit, &
833 kintegral=2.0_dp, kforce=1.0_dp)
834 END IF
835 IF (debug_forces) THEN
836 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
837 CALL para_env%sum(fodeb)
838 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Dx*dfxc[Dx]ADMM-PAW ", fodeb
839 END IF
840 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
841 IF (nspins == 1) THEN
842 CALL update_ks_atom(qs_env, mgx, matrix_p, forces=.true., &
843 rho_atom_external=rho_atom_set_g, &
844 kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
845 oce_external=admm_env%admm_gapw_env%oce, sab_external=sab_aux_fit, &
846 kintegral=1.0_dp, kforce=0.5_dp)
847 ELSE
848 CALL update_ks_atom(qs_env, mgx, matrix_p, forces=.true., &
849 rho_atom_external=rho_atom_set_g, &
850 kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
851 oce_external=admm_env%admm_gapw_env%oce, sab_external=sab_aux_fit, &
852 kintegral=1.0_dp, kforce=1.0_dp)
853 END IF
854 IF (debug_forces) THEN
855 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
856 CALL para_env%sum(fodeb)
857 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Dx*dgxc[Dx]ADMM-PAW ", fodeb
858 END IF
859 END IF
860 !
861 ! A' fx A - Forces
862 !
863 IF (debug_forces) fodeb(1:3) = force(1)%overlap_admm(1:3, 1)
864 fval = 2.0_dp*real(nspins, kind=dp)
865 CALL admm_projection_derivative(qs_env, mfx, matrix_px1, fval)
866 IF (debug_forces) THEN
867 fodeb(1:3) = force(1)%overlap_admm(1:3, 1) - fodeb(1:3)
868 CALL para_env%sum(fodeb)
869 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: P*dfXC(P)*S' ", fodeb
870 END IF
871 IF (debug_forces) fodeb(1:3) = force(1)%overlap_admm(1:3, 1)
872 fval = 2.0_dp*real(nspins, kind=dp)
873 CALL admm_projection_derivative(qs_env, mgx, matrix_p, fval)
874 IF (debug_forces) THEN
875 fodeb(1:3) = force(1)%overlap_admm(1:3, 1) - fodeb(1:3)
876 CALL para_env%sum(fodeb)
877 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: P*dgXC(P)*S' ", fodeb
878 END IF
879 !
880 ! Add ADMM fx/gx to the full basis fx/gx
881 fscal = 1.0_dp
882 IF (nspins == 2) fscal = 2.0_dp
883 nao = admm_env%nao_orb
884 nao_aux = admm_env%nao_aux_fit
885 ALLOCATE (dbwork)
886 CALL dbcsr_create(dbwork, template=matrix_fx(1)%matrix)
887 DO ispin = 1, nsev
888 ! fx
889 CALL cp_dbcsr_sm_fm_multiply(mfx(ispin)%matrix, admm_env%A, &
890 admm_env%work_aux_orb, nao)
891 CALL parallel_gemm('T', 'N', nao, nao, nao_aux, &
892 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
893 admm_env%work_orb_orb)
894 CALL dbcsr_copy(dbwork, matrix_fx(1)%matrix)
895 CALL dbcsr_set(dbwork, 0.0_dp)
896 CALL copy_fm_to_dbcsr(admm_env%work_orb_orb, dbwork, keep_sparsity=.true.)
897 CALL dbcsr_add(matrix_fx(ispin)%matrix, dbwork, 1.0_dp, fscal)
898 ! gx
899 CALL cp_dbcsr_sm_fm_multiply(mgx(ispin)%matrix, admm_env%A, &
900 admm_env%work_aux_orb, nao)
901 CALL parallel_gemm('T', 'N', nao, nao, nao_aux, &
902 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
903 admm_env%work_orb_orb)
904 CALL dbcsr_set(dbwork, 0.0_dp)
905 CALL copy_fm_to_dbcsr(admm_env%work_orb_orb, dbwork, keep_sparsity=.true.)
906 CALL dbcsr_add(matrix_gx(ispin)%matrix, dbwork, 1.0_dp, fscal)
907 END DO
908 CALL dbcsr_release(dbwork)
909 DEALLOCATE (dbwork)
912
913 END IF
914 END IF
915
916 DO ispin = 1, nsev
917 CALL auxbas_pw_pool%give_back_pw(rhox_r(ispin))
918 CALL auxbas_pw_pool%give_back_pw(rhox_g(ispin))
919 END DO
920 DEALLOCATE (rhox_r, rhox_g)
921 CALL auxbas_pw_pool%give_back_pw(rhox_tot_gspace)
922 IF (gapw_xc) THEN
923 DO ispin = 1, nsev
924 CALL auxbas_pw_pool%give_back_pw(rhoxx_r(ispin))
925 CALL auxbas_pw_pool%give_back_pw(rhoxx_g(ispin))
926 END DO
927 DEALLOCATE (rhoxx_r, rhoxx_g)
928 END IF
929 IF (.NOT. (is_rks_triplets .OR. do_sf)) THEN
930 CALL auxbas_pw_pool%give_back_pw(xv_hartree_rspace)
931 CALL auxbas_pw_pool%give_back_pw(xv_hartree_gspace)
932 END IF
933
934 ! HFX
935 IF (do_hfx) THEN
936 NULLIFY (matrix_hfx, matrix_hfx_asymm)
937 CALL dbcsr_allocate_matrix_set(matrix_hfx, nsev)
938 CALL dbcsr_allocate_matrix_set(matrix_hfx_asymm, nsev)
939 DO ispin = 1, nsev
940 ALLOCATE (matrix_hfx(ispin)%matrix)
941 CALL dbcsr_create(matrix_hfx(ispin)%matrix, template=matrix_s(1)%matrix)
942 CALL dbcsr_copy(matrix_hfx(ispin)%matrix, matrix_s(1)%matrix)
943 CALL dbcsr_set(matrix_hfx(ispin)%matrix, 0.0_dp)
944
945 ALLOCATE (matrix_hfx_asymm(ispin)%matrix)
946 CALL dbcsr_create(matrix_hfx_asymm(ispin)%matrix, template=matrix_s(1)%matrix, &
947 matrix_type=dbcsr_type_antisymmetric)
948 CALL dbcsr_complete_redistribute(matrix_hfx(ispin)%matrix, matrix_hfx_asymm(ispin)%matrix)
949 END DO
950 !
951 xc_section => full_kernel%xc_section
952 hfx_section => section_vals_get_subs_vals(xc_section, "HF")
953 CALL section_vals_get(hfx_section, n_repetition=n_rep_hf)
954 cpassert(n_rep_hf == 1)
955 CALL section_vals_val_get(hfx_section, "TREAT_LSD_IN_CORE", l_val=hfx_treat_lsd_in_core, &
956 i_rep_section=1)
957 mspin = 1
958 IF (hfx_treat_lsd_in_core) mspin = nsev
959 !
960 CALL get_qs_env(qs_env=qs_env, x_data=x_data, s_mstruct_changed=s_mstruct_changed)
961 distribute_fock_matrix = .true.
962 !
963 IF (do_admm) THEN
964 CALL get_admm_env(qs_env%admm_env, matrix_s_aux_fit=matrix_s_aux_fit)
965 NULLIFY (matrix_hfx_admm, matrix_hfx_admm_asymm)
966 CALL dbcsr_allocate_matrix_set(matrix_hfx_admm, nsev)
967 CALL dbcsr_allocate_matrix_set(matrix_hfx_admm_asymm, nsev)
968 DO ispin = 1, nsev
969 ALLOCATE (matrix_hfx_admm(ispin)%matrix)
970 CALL dbcsr_create(matrix_hfx_admm(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix)
971 CALL dbcsr_copy(matrix_hfx_admm(ispin)%matrix, matrix_s_aux_fit(1)%matrix)
972 CALL dbcsr_set(matrix_hfx_admm(ispin)%matrix, 0.0_dp)
973
974 ALLOCATE (matrix_hfx_admm_asymm(ispin)%matrix)
975 CALL dbcsr_create(matrix_hfx_admm_asymm(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix, &
976 matrix_type=dbcsr_type_antisymmetric)
977 CALL dbcsr_complete_redistribute(matrix_hfx_admm(ispin)%matrix, matrix_hfx_admm_asymm(ispin)%matrix)
978 END DO
979 !
980 NULLIFY (mpe, mhe)
981 ALLOCATE (mpe(nsev, 1), mhe(nsev, 1))
982 DO ispin = 1, nsev
983 mhe(ispin, 1)%matrix => matrix_hfx_admm(ispin)%matrix
984 mpe(ispin, 1)%matrix => matrix_px1_admm(ispin)%matrix
985 END DO
986 IF (x_data(1, 1)%do_hfx_ri) THEN
987 eh1 = 0.0_dp
988 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhe, eh1, rho_ao=mpe, &
989 geometry_did_change=s_mstruct_changed, nspins=nspins, &
990 hf_fraction=x_data(1, 1)%general_parameter%fraction)
991 ELSE
992 DO ispin = 1, mspin
993 eh1 = 0.0
994 CALL integrate_four_center(qs_env, x_data, mhe, eh1, mpe, hfx_section, &
995 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
996 ispin=ispin, nspins=nsev)
997 END DO
998 END IF
999 !anti-symmetric density
1000 DO ispin = 1, nsev
1001 mhe(ispin, 1)%matrix => matrix_hfx_admm_asymm(ispin)%matrix
1002 mpe(ispin, 1)%matrix => matrix_px1_admm_asymm(ispin)%matrix
1003 END DO
1004 IF (x_data(1, 1)%do_hfx_ri) THEN
1005 eh1 = 0.0_dp
1006 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhe, eh1, rho_ao=mpe, &
1007 geometry_did_change=s_mstruct_changed, nspins=nspins, &
1008 hf_fraction=x_data(1, 1)%general_parameter%fraction)
1009 ELSE
1010 DO ispin = 1, mspin
1011 eh1 = 0.0
1012 CALL integrate_four_center(qs_env, x_data, mhe, eh1, mpe, hfx_section, &
1013 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
1014 ispin=ispin, nspins=nsev)
1015 END DO
1016 END IF
1017 !
1018 nao = admm_env%nao_orb
1019 nao_aux = admm_env%nao_aux_fit
1020 ALLOCATE (dbwork, dbwork_asymm)
1021 CALL dbcsr_create(dbwork, template=matrix_hfx(1)%matrix)
1022 CALL dbcsr_create(dbwork_asymm, template=matrix_hfx(1)%matrix, matrix_type=dbcsr_type_antisymmetric)
1023 DO ispin = 1, nsev
1024 CALL cp_dbcsr_sm_fm_multiply(matrix_hfx_admm(ispin)%matrix, admm_env%A, &
1025 admm_env%work_aux_orb, nao)
1026 CALL parallel_gemm('T', 'N', nao, nao, nao_aux, &
1027 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
1028 admm_env%work_orb_orb)
1029 CALL dbcsr_copy(dbwork, matrix_hfx(1)%matrix)
1030 CALL dbcsr_set(dbwork, 0.0_dp)
1031 CALL copy_fm_to_dbcsr(admm_env%work_orb_orb, dbwork, keep_sparsity=.true.)
1032 CALL dbcsr_add(matrix_hfx(ispin)%matrix, dbwork, 1.0_dp, 1.0_dp)
1033 !anti-symmetric case
1034 CALL cp_dbcsr_sm_fm_multiply(matrix_hfx_admm_asymm(ispin)%matrix, admm_env%A, &
1035 admm_env%work_aux_orb, nao)
1036 CALL parallel_gemm('T', 'N', nao, nao, nao_aux, &
1037 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
1038 admm_env%work_orb_orb)
1039 CALL dbcsr_copy(dbwork_asymm, matrix_hfx_asymm(1)%matrix)
1040 CALL dbcsr_set(dbwork_asymm, 0.0_dp)
1041 CALL copy_fm_to_dbcsr(admm_env%work_orb_orb, dbwork_asymm, keep_sparsity=.true.)
1042 CALL dbcsr_add(matrix_hfx_asymm(ispin)%matrix, dbwork_asymm, 1.0_dp, 1.0_dp)
1043 END DO
1044 CALL dbcsr_release(dbwork)
1045 CALL dbcsr_release(dbwork_asymm)
1046 DEALLOCATE (dbwork, dbwork_asymm)
1047 ! forces
1048 ! ADMM Projection force
1049 IF (debug_forces) fodeb(1:3) = force(1)%overlap_admm(1:3, 1)
1050 fval = 4.0_dp*real(nspins, kind=dp)*0.5_dp !0.5 for symm/anti-symm
1051 CALL admm_projection_derivative(qs_env, matrix_hfx_admm, matrix_px1, fval)
1052 CALL admm_projection_derivative(qs_env, matrix_hfx_admm_asymm, matrix_px1_asymm, fval)
1053 IF (debug_forces) THEN
1054 fodeb(1:3) = force(1)%overlap_admm(1:3, 1) - fodeb(1:3)
1055 CALL para_env%sum(fodeb)
1056 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: P*Hx(P)*S' ", fodeb
1057 END IF
1058 !
1059 use_virial = .false.
1060 NULLIFY (mdum)
1061 fval = 2.0_dp*real(nspins, kind=dp)*0.5_dp !0.5 factor because of symemtry/anti-symmetry
1062 ! For SF TDDFT integrate_four_center and derivatives_four_center routines introduce a factor of 1/2
1063 IF (do_sf) fval = fval*2.0_dp
1064 IF (debug_forces) fodeb(1:3) = force(1)%fock_4c(1:3, 1)
1065 DO ispin = 1, nsev
1066 mpe(ispin, 1)%matrix => matrix_px1_admm(ispin)%matrix
1067 END DO
1068 IF (x_data(1, 1)%do_hfx_ri) THEN
1069 CALL hfx_ri_update_forces(qs_env, x_data(1, 1)%ri_data, nspins, &
1070 x_data(1, 1)%general_parameter%fraction, &
1071 rho_ao=mpe, rho_ao_resp=mdum, &
1072 use_virial=use_virial, rescale_factor=fval)
1073 ELSE
1074 CALL derivatives_four_center(qs_env, mpe, mdum, hfx_section, para_env, 1, use_virial, &
1075 adiabatic_rescale_factor=fval, nspins=nsev)
1076 END IF
1077 DO ispin = 1, nsev
1078 mpe(ispin, 1)%matrix => matrix_px1_admm_asymm(ispin)%matrix
1079 END DO
1080 IF (x_data(1, 1)%do_hfx_ri) THEN
1081 CALL hfx_ri_update_forces(qs_env, x_data(1, 1)%ri_data, nspins, &
1082 x_data(1, 1)%general_parameter%fraction, &
1083 rho_ao=mpe, rho_ao_resp=mdum, &
1084 use_virial=use_virial, rescale_factor=fval)
1085 ELSE
1086 CALL derivatives_four_center(qs_env, mpe, mdum, hfx_section, para_env, 1, use_virial, &
1087 adiabatic_rescale_factor=fval, nspins=SIZE(mpe, 1))
1088 END IF
1089 IF (debug_forces) THEN
1090 fodeb(1:3) = force(1)%fock_4c(1:3, 1) - fodeb(1:3)
1091 CALL para_env%sum(fodeb)
1092 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Dx*dhfx'*Dx ", fodeb
1093 END IF
1094 !
1095 DEALLOCATE (mpe, mhe)
1096 !
1097 CALL dbcsr_deallocate_matrix_set(matrix_hfx_admm)
1098 CALL dbcsr_deallocate_matrix_set(matrix_hfx_admm_asymm)
1099 ELSE
1100 NULLIFY (mpe, mhe)
1101 ALLOCATE (mpe(nsev, 1), mhe(nsev, 1))
1102 DO ispin = 1, nsev
1103 mhe(ispin, 1)%matrix => matrix_hfx(ispin)%matrix
1104 mpe(ispin, 1)%matrix => matrix_px1(ispin)%matrix
1105 END DO
1106 IF (x_data(1, 1)%do_hfx_ri) THEN
1107 eh1 = 0.0_dp
1108 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhe, eh1, rho_ao=mpe, &
1109 geometry_did_change=s_mstruct_changed, nspins=nspins, &
1110 hf_fraction=x_data(1, 1)%general_parameter%fraction)
1111 ELSE
1112 DO ispin = 1, mspin
1113 eh1 = 0.0
1114 CALL integrate_four_center(qs_env, x_data, mhe, eh1, mpe, hfx_section, &
1115 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
1116 ispin=ispin, nspins=SIZE(mpe, 1))
1117 END DO
1118 END IF
1119
1120 !anti-symmetric density matrix
1121 DO ispin = 1, nsev
1122 mhe(ispin, 1)%matrix => matrix_hfx_asymm(ispin)%matrix
1123 mpe(ispin, 1)%matrix => matrix_px1_asymm(ispin)%matrix
1124 END DO
1125 IF (x_data(1, 1)%do_hfx_ri) THEN
1126 eh1 = 0.0_dp
1127 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhe, eh1, rho_ao=mpe, &
1128 geometry_did_change=s_mstruct_changed, nspins=nspins, &
1129 hf_fraction=x_data(1, 1)%general_parameter%fraction)
1130 ELSE
1131 DO ispin = 1, mspin
1132 eh1 = 0.0
1133 CALL integrate_four_center(qs_env, x_data, mhe, eh1, mpe, hfx_section, &
1134 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
1135 ispin=ispin, nspins=SIZE(mpe, 1))
1136 END DO
1137 END IF
1138 ! forces
1139 use_virial = .false.
1140 NULLIFY (mdum)
1141 fval = 2.0_dp*real(nspins, kind=dp)*0.5_dp !extra 0.5 factor because of symmetry/antisymemtry
1142 ! For SF TDDFT integrate_four_center and derivatives_four_center routines introduce a factor of 1/2
1143 IF (do_sf) fval = fval*2.0_dp
1144 IF (debug_forces) fodeb(1:3) = force(1)%fock_4c(1:3, 1)
1145 DO ispin = 1, nsev
1146 mpe(ispin, 1)%matrix => matrix_px1(ispin)%matrix
1147 END DO
1148 IF (x_data(1, 1)%do_hfx_ri) THEN
1149 CALL hfx_ri_update_forces(qs_env, x_data(1, 1)%ri_data, nspins, &
1150 x_data(1, 1)%general_parameter%fraction, &
1151 rho_ao=mpe, rho_ao_resp=mdum, &
1152 use_virial=use_virial, rescale_factor=fval)
1153 ELSE
1154 CALL derivatives_four_center(qs_env, mpe, mdum, hfx_section, para_env, 1, use_virial, &
1155 adiabatic_rescale_factor=fval, nspins=SIZE(mpe, 1))
1156 END IF
1157 DO ispin = 1, nsev
1158 mpe(ispin, 1)%matrix => matrix_px1_asymm(ispin)%matrix
1159 END DO
1160 IF (x_data(1, 1)%do_hfx_ri) THEN
1161 CALL hfx_ri_update_forces(qs_env, x_data(1, 1)%ri_data, nspins, &
1162 x_data(1, 1)%general_parameter%fraction, &
1163 rho_ao=mpe, rho_ao_resp=mdum, &
1164 use_virial=use_virial, rescale_factor=fval)
1165 ELSE
1166 CALL derivatives_four_center(qs_env, mpe, mdum, hfx_section, para_env, 1, use_virial, &
1167 adiabatic_rescale_factor=fval, nspins=SIZE(mpe, 1))
1168 END IF
1169 IF (debug_forces) THEN
1170 fodeb(1:3) = force(1)%fock_4c(1:3, 1) - fodeb(1:3)
1171 CALL para_env%sum(fodeb)
1172 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Dx*dhfx*Dx ", fodeb
1173 END IF
1174 !
1175 DEALLOCATE (mpe, mhe)
1176 END IF
1177 fval = 2.0_dp*real(nspins, kind=dp)*0.5_dp !extra 0.5 because of symm/antisymm
1178 ! For SF TDDFT integrate_four_center and derivatives_four_center routines introduce a factor of 1/2
1179 IF (do_sf) fval = fval*2.0_dp
1180 DO ispin = 1, nsev
1181 CALL dbcsr_scale(matrix_hfx(ispin)%matrix, fval)
1182 CALL dbcsr_scale(matrix_hfx_asymm(ispin)%matrix, fval)
1183 END DO
1184 END IF
1185
1186 IF (gapw .OR. gapw_xc) THEN
1187 CALL local_rho_set_release(local_rho_set)
1188 CALL local_rho_set_release(local_rho_set_f)
1189 CALL local_rho_set_release(local_rho_set_g)
1190 IF (gapw) THEN
1191 CALL hartree_local_release(hartree_local)
1192 END IF
1193 END IF
1194 IF (do_admm) THEN
1195 IF (admm_env%do_gapw) THEN
1196 IF (tddfpt_control%admm_xc_correction) THEN
1197 IF (qs_env%admm_env%aux_exch_func /= do_admm_aux_exch_func_none) THEN
1198 CALL local_rho_set_release(local_rho_set_admm)
1199 CALL local_rho_set_release(local_rho_set_f_admm)
1200 CALL local_rho_set_release(local_rho_set_g_admm)
1201 END IF
1202 END IF
1203 END IF
1204 END IF
1205
1206 ! HFX short range
1207 IF (do_hfxsr) THEN
1208 cpabort("HFXSR not implemented")
1209 END IF
1210 ! HFX long range
1211 IF (do_hfxlr) THEN
1212 cpabort("HFXLR not implemented")
1213 END IF
1214
1215 CALL get_qs_env(qs_env, sab_orb=sab_orb)
1216 NULLIFY (matrix_wx1)
1217 CALL dbcsr_allocate_matrix_set(matrix_wx1, nspins)
1218 cpmos => ex_env%cpmos
1219 focc = 2.0_dp
1220 IF (nspins == 2) focc = 1.0_dp
1221
1222 ! Initialize mos and dimensions of occupied space
1223 ! In the following comments mos is referred to as Ca and mos2 as Cb
1224 spin = 1
1225 mos => gs_mos(1)%mos_occ
1226 mosa => gs_mos(1)%mos_active
1227 norb(1) = gs_mos(1)%nmo_occ
1228 nactive(1) = gs_mos(1)%nmo_active
1229 IF (nspins == 2) THEN
1230 mos2 => gs_mos(2)%mos_occ
1231 mosa2 => gs_mos(2)%mos_active
1232 norb(2) = gs_mos(2)%nmo_occ
1233 nactive(2) = gs_mos(2)%nmo_active
1234 END IF
1235 ! Build response vector, Eq. 49, and the third term of \Lamda_munu, Eq. 51
1236 DO ispin = 1, nspins
1237
1238 IF (nactive(ispin) == norb(ispin)) THEN
1239 do_res = .false.
1240 DO ia = 1, nactive(ispin)
1241 cpassert(ia == gs_mos(ispin)%index_active(ia))
1242 END DO
1243 ELSE
1244 do_res = .true.
1245 END IF
1246
1247 ! Initialize mos and dimensions of occupied space
1248 IF (.NOT. do_sf) THEN
1249 spin = ispin
1250 mos => gs_mos(ispin)%mos_occ
1251 mos2 => gs_mos(ispin)%mos_occ
1252 mosa => gs_mos(ispin)%mos_active
1253 mosa2 => gs_mos(ispin)%mos_active
1254 END IF
1255
1256 ! Create working fields for the response vector
1257 CALL cp_fm_create(cpscr, gs_mos(ispin)%mos_active%matrix_struct, "cpscr", set_zero=.true.)
1258 !
1259 CALL cp_fm_get_info(gs_mos(ispin)%mos_occ, matrix_struct=fm_struct, nrow_global=nao)
1260 !
1261 CALL cp_fm_create(avamat, fm_struct, nrow=nactive(spin), ncol=nactive(spin))
1262 CALL cp_fm_create(avcmat, fm_struct, nrow=nactive(spin), ncol=norb(spin))
1263 CALL cp_fm_create(cvcmat, fm_struct, nrow=norb(spin), ncol=norb(spin))
1264 !
1265 CALL cp_fm_create(vcvec, gs_mos(ispin)%mos_occ%matrix_struct, "vcvec")
1266 CALL cp_fm_create(vavec, gs_mos(ispin)%mos_active%matrix_struct, "vavec")
1267
1268 ! Allocate and initialize the Lambda matrix
1269 ALLOCATE (matrix_wx1(ispin)%matrix)
1270 CALL dbcsr_create(matrix=matrix_wx1(ispin)%matrix, template=matrix_s(1)%matrix)
1271 CALL cp_dbcsr_alloc_block_from_nbl(matrix_wx1(ispin)%matrix, sab_orb)
1272 CALL dbcsr_set(matrix_wx1(ispin)%matrix, 0.0_dp)
1273
1274 ! Add Hartree contributions to the perturbation vector
1275 IF (.NOT. (is_rks_triplets .OR. do_sf)) THEN
1276 CALL cp_dbcsr_sm_fm_multiply(matrix_hx(ispin)%matrix, evect(ispin), &
1277 cpscr, nactive(ispin), alpha=focc, beta=1.0_dp)
1278 CALL cp_dbcsr_sm_fm_multiply(matrix_hx(ispin)%matrix, mos, vcvec, norb(ispin), &
1279 alpha=1.0_dp, beta=0.0_dp)
1280 CALL parallel_gemm("T", "N", nactive(ispin), norb(ispin), nao, 1.0_dp, &
1281 mosa, vcvec, 0.0_dp, avcmat)
1282 CALL parallel_gemm("N", "N", nao, norb(ispin), nactive(ispin), 1.0_dp, &
1283 evect(ispin), avcmat, 0.0_dp, vcvec)
1284 CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, vcvec, cpmos(ispin), norb(ispin), alpha=-focc, beta=1.0_dp)
1285 !
1286 CALL cp_dbcsr_plus_fm_fm_t(matrix_wx1(ispin)%matrix, matrix_v=mos, matrix_g=vcvec, &
1287 ncol=norb(ispin), alpha=2.0_dp, symmetry_mode=1)
1288 END IF
1289 ! Add exchange-correlation kernel and exchange-correlation kernel derivative contributions to the response vector
1290 IF ((myfun /= xc_none) .AND. (tddfpt_control%spinflip /= tddfpt_sf_col)) THEN
1291
1292 ! XC Kernel contributions
1293 ! For spin-flip excitations this is the only contribution to the alpha response vector
1294 IF (.NOT. (do_sf .AND. (ispin == 2))) THEN
1295 ! F*X
1296 CALL cp_dbcsr_sm_fm_multiply(matrix_fx(spin)%matrix, evect(spin), &
1297 cpscr, nactive(ispin), alpha=focc, beta=1.0_dp)
1298 END IF
1299 ! For spin-flip excitations this is the only contribution to the beta response vector
1300 IF (.NOT. (do_sf .AND. (ispin == 1))) THEN
1301 ! F*Cb
1302 CALL cp_dbcsr_sm_fm_multiply(matrix_fx(spin)%matrix, mos2, vcvec, &
1303 norb(ispin), alpha=1.0_dp, beta=0.0_dp)
1304 ! Ca^T*F*Cb
1305 CALL parallel_gemm("T", "N", nactive(spin), norb(ispin), nao, 1.0_dp, &
1306 mosa, vcvec, 0.0_dp, avcmat)
1307 ! X*Ca^T*F*Cb
1308 CALL parallel_gemm("N", "N", nao, norb(ispin), nactive(spin), 1.0_dp, &
1309 evect(spin), avcmat, 0.0_dp, vcvec)
1310 ! -S*X*Ca^T*F*Cb
1311 CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, vcvec, cpmos(ispin), &
1312 norb(ispin), alpha=-focc, beta=1.0_dp)
1313 ! Add contributions to the \Lambda_munu for the perturbed overlap matrix term, third term of Eq. 51
1314 ! 2X*Ca^T*F*Cb*Cb^T
1315 CALL cp_dbcsr_plus_fm_fm_t(matrix_wx1(ispin)%matrix, matrix_v=vcvec, matrix_g=gs_mos(ispin)%mos_occ, &
1316 ncol=norb(ispin), alpha=2.0_dp, symmetry_mode=1)
1317 END IF
1318 !
1319
1320 ! XC g (third functional derivative) contributions
1321 ! g*Ca*focc
1322 CALL cp_dbcsr_sm_fm_multiply(matrix_gx(ispin)%matrix, gs_mos(ispin)%mos_occ, &
1323 cpmos(ispin), norb(ispin), alpha=focc, beta=1.0_dp)
1324 ! Add contributions to the \Lambda_munu for the perturbed overlap matrix term, third term of Eq. 51
1325 ! g*Ca
1326 CALL cp_dbcsr_sm_fm_multiply(matrix_gx(ispin)%matrix, gs_mos(ispin)%mos_occ, vcvec, norb(ispin), &
1327 alpha=1.0_dp, beta=0.0_dp)
1328 ! Ca^T*g*Ca
1329 CALL parallel_gemm("T", "N", norb(ispin), norb(ispin), nao, 1.0_dp, gs_mos(ispin)%mos_occ, vcvec, 0.0_dp, cvcmat)
1330 ! Ca*Ca^T*g*Ca
1331 CALL parallel_gemm("N", "N", nao, norb(ispin), norb(ispin), 1.0_dp, gs_mos(ispin)%mos_occ, cvcmat, 0.0_dp, vcvec)
1332 ! Ca*Ca^T*g*Ca*Ca^T
1333 CALL cp_dbcsr_plus_fm_fm_t(matrix_wx1(ispin)%matrix, matrix_v=vcvec, matrix_g=gs_mos(ispin)%mos_occ, &
1334 ncol=norb(ispin), alpha=1.0_dp, symmetry_mode=1)
1335 !
1336 END IF
1337 ! Add Fock contributions to the response vector
1338 IF (do_hfx) THEN
1339 ! For spin-flip excitations this is the only contribution to the alpha response vector
1340 IF (.NOT. (do_sf .AND. (ispin == 2))) THEN
1341 ! F^sym*X
1342 CALL cp_dbcsr_sm_fm_multiply(matrix_hfx(spin)%matrix, evect(spin), &
1343 cpscr, nactive(spin), alpha=focc, beta=1.0_dp)
1344 ! F^asym*X
1345 CALL cp_dbcsr_sm_fm_multiply(matrix_hfx_asymm(spin)%matrix, evect(spin), &
1346 cpscr, nactive(spin), alpha=focc, beta=1.0_dp)
1347 END IF
1348
1349 ! For spin-flip excitations this is the only contribution to the beta response vector
1350 IF (.NOT. (do_sf .AND. (ispin == 1))) THEN
1351 ! F^sym*Cb
1352 CALL cp_dbcsr_sm_fm_multiply(matrix_hfx(spin)%matrix, mos2, vcvec, norb(ispin), &
1353 alpha=1.0_dp, beta=0.0_dp)
1354 ! -F^asym*Cb
1355 CALL cp_dbcsr_sm_fm_multiply(matrix_hfx_asymm(spin)%matrix, mos2, vcvec, norb(ispin), &
1356 alpha=1.0_dp, beta=1.0_dp)
1357 ! Ca^T*F*Cb
1358 CALL parallel_gemm("T", "N", nactive(spin), norb(ispin), nao, 1.0_dp, &
1359 mosa, vcvec, 0.0_dp, avcmat)
1360 ! X*Ca^T*F*Cb
1361 CALL parallel_gemm("N", "N", nao, norb(ispin), nactive(spin), 1.0_dp, &
1362 evect(spin), avcmat, 0.0_dp, vcvec)
1363 ! -S*X*Ca^T*F*Cb
1364 CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, vcvec, cpmos(ispin), &
1365 norb(ispin), alpha=-focc, beta=1.0_dp)
1366 ! Add contributions to the \Lambda_munu for the perturbed overlap matrix term, third term of Eq. 51
1367 ! 2X*Ca^T*F*Cb*Cb^T
1368 CALL cp_dbcsr_plus_fm_fm_t(matrix_wx1(ispin)%matrix, matrix_v=vcvec, matrix_g=mos2, &
1369 ncol=norb(ispin), alpha=2.0_dp, symmetry_mode=1)
1370 END IF
1371 END IF
1372 !
1373 IF (do_res) THEN
1374 DO ia = 1, nactive(ispin)
1375 ib = gs_mos(ispin)%index_active(ia)
1376 CALL cp_fm_add_columns(cpscr, cpmos(ispin), 1, 1.0_dp, ia, ib)
1377 END DO
1378 ELSE
1379 CALL cp_fm_geadd(1.0_dp, "N", cpscr, 1.0_dp, cpmos(ispin))
1380 END IF
1381 !
1382 CALL cp_fm_release(cpscr)
1383 CALL cp_fm_release(avamat)
1384 CALL cp_fm_release(avcmat)
1385 CALL cp_fm_release(cvcmat)
1386 CALL cp_fm_release(vcvec)
1387 CALL cp_fm_release(vavec)
1388 END DO
1389
1390 IF (.NOT. (is_rks_triplets .OR. do_sf)) THEN
1391 CALL dbcsr_deallocate_matrix_set(matrix_hx)
1392 END IF
1393 IF (ASSOCIATED(ex_env%matrix_wx1)) CALL dbcsr_deallocate_matrix_set(ex_env%matrix_wx1)
1394 ex_env%matrix_wx1 => matrix_wx1
1395 IF (.NOT. ((myfun == xc_none) .OR. (tddfpt_control%spinflip == tddfpt_sf_col))) THEN
1396 CALL dbcsr_deallocate_matrix_set(matrix_fx)
1397 CALL dbcsr_deallocate_matrix_set(matrix_gx)
1398 END IF
1399 IF (do_hfx) THEN
1400 CALL dbcsr_deallocate_matrix_set(matrix_hfx)
1401 CALL dbcsr_deallocate_matrix_set(matrix_hfx_asymm)
1402 END IF
1403
1404 CALL timestop(handle)
1405
1406 END SUBROUTINE fhxc_force
1407
1408! **************************************************************************************************
1409!> \brief Simplified Tamm Dancoff approach (sTDA). Kernel contribution to forces
1410!> \param qs_env ...
1411!> \param ex_env ...
1412!> \param gs_mos ...
1413!> \param stda_env ...
1414!> \param sub_env ...
1415!> \param work ...
1416!> \param debug_forces ...
1417! **************************************************************************************************
1418 SUBROUTINE stda_force(qs_env, ex_env, gs_mos, stda_env, sub_env, work, 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(stda_env_type), POINTER :: stda_env
1425 TYPE(tddfpt_subgroup_env_type) :: sub_env
1426 TYPE(tddfpt_work_matrices) :: work
1427 LOGICAL, INTENT(IN) :: debug_forces
1428
1429 CHARACTER(len=*), PARAMETER :: routinen = 'stda_force'
1430
1431 INTEGER :: atom_i, atom_j, ewald_type, handle, i, &
1432 ia, iatom, idimk, ikind, iounit, is, &
1433 ispin, jatom, jkind, jspin, nao, &
1434 natom, norb, nsgf, nspins
1435 INTEGER, ALLOCATABLE, DIMENSION(:) :: atom_of_kind, first_sgf, kind_of, &
1436 last_sgf
1437 INTEGER, DIMENSION(2) :: nactive, nlim
1438 LOGICAL :: calculate_forces, do_coulomb, do_ewald, &
1439 found, is_rks_triplets, use_virial
1440 REAL(kind=dp) :: alpha, bp, dgabr, dr, eta, fdim, gabr, &
1441 hfx, rbeta, spinfac, xfac
1442 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: tcharge, tv
1443 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: gtcharge
1444 REAL(kind=dp), DIMENSION(3) :: fij, fodeb, rij
1445 REAL(kind=dp), DIMENSION(:, :), POINTER :: gab, pblock
1446 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1447 TYPE(cell_type), POINTER :: cell
1448 TYPE(cp_fm_struct_type), POINTER :: fmstruct, fmstruct_mat, fmstructjspin
1449 TYPE(cp_fm_type) :: cvcmat, cvec, cvecjspin, t0matrix, &
1450 t1matrix, vcvec, xvec
1451 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: xtransformed
1452 TYPE(cp_fm_type), DIMENSION(:), POINTER :: cpmos, x
1453 TYPE(cp_fm_type), POINTER :: ct, ctjspin, ucmatrix, uxmatrix
1454 TYPE(cp_logger_type), POINTER :: logger
1455 TYPE(dbcsr_iterator_type) :: iter
1456 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: gamma_matrix, matrix_plo, matrix_s, &
1457 matrix_wx1, scrm
1458 TYPE(dbcsr_type) :: pdens, ptrans
1459 TYPE(dbcsr_type), POINTER :: tempmat
1460 TYPE(dft_control_type), POINTER :: dft_control
1461 TYPE(ewald_environment_type), POINTER :: ewald_env
1462 TYPE(ewald_pw_type), POINTER :: ewald_pw
1463 TYPE(mp_para_env_type), POINTER :: para_env
1464 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
1465 POINTER :: n_list, sab_orb
1466 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1467 TYPE(qs_force_type), DIMENSION(:), POINTER :: force
1468 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1469 TYPE(qs_ks_env_type), POINTER :: ks_env
1470 TYPE(stda_control_type), POINTER :: stda_control
1471 TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
1472 TYPE(virial_type), POINTER :: virial
1473
1474 CALL timeset(routinen, handle)
1475
1476 cpassert(ASSOCIATED(ex_env))
1477 cpassert(ASSOCIATED(gs_mos))
1478
1479 logger => cp_get_default_logger()
1480 IF (logger%para_env%is_source()) THEN
1481 iounit = cp_logger_get_default_unit_nr(logger, local=.true.)
1482 ELSE
1483 iounit = -1
1484 END IF
1485
1486 CALL get_qs_env(qs_env, dft_control=dft_control)
1487 tddfpt_control => dft_control%tddfpt2_control
1488 stda_control => tddfpt_control%stda_control
1489 nspins = dft_control%nspins
1490 is_rks_triplets = tddfpt_control%rks_triplets .AND. (nspins == 1)
1491
1492 x => ex_env%evect
1493
1494 nactive(:) = stda_env%nactive(:)
1495 xfac = 2.0_dp
1496 spinfac = 2.0_dp
1497 IF (nspins == 2) spinfac = 1.0_dp
1498 NULLIFY (matrix_wx1)
1499 CALL dbcsr_allocate_matrix_set(matrix_wx1, nspins)
1500 NULLIFY (matrix_plo)
1501 CALL dbcsr_allocate_matrix_set(matrix_plo, nspins)
1502
1503 IF (nspins == 1 .AND. is_rks_triplets) THEN
1504 do_coulomb = .false.
1505 ELSE
1506 do_coulomb = .true.
1507 END IF
1508 do_ewald = stda_control%do_ewald
1509
1510 CALL get_qs_env(qs_env, para_env=para_env, force=force)
1511
1512 CALL get_qs_env(qs_env, natom=natom, cell=cell, &
1513 particle_set=particle_set, qs_kind_set=qs_kind_set)
1514 ALLOCATE (first_sgf(natom))
1515 ALLOCATE (last_sgf(natom))
1516 CALL get_particle_set(particle_set, qs_kind_set, first_sgf=first_sgf, last_sgf=last_sgf)
1517
1518 CALL get_qs_env(qs_env, ks_env=ks_env, matrix_s=matrix_s, sab_orb=sab_orb, atomic_kind_set=atomic_kind_set)
1519 CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, kind_of=kind_of, atom_of_kind=atom_of_kind)
1520
1521 ! calculate Loewdin transformed Davidson trial vector tilde(X)=S^1/2*X
1522 ! and tilde(tilde(X))=S^1/2_A*tilde(X)_A
1523 ALLOCATE (xtransformed(nspins))
1524 DO ispin = 1, nspins
1525 NULLIFY (fmstruct)
1526 ct => work%ctransformed(ispin)
1527 CALL cp_fm_get_info(ct, matrix_struct=fmstruct)
1528 CALL cp_fm_create(matrix=xtransformed(ispin), matrix_struct=fmstruct, name="XTRANSFORMED")
1529 END DO
1530 CALL get_lowdin_x(work%shalf, x, xtransformed)
1531
1532 ALLOCATE (tcharge(natom), gtcharge(natom, 4))
1533
1534 cpmos => ex_env%cpmos
1535
1536 DO ispin = 1, nspins
1537 ct => work%ctransformed(ispin)
1538 CALL cp_fm_get_info(ct, matrix_struct=fmstruct, nrow_global=nsgf)
1539 ALLOCATE (tv(nsgf))
1540 CALL cp_fm_create(cvec, fmstruct)
1541 CALL cp_fm_create(xvec, fmstruct)
1542 !
1543 ALLOCATE (matrix_wx1(ispin)%matrix)
1544 CALL dbcsr_create(matrix=matrix_wx1(ispin)%matrix, template=matrix_s(1)%matrix)
1545 CALL cp_dbcsr_alloc_block_from_nbl(matrix_wx1(ispin)%matrix, sab_orb)
1546 CALL dbcsr_set(matrix_wx1(ispin)%matrix, 0.0_dp)
1547 ALLOCATE (matrix_plo(ispin)%matrix)
1548 CALL dbcsr_create(matrix=matrix_plo(ispin)%matrix, template=matrix_s(1)%matrix)
1549 CALL cp_dbcsr_alloc_block_from_nbl(matrix_plo(ispin)%matrix, sab_orb)
1550 CALL dbcsr_set(matrix_plo(ispin)%matrix, 0.0_dp)
1551 !
1552 ! *** Coulomb contribution
1553 !
1554 IF (do_coulomb) THEN
1555 !
1556 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1557 !
1558 tcharge(:) = 0.0_dp
1559 DO jspin = 1, nspins
1560 ctjspin => work%ctransformed(jspin)
1561 CALL cp_fm_get_info(ctjspin, matrix_struct=fmstructjspin)
1562 CALL cp_fm_get_info(ctjspin, matrix_struct=fmstructjspin, nrow_global=nsgf)
1563 CALL cp_fm_create(cvecjspin, fmstructjspin)
1564 ! CV(mu,j) = CT(mu,j)*XT(mu,j)
1565 CALL cp_fm_schur_product(ctjspin, xtransformed(jspin), cvecjspin)
1566 ! TV(mu) = SUM_j CV(mu,j)
1567 CALL cp_fm_vectorssum(cvecjspin, tv, "R")
1568 ! contract charges
1569 ! TC(a) = SUM_(mu of a) TV(mu)
1570 DO ia = 1, natom
1571 DO is = first_sgf(ia), last_sgf(ia)
1572 tcharge(ia) = tcharge(ia) + tv(is)
1573 END DO
1574 END DO
1575 CALL cp_fm_release(cvecjspin)
1576 END DO !jspin
1577 ! Apply tcharge*gab -> gtcharge
1578 ! gT(b) = SUM_a g(a,b)*TC(a)
1579 ! gab = work%gamma_exchange(1)%matrix
1580 gtcharge = 0.0_dp
1581 ! short range contribution
1582 NULLIFY (gamma_matrix)
1583 CALL setup_gamma(qs_env, stda_env, sub_env, gamma_matrix, ndim=4)
1584 tempmat => gamma_matrix(1)%matrix
1585 CALL dbcsr_iterator_start(iter, tempmat)
1586 DO WHILE (dbcsr_iterator_blocks_left(iter))
1587 CALL dbcsr_iterator_next_block(iter, iatom, jatom, gab)
1588 gtcharge(iatom, 1) = gtcharge(iatom, 1) + gab(1, 1)*tcharge(jatom)
1589 IF (iatom /= jatom) THEN
1590 gtcharge(jatom, 1) = gtcharge(jatom, 1) + gab(1, 1)*tcharge(iatom)
1591 END IF
1592 DO idimk = 2, 4
1593 fdim = -1.0_dp
1594 CALL dbcsr_get_block_p(matrix=gamma_matrix(idimk)%matrix, &
1595 row=iatom, col=jatom, block=gab, found=found)
1596 IF (found) THEN
1597 gtcharge(iatom, idimk) = gtcharge(iatom, idimk) + gab(1, 1)*tcharge(jatom)
1598 IF (iatom /= jatom) THEN
1599 gtcharge(jatom, idimk) = gtcharge(jatom, idimk) + fdim*gab(1, 1)*tcharge(iatom)
1600 END IF
1601 END IF
1602 END DO
1603 END DO
1604 CALL dbcsr_iterator_stop(iter)
1605 CALL dbcsr_deallocate_matrix_set(gamma_matrix)
1606 ! Ewald long range contribution
1607 IF (do_ewald) THEN
1608 ewald_env => work%ewald_env
1609 ewald_pw => work%ewald_pw
1610 CALL ewald_env_get(ewald_env, alpha=alpha, ewald_type=ewald_type)
1611 CALL get_qs_env(qs_env=qs_env, sab_orb=n_list, virial=virial)
1612 use_virial = .false.
1613 calculate_forces = .false.
1614 CALL tb_ewald_overlap(gtcharge, tcharge, alpha, n_list, virial, use_virial)
1615 CALL tb_spme_evaluate(ewald_env, ewald_pw, particle_set, cell, &
1616 gtcharge, tcharge, calculate_forces, virial, use_virial)
1617 ! add self charge interaction contribution
1618 IF (para_env%is_source()) THEN
1619 gtcharge(:, 1) = gtcharge(:, 1) - 2._dp*alpha*oorootpi*tcharge(:)
1620 END IF
1621 ELSE
1622 nlim = get_limit(natom, para_env%num_pe, para_env%mepos)
1623 DO iatom = nlim(1), nlim(2)
1624 DO jatom = 1, iatom - 1
1625 rij = particle_set(iatom)%r - particle_set(jatom)%r
1626 rij = pbc(rij, cell)
1627 dr = sqrt(sum(rij(:)**2))
1628 IF (dr > 1.e-6_dp) THEN
1629 gtcharge(iatom, 1) = gtcharge(iatom, 1) + tcharge(jatom)/dr
1630 gtcharge(jatom, 1) = gtcharge(jatom, 1) + tcharge(iatom)/dr
1631 DO idimk = 2, 4
1632 gtcharge(iatom, idimk) = gtcharge(iatom, idimk) + rij(idimk - 1)*tcharge(jatom)/dr**3
1633 gtcharge(jatom, idimk) = gtcharge(jatom, idimk) - rij(idimk - 1)*tcharge(iatom)/dr**3
1634 END DO
1635 END IF
1636 END DO
1637 END DO
1638 END IF
1639 CALL para_env%sum(gtcharge(:, 1))
1640 ! expand charges
1641 ! TV(mu) = TC(a of mu)
1642 tv(1:nsgf) = 0.0_dp
1643 DO ia = 1, natom
1644 DO is = first_sgf(ia), last_sgf(ia)
1645 tv(is) = gtcharge(ia, 1)
1646 END DO
1647 END DO
1648 !
1649 DO iatom = 1, natom
1650 ikind = kind_of(iatom)
1651 atom_i = atom_of_kind(iatom)
1652 DO i = 1, 3
1653 fij(i) = spinfac*spinfac*gtcharge(iatom, i + 1)*tcharge(iatom)
1654 END DO
1655 force(ikind)%rho_elec(1, atom_i) = force(ikind)%rho_elec(1, atom_i) - fij(1)
1656 force(ikind)%rho_elec(2, atom_i) = force(ikind)%rho_elec(2, atom_i) - fij(2)
1657 force(ikind)%rho_elec(3, atom_i) = force(ikind)%rho_elec(3, atom_i) - fij(3)
1658 END DO
1659 !
1660 IF (debug_forces) THEN
1661 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1662 CALL para_env%sum(fodeb)
1663 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Coul[X] ", fodeb
1664 END IF
1665 norb = nactive(ispin)
1666 ! forces from Lowdin charge derivative
1667 CALL cp_fm_get_info(work%S_C0_C0T(ispin), matrix_struct=fmstruct)
1668 CALL cp_fm_create(t0matrix, matrix_struct=fmstruct, name="T0 SCRATCH")
1669 CALL cp_fm_create(t1matrix, matrix_struct=fmstruct, name="T1 SCRATCH")
1670 ALLOCATE (ucmatrix)
1671 CALL fm_pool_create_fm(work%fm_pool_ao_mo_active(ispin)%pool, ucmatrix)
1672 ALLOCATE (uxmatrix)
1673 CALL fm_pool_create_fm(work%fm_pool_ao_mo_active(ispin)%pool, uxmatrix)
1674 ct => work%ctransformed(ispin)
1675 CALL cp_fm_to_fm(ct, cvec)
1676 CALL cp_fm_row_scale(cvec, tv)
1677 CALL parallel_gemm('T', 'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1678 cvec, 0.0_dp, ucmatrix)
1679 CALL parallel_gemm('T', 'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1680 x(ispin), 0.0_dp, uxmatrix)
1681 CALL parallel_gemm('N', 'T', nsgf, nsgf, norb, 1.0_dp, uxmatrix, ucmatrix, 0.0_dp, t0matrix)
1682 CALL cp_fm_to_fm(xtransformed(ispin), cvec)
1683 CALL cp_fm_row_scale(cvec, tv)
1684 CALL parallel_gemm('T', 'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1685 cvec, 0.0_dp, uxmatrix)
1686 CALL parallel_gemm('T', 'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1687 gs_mos(ispin)%mos_occ, 0.0_dp, ucmatrix)
1688 CALL parallel_gemm('N', 'T', nsgf, nsgf, norb, 1.0_dp, ucmatrix, uxmatrix, 1.0_dp, t0matrix)
1689 CALL cp_fm_schur_product(work%slambda, t0matrix, t1matrix)
1690 !
1691 CALL parallel_gemm('N', 'N', nsgf, nsgf, nsgf, spinfac, work%S_eigenvectors, t1matrix, &
1692 0.0_dp, t0matrix)
1693 CALL cp_dbcsr_plus_fm_fm_t(matrix_plo(ispin)%matrix, matrix_v=t0matrix, &
1694 matrix_g=work%S_eigenvectors, ncol=nsgf, alpha=2.0_dp, symmetry_mode=1)
1695 CALL fm_pool_give_back_fm(work%fm_pool_ao_mo_active(ispin)%pool, ucmatrix)
1696 DEALLOCATE (ucmatrix)
1697 CALL fm_pool_give_back_fm(work%fm_pool_ao_mo_active(ispin)%pool, uxmatrix)
1698 DEALLOCATE (uxmatrix)
1699 CALL cp_fm_release(t0matrix)
1700 CALL cp_fm_release(t1matrix)
1701 !
1702 ! CV(mu,i) = TV(mu)*XT(mu,i)
1703 CALL cp_fm_to_fm(xtransformed(ispin), cvec)
1704 CALL cp_fm_row_scale(cvec, tv)
1705 CALL cp_dbcsr_sm_fm_multiply(work%shalf, cvec, cpmos(ispin), norb, 2.0_dp*spinfac, 1.0_dp)
1706 ! CV(mu,i) = TV(mu)*CT(mu,i)
1707 ct => work%ctransformed(ispin)
1708 CALL cp_fm_to_fm(ct, cvec)
1709 CALL cp_fm_row_scale(cvec, tv)
1710 ! Shalf(nu,mu)*CV(mu,i)
1711 CALL cp_fm_get_info(cvec, matrix_struct=fmstruct, nrow_global=nao)
1712 CALL cp_fm_create(vcvec, fmstruct)
1713 CALL cp_dbcsr_sm_fm_multiply(work%shalf, cvec, vcvec, norb, 1.0_dp, 0.0_dp)
1714 CALL cp_fm_struct_create(fmstruct_mat, context=fmstruct%context, nrow_global=norb, &
1715 ncol_global=norb, para_env=fmstruct%para_env)
1716 CALL cp_fm_create(cvcmat, fmstruct_mat)
1717 CALL cp_fm_struct_release(fmstruct_mat)
1718 CALL parallel_gemm("T", "N", norb, norb, nao, 1.0_dp, gs_mos(ispin)%mos_occ, vcvec, 0.0_dp, cvcmat)
1719 CALL parallel_gemm("N", "N", nao, norb, norb, 1.0_dp, x(ispin), cvcmat, 0.0_dp, vcvec)
1720 CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, vcvec, cpmos(ispin), &
1721 nactive(ispin), alpha=-2.0_dp*spinfac, beta=1.0_dp)
1722 ! wx1
1723 alpha = 2.0_dp
1724 CALL cp_dbcsr_plus_fm_fm_t(matrix_wx1(ispin)%matrix, matrix_v=gs_mos(ispin)%mos_occ, &
1725 matrix_g=vcvec, ncol=norb, alpha=2.0_dp*alpha, symmetry_mode=1)
1726 CALL cp_fm_release(vcvec)
1727 CALL cp_fm_release(cvcmat)
1728 END IF
1729 !
1730 ! *** Exchange contribution
1731 !
1732 IF (stda_env%do_exchange) THEN
1733 !
1734 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1735 !
1736 norb = nactive(ispin)
1737 !
1738 tempmat => work%shalf
1739 CALL dbcsr_create(pdens, template=tempmat, matrix_type=dbcsr_type_no_symmetry)
1740 ! P(nu,mu) = SUM_j XT(nu,j)*CT(mu,j)
1741 ct => work%ctransformed(ispin)
1742 CALL dbcsr_set(pdens, 0.0_dp)
1743 CALL cp_dbcsr_plus_fm_fm_t(pdens, xtransformed(ispin), ct, nactive(ispin), &
1744 1.0_dp, keep_sparsity=.false.)
1745 CALL dbcsr_filter(pdens, stda_env%eps_td_filter)
1746 ! Apply PP*gab -> PP; gab = gamma_coulomb
1747 ! P(nu,mu) = P(nu,mu)*g(a of nu,b of mu)
1748 bp = stda_env%beta_param
1749 hfx = stda_env%hfx_fraction
1750 CALL dbcsr_iterator_start(iter, pdens)
1751 DO WHILE (dbcsr_iterator_blocks_left(iter))
1752 CALL dbcsr_iterator_next_block(iter, iatom, jatom, pblock)
1753 rij = particle_set(iatom)%r - particle_set(jatom)%r
1754 rij = pbc(rij, cell)
1755 dr = sqrt(sum(rij(:)**2))
1756 ikind = kind_of(iatom)
1757 jkind = kind_of(jatom)
1758 eta = (stda_env%kind_param_set(ikind)%kind_param%hardness_param + &
1759 stda_env%kind_param_set(jkind)%kind_param%hardness_param)/2.0_dp
1760 rbeta = dr**bp
1761 IF (hfx > 0.0_dp) THEN
1762 gabr = (1._dp/(rbeta + (hfx*eta)**(-bp)))**(1._dp/bp)
1763 ELSE
1764 IF (dr < 1.0e-6_dp) THEN
1765 gabr = 0.0_dp
1766 ELSE
1767 gabr = 1._dp/dr
1768 END IF
1769 END IF
1770 ! gabr = (1._dp/(rbeta + (hfx*eta)**(-bp)))**(1._dp/bp)
1771 ! forces
1772 IF (dr > 1.0e-6_dp) THEN
1773 IF (hfx > 0.0_dp) THEN
1774 dgabr = -(1._dp/bp)*(1._dp/(rbeta + (hfx*eta)**(-bp)))**(1._dp/bp + 1._dp)
1775 dgabr = bp*rbeta/dr**2*dgabr
1776 dgabr = sum(pblock**2)*dgabr
1777 ELSE
1778 dgabr = -1.0_dp/dr**3
1779 dgabr = sum(pblock**2)*dgabr
1780 END IF
1781 atom_i = atom_of_kind(iatom)
1782 atom_j = atom_of_kind(jatom)
1783 DO i = 1, 3
1784 fij(i) = dgabr*rij(i)
1785 END DO
1786 force(ikind)%rho_elec(1, atom_i) = force(ikind)%rho_elec(1, atom_i) - fij(1)
1787 force(ikind)%rho_elec(2, atom_i) = force(ikind)%rho_elec(2, atom_i) - fij(2)
1788 force(ikind)%rho_elec(3, atom_i) = force(ikind)%rho_elec(3, atom_i) - fij(3)
1789 force(jkind)%rho_elec(1, atom_j) = force(jkind)%rho_elec(1, atom_j) + fij(1)
1790 force(jkind)%rho_elec(2, atom_j) = force(jkind)%rho_elec(2, atom_j) + fij(2)
1791 force(jkind)%rho_elec(3, atom_j) = force(jkind)%rho_elec(3, atom_j) + fij(3)
1792 END IF
1793 !
1794 pblock = gabr*pblock
1795 END DO
1796 CALL dbcsr_iterator_stop(iter)
1797 !
1798 ! Transpose pdens matrix
1799 CALL dbcsr_create(ptrans, template=pdens)
1800 CALL dbcsr_transposed(ptrans, pdens)
1801 !
1802 ! forces from Lowdin charge derivative
1803 CALL cp_fm_get_info(work%S_C0_C0T(ispin), matrix_struct=fmstruct)
1804 CALL cp_fm_create(t0matrix, matrix_struct=fmstruct, name="T0 SCRATCH")
1805 CALL cp_fm_create(t1matrix, matrix_struct=fmstruct, name="T1 SCRATCH")
1806 ALLOCATE (ucmatrix)
1807 CALL fm_pool_create_fm(work%fm_pool_ao_mo_active(ispin)%pool, ucmatrix)
1808 ALLOCATE (uxmatrix)
1809 CALL fm_pool_create_fm(work%fm_pool_ao_mo_active(ispin)%pool, uxmatrix)
1810 ct => work%ctransformed(ispin)
1811 CALL cp_dbcsr_sm_fm_multiply(pdens, ct, cvec, norb, 1.0_dp, 0.0_dp)
1812 CALL parallel_gemm('T', 'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1813 cvec, 0.0_dp, ucmatrix)
1814 CALL parallel_gemm('T', 'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1815 x(ispin), 0.0_dp, uxmatrix)
1816 CALL parallel_gemm('N', 'T', nsgf, nsgf, norb, 1.0_dp, uxmatrix, ucmatrix, 0.0_dp, t0matrix)
1817 CALL cp_dbcsr_sm_fm_multiply(ptrans, xtransformed(ispin), cvec, norb, 1.0_dp, 0.0_dp)
1818 CALL parallel_gemm('T', 'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1819 cvec, 0.0_dp, uxmatrix)
1820 CALL parallel_gemm('T', 'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1821 gs_mos(ispin)%mos_occ, 0.0_dp, ucmatrix)
1822 CALL parallel_gemm('N', 'T', nsgf, nsgf, norb, 1.0_dp, ucmatrix, uxmatrix, 1.0_dp, t0matrix)
1823 CALL cp_fm_schur_product(work%slambda, t0matrix, t1matrix)
1824 CALL parallel_gemm('N', 'N', nsgf, nsgf, nsgf, -1.0_dp, work%S_eigenvectors, t1matrix, &
1825 0.0_dp, t0matrix)
1826 CALL cp_dbcsr_plus_fm_fm_t(matrix_plo(ispin)%matrix, matrix_v=t0matrix, &
1827 matrix_g=work%S_eigenvectors, ncol=nsgf, alpha=2.0_dp, symmetry_mode=1)
1828 CALL fm_pool_give_back_fm(work%fm_pool_ao_mo_active(ispin)%pool, ucmatrix)
1829 DEALLOCATE (ucmatrix)
1830 CALL fm_pool_give_back_fm(work%fm_pool_ao_mo_active(ispin)%pool, uxmatrix)
1831 DEALLOCATE (uxmatrix)
1832 CALL cp_fm_release(t0matrix)
1833 CALL cp_fm_release(t1matrix)
1834
1835 ! RHS contribution to response matrix
1836 ! CV(nu,i) = P(nu,mu)*XT(mu,i)
1837 CALL cp_dbcsr_sm_fm_multiply(ptrans, xtransformed(ispin), cvec, norb, 1.0_dp, 0.0_dp)
1838 CALL cp_dbcsr_sm_fm_multiply(work%shalf, cvec, cpmos(ispin), norb, &
1839 alpha=-xfac, beta=1.0_dp)
1840 !
1841 CALL cp_fm_get_info(cvec, matrix_struct=fmstruct, nrow_global=nao)
1842 CALL cp_fm_create(vcvec, fmstruct)
1843 ! CV(nu,i) = P(nu,mu)*CT(mu,i)
1844 CALL cp_dbcsr_sm_fm_multiply(ptrans, ct, cvec, norb, 1.0_dp, 0.0_dp)
1845 CALL cp_dbcsr_sm_fm_multiply(work%shalf, cvec, vcvec, norb, 1.0_dp, 0.0_dp)
1846 CALL cp_fm_struct_create(fmstruct_mat, context=fmstruct%context, nrow_global=norb, &
1847 ncol_global=norb, para_env=fmstruct%para_env)
1848 CALL cp_fm_create(cvcmat, fmstruct_mat)
1849 CALL cp_fm_struct_release(fmstruct_mat)
1850 CALL parallel_gemm("T", "N", norb, norb, nao, 1.0_dp, gs_mos(ispin)%mos_occ, vcvec, 0.0_dp, cvcmat)
1851 CALL parallel_gemm("N", "N", nao, norb, norb, 1.0_dp, x(ispin), cvcmat, 0.0_dp, vcvec)
1852 CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, vcvec, cpmos(ispin), &
1853 norb, alpha=xfac, beta=1.0_dp)
1854 ! wx1
1855 IF (nspins == 2) THEN
1856 alpha = -2.0_dp
1857 ELSE
1858 alpha = -1.0_dp
1859 END IF
1860 CALL cp_dbcsr_plus_fm_fm_t(matrix_wx1(ispin)%matrix, matrix_v=gs_mos(ispin)%mos_occ, &
1861 matrix_g=vcvec, &
1862 ncol=norb, alpha=2.0_dp*alpha, symmetry_mode=1)
1863 CALL cp_fm_release(vcvec)
1864 CALL cp_fm_release(cvcmat)
1865 !
1866 CALL dbcsr_release(pdens)
1867 CALL dbcsr_release(ptrans)
1868 !
1869 IF (debug_forces) THEN
1870 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1871 CALL para_env%sum(fodeb)
1872 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Exch[X] ", fodeb
1873 END IF
1874 END IF
1875 !
1876 CALL cp_fm_release(cvec)
1877 CALL cp_fm_release(xvec)
1878 DEALLOCATE (tv)
1879 END DO
1880
1881 CALL cp_fm_release(xtransformed)
1882 DEALLOCATE (tcharge, gtcharge)
1883 DEALLOCATE (first_sgf, last_sgf)
1884
1885 ! Lowdin forces
1886 IF (nspins == 2) THEN
1887 CALL dbcsr_add(matrix_plo(1)%matrix, matrix_plo(2)%matrix, &
1888 alpha_scalar=1.0_dp, beta_scalar=1.0_dp)
1889 END IF
1890 CALL dbcsr_scale(matrix_plo(1)%matrix, -1.0_dp)
1891 NULLIFY (scrm)
1892 IF (debug_forces) fodeb(1:3) = force(1)%overlap(1:3, 1)
1893 CALL build_overlap_matrix(ks_env, matrix_s=scrm, &
1894 matrix_name="OVERLAP MATRIX", &
1895 basis_type_a="ORB", basis_type_b="ORB", &
1896 sab_nl=sab_orb, calculate_forces=.true., &
1897 matrix_p=matrix_plo(1)%matrix)
1899 CALL dbcsr_deallocate_matrix_set(matrix_plo)
1900 IF (debug_forces) THEN
1901 fodeb(1:3) = force(1)%overlap(1:3, 1) - fodeb(1:3)
1902 CALL para_env%sum(fodeb)
1903 IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Lowdin ", fodeb
1904 END IF
1905
1906 IF (ASSOCIATED(ex_env%matrix_wx1)) CALL dbcsr_deallocate_matrix_set(ex_env%matrix_wx1)
1907 ex_env%matrix_wx1 => matrix_wx1
1908
1909 CALL timestop(handle)
1910
1911 END SUBROUTINE stda_force
1912
1913! **************************************************************************************************
1914
1915END MODULE qs_tddfpt2_fhxc_forces
Contains ADMM methods which require molecular orbitals.
subroutine, public admm_projection_derivative(qs_env, matrix_hz, matrix_pz, fval)
Calculate derivatives terms from overlap matrices.
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.
Handles all functions related to the CELL.
Definition cell_types.F:15
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
subroutine, public dbcsr_transposed(transposed, normal, shallow_data_copy, transpose_distribution, use_distribution)
...
subroutine, public dbcsr_scale(matrix, alpha_scalar)
...
subroutine, public dbcsr_iterator_next_block(iterator, row, column, block, block_number_argument_has_been_removed, row_size, col_size, row_offset, col_offset)
...
logical function, public dbcsr_iterator_blocks_left(iterator)
...
subroutine, public dbcsr_iterator_stop(iterator)
...
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_get_block_p(matrix, row, col, block, found, row_size, col_size)
...
subroutine, public dbcsr_filter(matrix, eps)
...
subroutine, public dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
...
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)
...
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.
Basic linear algebra operations for full matrices.
subroutine, public cp_fm_row_scale(matrixa, scaling)
scales row i of matrix a with scaling(i)
subroutine, public cp_fm_add_columns(msource, mtarget, ncol, alpha, source_start, target_start)
Add (and scale) a subset of columns of a fm to a fm b = alpha*a + b.
subroutine, public cp_fm_geadd(alpha, trans, matrix_a, beta, matrix_b)
interface to BLACS geadd: matrix_b = beta*matrix_b + alpha*opt(matrix_a) where opt(matrix_a) can be e...
subroutine, public cp_fm_schur_product(matrix_a, matrix_b, matrix_c)
computes the schur product of two matrices c_ij = a_ij * b_ij
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_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_vectorssum(matrix, sum_array, dir)
summing up all the elements along the matrix's i-th index or
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp, nrow, ncol, set_zero)
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
subroutine, public ewald_env_get(ewald_env, ewald_type, alpha, eps_pol, epsilon, gmax, ns_max, o_spline, group, para_env, poisson_section, precs, rcut, do_multipoles, max_multipole, do_ipol, max_ipol_iter, interaction_cutoffs, cell_hmat)
Purpose: Get the EWALD environment.
Calculation of Ewald contributions in DFTB.
subroutine, public tb_ewald_overlap(gmcharge, mcharge, alpha, n_list, virial, use_virial)
...
subroutine, public tb_spme_evaluate(ewald_env, ewald_pw, particle_set, box, gmcharge, mcharge, calculate_forces, virial, use_virial)
...
Types for excited states potential energies.
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 derivatives with respect to basis function origin.
subroutine, public derivatives_four_center(qs_env, rho_ao, rho_ao_resp, hfx_section, para_env, irep, use_virial, adiabatic_rescale_factor, resp_only, external_x_data, nspins)
computes four center derivatives for a full basis set and updates the forcesfock_4c arrays....
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
subroutine, public hfx_ri_update_forces(qs_env, ri_data, nspins, hf_fraction, rho_ao, rho_ao_resp, mos, use_virial, resp_only, rescale_factor)
the general routine that calls the relevant force code
Definition hfx_ri.F:3044
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 do_analytic
integer, parameter, public tddfpt_sf_col
integer, parameter, public xc_kernel_method_best
integer, parameter, public xc_kernel_method_analytic
integer, parameter, public do_admm_aux_exch_func_none
integer, parameter, public tddfpt_kernel_full
integer, parameter, public xc_kernel_method_numeric
integer, parameter, public do_numeric
integer, parameter, public no_sf_tddfpt
integer, parameter, public xc_none
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
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
Definition of mathematical constants and functions.
real(kind=dp), parameter, public oorootpi
Interface to the message passing library MPI.
basic linear algebra operations for full matrixes
Define methods related to particle_type.
subroutine, public get_particle_set(particle_set, qs_kind_set, first_sgf, last_sgf, nsgf, nmao, basis)
Get the components of a particle set.
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
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.
https://en.wikipedia.org/wiki/Finite_difference_coefficient
Definition qs_fxc.F:27
subroutine, public qs_fgxc_create(ks_env, rho0_struct, rho1_struct, xc_section, accuracy, is_triplet, fxc_rho, fxc_tau, gxc_rho, gxc_tau)
...
Definition qs_fxc.F:620
subroutine, public qs_fgxc_gdiff(ks_env, rho0_struct, rho1_struct, xc_section, accuracy, epsrho, is_triplet, fxc_rho, fxc_tau, gxc_rho, gxc_tau, spinflip)
...
Definition qs_fxc.F:455
subroutine, public qs_fgxc_release(ks_env, fxc_rho, fxc_tau, gxc_rho, gxc_tau)
...
Definition qs_fxc.F:749
subroutine, public qs_fgxc_analytic(rho0_struct, rho1_struct, xc_section, pw_pool, fxc_rho, fxc_tau, gxc_rho, gxc_tau, spinflip)
Calculates the values at the grid points in real space (r_i), of the second and third functional deri...
Definition qs_fxc.F:302
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.
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
subroutine, public local_rho_set_create(local_rho_set)
...
subroutine, public local_rho_set_release(local_rho_set)
...
Define the neighbor list data types and the corresponding functionality.
Routines for the construction of the coefficients for the expansion of the atomic densities rho1_hard...
subroutine, public build_oce_matrices(intac, calculate_forces, nder, qs_kind_set, particle_set, sap_oce, eps_fit)
Set up the sparse matrix for the coefficients of one center expansions This routine uses the same log...
subroutine, public allocate_oce_set(oce_set, nkind)
Allocate and initialize the matrix set of oce coefficients.
subroutine, public create_oce_set(oce_set)
...
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 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...
Simplified Tamm Dancoff approach (sTDA).
Simplified Tamm Dancoff approach (sTDA).
subroutine, public get_lowdin_x(shalf, xvec, xt)
Calculate Lowdin transformed Davidson trial vector X shalf (dbcsr), xvec, xt (fm) are defined in the ...
subroutine, public setup_gamma(qs_env, stda_env, sub_env, gamma_matrix, ndim)
Calculate sTDA exchange-type contributions.
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_gfxc_atom(qs_env, rho0_atom_set, rho1_atom_set, rho2_atom_set, kind_set, xc_section, is_triplet, accuracy)
...
subroutine, public gfxc_atom_diff(qs_env, rho0_atom_set, rho1_atom_set, rho2_atom_set, kind_set, xc_section, is_triplet, accuracy, epsrho)
...
types for task lists
All kind of helpful little routines.
Definition util.F:14
pure integer function, dimension(2), public get_limit(m, n, me)
divide m entries into n parts, return size of part me
Definition util.F:333
stores some data used in wavefunction fitting
Definition admm_types.F:120
Provides all information about an atomic kind.
Type defining parameters related to the simulation cell.
Definition cell_types.F:60
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 ...
Collection of variables required to evaluate adiabatic TDDFPT kernel.
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.