42 USE dbcsr_api,
ONLY: &
43 dbcsr_add, dbcsr_complete_redistribute, dbcsr_copy, dbcsr_create, dbcsr_filter, &
44 dbcsr_get_block_p, dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, &
45 dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_p_type, &
46 dbcsr_release, dbcsr_scale, dbcsr_set, dbcsr_transposed, dbcsr_type, &
47 dbcsr_type_antisymmetric, dbcsr_type_no_symmetry
49 ewald_environment_type
136 #include "./base/base_uses.f90"
142 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'qs_tddfpt2_fhxc_forces'
160 SUBROUTINE fhxc_force(qs_env, ex_env, gs_mos, full_kernel, debug_forces)
162 TYPE(qs_environment_type),
POINTER :: qs_env
163 TYPE(excited_energy_type),
POINTER :: ex_env
164 TYPE(tddfpt_ground_state_mos),
DIMENSION(:), &
166 TYPE(full_kernel_env_type),
INTENT(IN) :: full_kernel
167 LOGICAL,
INTENT(IN) :: debug_forces
169 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fhxc_force'
171 CHARACTER(LEN=default_string_length) :: basis_type
172 INTEGER :: handle, iounit, ispin, mspin, myfun, &
173 n_rep_hf, nao, nao_aux, natom, nkind, &
175 LOGICAL :: distribute_fock_matrix, do_admm, do_analytic, do_hfx, do_hfxlr, do_hfxsr, &
176 do_numeric, gapw, gapw_xc, hfx_treat_lsd_in_core, is_rks_triplets, s_mstruct_changed, &
178 REAL(kind=
dp) :: eh1, eh1c, eps_delta, eps_fit, focc, &
179 fscal, fval, kval, xehartree
180 REAL(kind=
dp),
DIMENSION(3) :: fodeb
181 TYPE(admm_type),
POINTER :: admm_env
182 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
183 TYPE(cp_fm_struct_type),
POINTER :: fm_struct, fm_struct_mat
184 TYPE(cp_fm_type) :: cvcmat, vcvec
185 TYPE(cp_fm_type),
DIMENSION(:),
POINTER :: cpmos, evect
186 TYPE(cp_fm_type),
POINTER :: mos
187 TYPE(cp_logger_type),
POINTER :: logger
188 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_fx, matrix_gx, matrix_hfx, &
189 matrix_hfx_admm, matrix_hfx_admm_asymm, matrix_hfx_asymm, matrix_hx, matrix_p, &
190 matrix_p_admm, matrix_px1, matrix_px1_admm, matrix_px1_admm_asymm, matrix_px1_asymm, &
191 matrix_s, matrix_s_aux_fit, matrix_wx1, mdum, mfx, mgx
192 TYPE(dbcsr_p_type),
DIMENSION(:, :),
POINTER :: mhe, mpe, mpga
193 TYPE(dbcsr_type),
POINTER :: dbwork, dbwork_asymm
194 TYPE(dft_control_type),
POINTER :: dft_control
195 TYPE(hartree_local_type),
POINTER :: hartree_local
196 TYPE(hfx_type),
DIMENSION(:, :),
POINTER :: x_data
197 TYPE(local_rho_type),
POINTER :: local_rho_set, local_rho_set_admm, local_rho_set_f, &
198 local_rho_set_f_admm, local_rho_set_g, local_rho_set_g_admm
199 TYPE(mp_para_env_type),
POINTER :: para_env
200 TYPE(neighbor_list_set_p_type),
DIMENSION(:), &
201 POINTER :: sab, sab_aux_fit, sab_orb, sap_oce
202 TYPE(oce_matrix_type),
POINTER :: oce
203 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
204 TYPE(pw_c1d_gs_type) :: rhox_tot_gspace, xv_hartree_gspace
205 TYPE(pw_c1d_gs_type),
DIMENSION(:),
POINTER :: rho_g_aux, rhox_g, rhox_g_aux, rhoxx_g
206 TYPE(pw_env_type),
POINTER :: pw_env
207 TYPE(pw_poisson_type),
POINTER :: poisson_env
208 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool
209 TYPE(pw_r3d_rs_type) :: xv_hartree_rspace
210 TYPE(pw_r3d_rs_type),
DIMENSION(:),
POINTER :: fxc_rho, fxc_tau, gxc_rho, gxc_tau, &
211 rho_r_aux, rhox_r, rhox_r_aux, rhoxx_r
212 TYPE(qs_force_type),
DIMENSION(:),
POINTER :: force
213 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
214 TYPE(qs_ks_env_type),
POINTER :: ks_env
215 TYPE(qs_rho_type),
POINTER :: rho, rho_aux_fit, rhox, rhox_aux
216 TYPE(rho_atom_type),
DIMENSION(:),
POINTER :: rho_atom_set, rho_atom_set_f, &
218 TYPE(section_vals_type),
POINTER :: hfx_section, xc_section
219 TYPE(task_list_type),
POINTER :: task_list
220 TYPE(tddfpt2_control_type),
POINTER :: tddfpt_control
222 CALL timeset(routinen, handle)
225 IF (logger%para_env%is_source())
THEN
231 CALL get_qs_env(qs_env, dft_control=dft_control)
232 tddfpt_control => dft_control%tddfpt2_control
233 nspins = dft_control%nspins
234 is_rks_triplets = tddfpt_control%rks_triplets .AND. (nspins == 1)
236 do_hfx = tddfpt_control%do_hfx
237 do_hfxsr = tddfpt_control%do_hfxsr
238 do_hfxlr = tddfpt_control%do_hfxlr
239 do_admm = tddfpt_control%do_admm
240 gapw = dft_control%qs_control%gapw
241 gapw_xc = dft_control%qs_control%gapw_xc
243 evect => ex_env%evect
244 matrix_px1 => ex_env%matrix_px1
245 matrix_px1_admm => ex_env%matrix_px1_admm
246 matrix_px1_asymm => ex_env%matrix_px1_asymm
247 matrix_px1_admm_asymm => ex_env%matrix_px1_admm_asymm
250 IF (nspins == 2) focc = 0.5_dp
252 CALL dbcsr_set(matrix_px1(ispin)%matrix, 0.0_dp)
255 matrix_v=evect(ispin), &
256 matrix_g=gs_mos(ispin)%mos_occ, &
257 ncol=norb, alpha=2.0_dp*focc, symmetry_mode=1)
259 CALL dbcsr_set(matrix_px1_asymm(ispin)%matrix, 0.0_dp)
262 matrix_v=gs_mos(ispin)%mos_occ, &
263 matrix_g=evect(ispin), &
264 ncol=norb, alpha=2.0_dp*focc, &
268 CALL get_qs_env(qs_env, ks_env=ks_env, pw_env=pw_env, para_env=para_env)
270 NULLIFY (hartree_local, local_rho_set, local_rho_set_admm)
271 IF (gapw .OR. gapw_xc)
THEN
272 IF (nspins == 2)
THEN
274 CALL dbcsr_scale(matrix_px1(ispin)%matrix, 2.0_dp)
278 atomic_kind_set=atomic_kind_set, &
279 qs_kind_set=qs_kind_set)
282 qs_kind_set, dft_control, para_env)
285 CALL init_rho0(local_rho_set, qs_env, dft_control%qs_control%gapw_control, &
292 CALL get_qs_env(qs_env=qs_env, oce=oce, sap_oce=sap_oce, sab_orb=sab)
294 CALL get_qs_env(qs_env=qs_env, nkind=nkind, particle_set=particle_set)
296 eps_fit = dft_control%qs_control%gapw_control%eps_fit
301 mpga(1:nspins, 1:1) => matrix_px1(1:nspins)
303 qs_kind_set, oce, sab, para_env)
308 qs_kind_set, dft_control, para_env)
310 qs_kind_set, oce, sab, para_env)
315 qs_kind_set, dft_control, para_env)
317 qs_kind_set, oce, sab, para_env)
319 IF (nspins == 2)
THEN
321 CALL dbcsr_scale(matrix_px1(ispin)%matrix, 0.5_dp)
328 nao_aux = admm_env%nao_aux_fit
329 nao = admm_env%nao_orb
333 CALL parallel_gemm(
'N',
'N', nao_aux, nao, nao, &
334 1.0_dp, admm_env%A, admm_env%work_orb_orb, 0.0_dp, &
335 admm_env%work_aux_orb)
336 CALL parallel_gemm(
'N',
'T', nao_aux, nao_aux, nao, &
337 1.0_dp, admm_env%work_aux_orb, admm_env%A, 0.0_dp, &
338 admm_env%work_aux_aux)
339 CALL copy_fm_to_dbcsr(admm_env%work_aux_aux, matrix_px1_admm(ispin)%matrix, &
340 keep_sparsity=.true.)
342 CALL copy_dbcsr_to_fm(matrix_px1_asymm(ispin)%matrix, admm_env%work_orb_orb)
343 CALL parallel_gemm(
'N',
'N', nao_aux, nao, nao, &
344 1.0_dp, admm_env%A, admm_env%work_orb_orb, 0.0_dp, &
345 admm_env%work_aux_orb)
346 CALL parallel_gemm(
'N',
'T', nao_aux, nao_aux, nao, &
347 1.0_dp, admm_env%work_aux_orb, admm_env%A, 0.0_dp, &
348 admm_env%work_aux_aux)
349 CALL copy_fm_to_dbcsr(admm_env%work_aux_aux, matrix_px1_admm_asymm(ispin)%matrix, &
350 keep_sparsity=.true.)
353 IF (admm_env%do_gapw)
THEN
354 IF (do_admm .AND. tddfpt_control%admm_xc_correction)
THEN
358 CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set)
361 admm_env%admm_gapw_env%admm_kind_set, dft_control, para_env)
362 mpga(1:nspins, 1:1) => matrix_px1_admm(1:nspins)
365 admm_env%admm_gapw_env%admm_kind_set, &
366 admm_env%admm_gapw_env%oce, sab_aux_fit, para_env)
368 kind_set_external=admm_env%admm_gapw_env%admm_kind_set)
372 admm_env%admm_gapw_env%admm_kind_set, dft_control, para_env)
374 admm_env%admm_gapw_env%admm_kind_set, &
375 admm_env%admm_gapw_env%oce, sab_aux_fit, para_env)
377 kind_set_external=admm_env%admm_gapw_env%admm_kind_set)
381 admm_env%admm_gapw_env%admm_kind_set, dft_control, para_env)
383 admm_env%admm_gapw_env%admm_kind_set, &
384 admm_env%admm_gapw_env%oce, sab_aux_fit, para_env)
386 kind_set_external=admm_env%admm_gapw_env%admm_kind_set)
392 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
393 poisson_env=poisson_env)
395 ALLOCATE (rhox_r(nspins), rhox_g(nspins))
397 CALL auxbas_pw_pool%create_pw(rhox_r(ispin))
398 CALL auxbas_pw_pool%create_pw(rhox_g(ispin))
400 CALL auxbas_pw_pool%create_pw(rhox_tot_gspace)
402 CALL pw_zero(rhox_tot_gspace)
404 IF (nspins == 2)
CALL dbcsr_scale(matrix_px1(ispin)%matrix, 2.0_dp)
406 rho=rhox_r(ispin), rho_gspace=rhox_g(ispin), &
408 CALL pw_axpy(rhox_g(ispin), rhox_tot_gspace)
409 IF (nspins == 2)
CALL dbcsr_scale(matrix_px1(ispin)%matrix, 0.5_dp)
413 ALLOCATE (rhoxx_r(nspins), rhoxx_g(nspins))
415 CALL auxbas_pw_pool%create_pw(rhoxx_r(ispin))
416 CALL auxbas_pw_pool%create_pw(rhoxx_g(ispin))
419 IF (nspins == 2)
CALL dbcsr_scale(matrix_px1(ispin)%matrix, 2.0_dp)
421 rho=rhoxx_r(ispin), rho_gspace=rhoxx_g(ispin), &
423 IF (nspins == 2)
CALL dbcsr_scale(matrix_px1(ispin)%matrix, 0.5_dp)
427 CALL get_qs_env(qs_env, matrix_s=matrix_s, force=force)
429 IF (.NOT. is_rks_triplets)
THEN
430 CALL auxbas_pw_pool%create_pw(xv_hartree_rspace)
431 CALL auxbas_pw_pool%create_pw(xv_hartree_gspace)
434 CALL pw_axpy(local_rho_set%rho0_mpole%rho0_s_gs, rhox_tot_gspace)
436 CALL pw_poisson_solve(poisson_env, rhox_tot_gspace, xehartree, &
438 CALL pw_transfer(xv_hartree_gspace, xv_hartree_rspace)
439 CALL pw_scale(xv_hartree_rspace, xv_hartree_rspace%pw_grid%dvol)
441 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
445 ALLOCATE (matrix_hx(ispin)%matrix)
446 CALL dbcsr_create(matrix_hx(ispin)%matrix, template=matrix_s(1)%matrix)
447 CALL dbcsr_copy(matrix_hx(ispin)%matrix, matrix_s(1)%matrix)
448 CALL dbcsr_set(matrix_hx(ispin)%matrix, 0.0_dp)
449 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=xv_hartree_rspace, &
450 pmat=matrix_px1(ispin), hmat=matrix_hx(ispin), &
451 gapw=gapw, calculate_forces=.true.)
453 IF (debug_forces)
THEN
454 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
455 CALL para_env%sum(fodeb)
456 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Px*dKh[X] ", fodeb
459 IF (debug_forces) fodeb(1:3) = force(1)%g0s_Vh_elec(1:3, 1)
460 CALL vh_1c_gg_integrals(qs_env, eh1c, hartree_local%ecoul_1c, local_rho_set, para_env, tddft=.true., &
462 IF (nspins == 1)
THEN
468 local_rho_set=local_rho_set, kforce=kval)
469 IF (debug_forces)
THEN
470 fodeb(1:3) = force(1)%g0s_Vh_elec(1:3, 1) - fodeb(1:3)
471 CALL para_env%sum(fodeb)
472 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Px*dKh[X]PAWg0", fodeb
474 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
475 CALL update_ks_atom(qs_env, matrix_hx, matrix_px1, forces=.true., &
476 rho_atom_external=local_rho_set%rho_atom_set)
477 IF (debug_forces)
THEN
478 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
479 CALL para_env%sum(fodeb)
480 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Px*dKh[X]PAW ", fodeb
486 IF (full_kernel%do_exck)
THEN
489 NULLIFY (fxc_rho, fxc_tau, gxc_rho, gxc_tau)
490 xc_section => full_kernel%xc_section
494 SELECT CASE (ex_env%xc_kernel_method)
502 do_analytic = .false.
505 cpabort(
"invalid xc_kernel_method")
507 order = ex_env%diff_order
508 eps_delta = ex_env%eps_delta_rho
511 CALL get_qs_env(qs_env=qs_env, ks_env=ks_env, rho_xc=rho)
513 CALL get_qs_env(qs_env=qs_env, ks_env=ks_env, rho=rho)
520 CALL qs_rho_set(rho_struct=rhox, rho_ao=matrix_px1, rho_r=rhoxx_r, rho_g=rhoxx_g, &
521 rho_r_valid=.true., rho_g_valid=.true.)
523 CALL qs_rho_set(rho_struct=rhox, rho_ao=matrix_px1, rho_r=rhox_r, rho_g=rhox_g, &
524 rho_r_valid=.true., rho_g_valid=.true.)
526 IF (do_analytic .AND. .NOT. do_numeric)
THEN
527 cpabort(
"Analytic 3rd EXC derivatives not available")
528 ELSEIF (do_numeric)
THEN
529 IF (do_analytic)
THEN
530 CALL qs_fgxc_gdiff(ks_env, rho, rhox, xc_section, order, eps_delta, is_rks_triplets, &
531 fxc_rho, fxc_tau, gxc_rho, gxc_tau)
533 CALL qs_fgxc_create(ks_env, rho, rhox, xc_section, order, is_rks_triplets, &
534 fxc_rho, fxc_tau, gxc_rho, gxc_tau)
537 cpabort(
"FHXC forces analytic/numeric")
546 IF (nspins == 2)
THEN
548 CALL pw_scale(gxc_rho(ispin), 0.5_dp)
549 IF (
ASSOCIATED(gxc_tau))
CALL pw_scale(gxc_tau(ispin), 0.5_dp)
552 IF (gapw .OR. gapw_xc)
THEN
553 IF (do_analytic .AND. .NOT. do_numeric)
THEN
554 cpabort(
"Analytic 3rd EXC derivatives not available")
555 ELSEIF (do_numeric)
THEN
556 IF (do_analytic)
THEN
558 local_rho_set_f%rho_atom_set, local_rho_set_g%rho_atom_set, &
559 qs_kind_set, xc_section, is_rks_triplets, order, eps_delta)
562 local_rho_set_f%rho_atom_set, local_rho_set_g%rho_atom_set, &
563 qs_kind_set, xc_section, is_rks_triplets, order)
566 cpabort(
"FHXC forces analytic/numeric")
570 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
574 ALLOCATE (matrix_fx(ispin)%matrix)
575 CALL dbcsr_create(matrix_fx(ispin)%matrix, template=matrix_s(1)%matrix)
576 CALL dbcsr_copy(matrix_fx(ispin)%matrix, matrix_s(1)%matrix)
577 CALL dbcsr_set(matrix_fx(ispin)%matrix, 0.0_dp)
578 CALL pw_scale(fxc_rho(ispin), fxc_rho(ispin)%pw_grid%dvol)
579 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=fxc_rho(ispin), &
580 pmat=matrix_px1(ispin), hmat=matrix_fx(ispin), &
581 gapw=(gapw .OR. gapw_xc), calculate_forces=.true.)
583 IF (debug_forces)
THEN
584 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
585 CALL para_env%sum(fodeb)
586 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Px*dKf[X] ", fodeb
589 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
593 ALLOCATE (matrix_gx(ispin)%matrix)
594 CALL dbcsr_create(matrix_gx(ispin)%matrix, template=matrix_s(1)%matrix)
595 CALL dbcsr_copy(matrix_gx(ispin)%matrix, matrix_s(1)%matrix)
596 CALL dbcsr_set(matrix_gx(ispin)%matrix, 0.0_dp)
597 CALL pw_scale(gxc_rho(ispin), gxc_rho(ispin)%pw_grid%dvol)
598 CALL pw_scale(gxc_rho(ispin), 0.5_dp)
599 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=gxc_rho(ispin), &
600 pmat=matrix_p(ispin), hmat=matrix_gx(ispin), &
601 gapw=(gapw .OR. gapw_xc), calculate_forces=.true.)
602 CALL dbcsr_scale(matrix_gx(ispin)%matrix, 2.0_dp)
604 IF (debug_forces)
THEN
605 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
606 CALL para_env%sum(fodeb)
607 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: P*dKg[X] ", fodeb
611 IF (gapw .OR. gapw_xc)
THEN
612 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
613 CALL update_ks_atom(qs_env, matrix_fx, matrix_px1, forces=.true., tddft=.true., &
614 rho_atom_external=local_rho_set_f%rho_atom_set, &
615 kintegral=1.0_dp, kforce=1.0_dp)
616 IF (debug_forces)
THEN
617 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
618 CALL para_env%sum(fodeb)
619 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Px*dKf[X]PAW ", fodeb
621 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
622 IF (nspins == 1)
THEN
623 CALL update_ks_atom(qs_env, matrix_gx, matrix_p, forces=.true., tddft=.true., &
624 rho_atom_external=local_rho_set_g%rho_atom_set, &
628 rho_atom_external=local_rho_set_g%rho_atom_set, &
629 kintegral=0.5_dp, kforce=0.25_dp)
631 IF (debug_forces)
THEN
632 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
633 CALL para_env%sum(fodeb)
634 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Px*dKg[X]PAW ", fodeb
640 IF (do_admm .AND. tddfpt_control%admm_xc_correction)
THEN
644 IF (.NOT. tddfpt_control%admm_symm)
THEN
645 CALL cp_warn(__location__,
"Forces need symmetric ADMM kernel corrections")
646 cpabort(
"ADMM KERNEL CORRECTION")
648 xc_section => admm_env%xc_section_aux
649 CALL get_admm_env(admm_env, rho_aux_fit=rho_aux_fit, matrix_s_aux_fit=matrix_s_aux_fit, &
650 task_list_aux_fit=task_list)
651 basis_type =
"AUX_FIT"
652 IF (admm_env%do_gapw)
THEN
653 basis_type =
"AUX_FIT_SOFT"
654 task_list => admm_env%admm_gapw_env%task_list
661 ALLOCATE (mfx(ispin)%matrix, mgx(ispin)%matrix)
662 CALL dbcsr_create(mfx(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix)
663 CALL dbcsr_copy(mfx(ispin)%matrix, matrix_s_aux_fit(1)%matrix)
664 CALL dbcsr_set(mfx(ispin)%matrix, 0.0_dp)
665 CALL dbcsr_create(mgx(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix)
666 CALL dbcsr_copy(mgx(ispin)%matrix, matrix_s_aux_fit(1)%matrix)
667 CALL dbcsr_set(mgx(ispin)%matrix, 0.0_dp)
671 NULLIFY (rho_g_aux, rho_r_aux, rhox_g_aux, rhox_r_aux)
672 CALL qs_rho_get(rho_aux_fit, rho_r=rho_r_aux, rho_g=rho_g_aux)
673 CALL qs_rho_get(rho_aux_fit, rho_ao=matrix_p_admm)
675 ALLOCATE (rhox_r_aux(nspins), rhox_g_aux(nspins))
677 CALL auxbas_pw_pool%create_pw(rhox_r_aux(ispin))
678 CALL auxbas_pw_pool%create_pw(rhox_g_aux(ispin))
682 rho=rhox_r_aux(ispin), rho_gspace=rhox_g_aux(ispin), &
683 basis_type=basis_type, &
684 task_list_external=task_list)
690 CALL qs_rho_set(rho_struct=rhox_aux, rho_ao=matrix_px1_admm, &
691 rho_r=rhox_r_aux, rho_g=rhox_g_aux, &
692 rho_r_valid=.true., rho_g_valid=.true.)
693 IF (do_analytic .AND. .NOT. do_numeric)
THEN
694 cpabort(
"Analytic 3rd derivatives of EXC not available")
695 ELSEIF (do_numeric)
THEN
696 IF (do_analytic)
THEN
697 CALL qs_fgxc_gdiff(ks_env, rho_aux_fit, rhox_aux, xc_section, order, eps_delta, &
698 is_rks_triplets, fxc_rho, fxc_tau, gxc_rho, gxc_tau)
701 order, is_rks_triplets, fxc_rho, fxc_tau, gxc_rho, gxc_tau)
704 cpabort(
"FHXC forces analytic/numeric")
711 DEALLOCATE (rhox_aux)
714 CALL auxbas_pw_pool%give_back_pw(rhox_r_aux(ispin))
715 CALL auxbas_pw_pool%give_back_pw(rhox_g_aux(ispin))
717 DEALLOCATE (rhox_r_aux, rhox_g_aux)
719 IF (nspins == 2) fscal = 2.0_dp
721 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
723 CALL pw_scale(fxc_rho(ispin), fxc_rho(ispin)%pw_grid%dvol)
724 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=fxc_rho(ispin), &
726 pmat=matrix_px1_admm(ispin), &
727 basis_type=basis_type, &
728 calculate_forces=.true., &
730 task_list_external=task_list)
732 IF (debug_forces)
THEN
733 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
734 CALL para_env%sum(fodeb)
735 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Px*dKf[X]ADMM", fodeb
738 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
740 CALL pw_scale(gxc_rho(ispin), gxc_rho(ispin)%pw_grid%dvol)
741 CALL pw_scale(gxc_rho(ispin), 0.5_dp)
742 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=gxc_rho(ispin), &
744 pmat=matrix_p_admm(ispin), &
745 basis_type=basis_type, &
746 calculate_forces=.true., &
748 task_list_external=task_list)
749 CALL dbcsr_scale(mgx(ispin)%matrix, 2.0_dp)
751 IF (debug_forces)
THEN
752 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
753 CALL para_env%sum(fodeb)
754 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: P*dKg[X]ADMM", fodeb
758 IF (admm_env%do_gapw)
THEN
760 rho_atom_set => admm_env%admm_gapw_env%local_rho_set%rho_atom_set
761 rho_atom_set_f => local_rho_set_f_admm%rho_atom_set
762 rho_atom_set_g => local_rho_set_g_admm%rho_atom_set
764 IF (do_analytic .AND. .NOT. do_numeric)
THEN
765 cpabort(
"Analytic 3rd EXC derivatives not available")
766 ELSEIF (do_numeric)
THEN
767 IF (do_analytic)
THEN
769 rho_atom_set_f, rho_atom_set_g, &
770 admm_env%admm_gapw_env%admm_kind_set, xc_section, &
771 is_rks_triplets, order, eps_delta)
774 rho_atom_set_f, rho_atom_set_g, &
775 admm_env%admm_gapw_env%admm_kind_set, xc_section, &
776 is_rks_triplets, order)
779 cpabort(
"FHXC forces analytic/numeric")
782 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
783 IF (nspins == 1)
THEN
784 CALL update_ks_atom(qs_env, mfx, matrix_px1_admm, forces=.true., &
785 rho_atom_external=rho_atom_set_f, &
786 kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
787 oce_external=admm_env%admm_gapw_env%oce, sab_external=sab_aux_fit, &
788 kintegral=2.0_dp, kforce=0.5_dp)
790 CALL update_ks_atom(qs_env, mfx, matrix_px1_admm, forces=.true., &
791 rho_atom_external=rho_atom_set_f, &
792 kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
793 oce_external=admm_env%admm_gapw_env%oce, sab_external=sab_aux_fit, &
794 kintegral=2.0_dp, kforce=1.0_dp)
796 IF (debug_forces)
THEN
797 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
798 CALL para_env%sum(fodeb)
799 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Px*dKf[X]ADMM-PAW ", fodeb
801 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
802 IF (nspins == 1)
THEN
804 rho_atom_external=rho_atom_set_g, &
805 kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
806 oce_external=admm_env%admm_gapw_env%oce, sab_external=sab_aux_fit, &
807 kintegral=1.0_dp, kforce=0.5_dp)
810 rho_atom_external=rho_atom_set_g, &
811 kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
812 oce_external=admm_env%admm_gapw_env%oce, sab_external=sab_aux_fit, &
813 kintegral=1.0_dp, kforce=1.0_dp)
815 IF (debug_forces)
THEN
816 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
817 CALL para_env%sum(fodeb)
818 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: P*dKg[X]ADMM-PAW ", fodeb
824 IF (debug_forces) fodeb(1:3) = force(1)%overlap_admm(1:3, 1)
825 fval = 2.0_dp*real(nspins, kind=
dp)
827 IF (debug_forces)
THEN
828 fodeb(1:3) = force(1)%overlap_admm(1:3, 1) - fodeb(1:3)
829 CALL para_env%sum(fodeb)
830 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: P*dfXC(P)*S' ", fodeb
832 IF (debug_forces) fodeb(1:3) = force(1)%overlap_admm(1:3, 1)
833 fval = 2.0_dp*real(nspins, kind=
dp)
835 IF (debug_forces)
THEN
836 fodeb(1:3) = force(1)%overlap_admm(1:3, 1) - fodeb(1:3)
837 CALL para_env%sum(fodeb)
838 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: P*dgXC(P)*S' ", fodeb
843 IF (nspins == 2) fscal = 2.0_dp
844 nao = admm_env%nao_orb
845 nao_aux = admm_env%nao_aux_fit
847 CALL dbcsr_create(dbwork, template=matrix_fx(1)%matrix)
851 admm_env%work_aux_orb, nao)
852 CALL parallel_gemm(
'T',
'N', nao, nao, nao_aux, &
853 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
854 admm_env%work_orb_orb)
855 CALL dbcsr_copy(dbwork, matrix_fx(1)%matrix)
856 CALL dbcsr_set(dbwork, 0.0_dp)
858 CALL dbcsr_add(matrix_fx(ispin)%matrix, dbwork, 1.0_dp, fscal)
861 admm_env%work_aux_orb, nao)
862 CALL parallel_gemm(
'T',
'N', nao, nao, nao_aux, &
863 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
864 admm_env%work_orb_orb)
865 CALL dbcsr_set(dbwork, 0.0_dp)
867 CALL dbcsr_add(matrix_gx(ispin)%matrix, dbwork, 1.0_dp, fscal)
869 CALL dbcsr_release(dbwork)
878 CALL auxbas_pw_pool%give_back_pw(rhox_r(ispin))
879 CALL auxbas_pw_pool%give_back_pw(rhox_g(ispin))
881 DEALLOCATE (rhox_r, rhox_g)
882 CALL auxbas_pw_pool%give_back_pw(rhox_tot_gspace)
885 CALL auxbas_pw_pool%give_back_pw(rhoxx_r(ispin))
886 CALL auxbas_pw_pool%give_back_pw(rhoxx_g(ispin))
888 DEALLOCATE (rhoxx_r, rhoxx_g)
890 IF (.NOT. is_rks_triplets)
THEN
891 CALL auxbas_pw_pool%give_back_pw(xv_hartree_rspace)
892 CALL auxbas_pw_pool%give_back_pw(xv_hartree_gspace)
897 NULLIFY (matrix_hfx, matrix_hfx_asymm)
901 ALLOCATE (matrix_hfx(ispin)%matrix)
902 CALL dbcsr_create(matrix_hfx(ispin)%matrix, template=matrix_s(1)%matrix)
903 CALL dbcsr_copy(matrix_hfx(ispin)%matrix, matrix_s(1)%matrix)
904 CALL dbcsr_set(matrix_hfx(ispin)%matrix, 0.0_dp)
906 ALLOCATE (matrix_hfx_asymm(ispin)%matrix)
907 CALL dbcsr_create(matrix_hfx_asymm(ispin)%matrix, template=matrix_s(1)%matrix, &
908 matrix_type=dbcsr_type_antisymmetric)
909 CALL dbcsr_complete_redistribute(matrix_hfx(ispin)%matrix, matrix_hfx_asymm(ispin)%matrix)
912 xc_section => full_kernel%xc_section
915 cpassert(n_rep_hf == 1)
919 IF (hfx_treat_lsd_in_core) mspin = nspins
921 CALL get_qs_env(qs_env=qs_env, x_data=x_data, s_mstruct_changed=s_mstruct_changed)
922 distribute_fock_matrix = .true.
925 CALL get_admm_env(qs_env%admm_env, matrix_s_aux_fit=matrix_s_aux_fit)
926 NULLIFY (matrix_hfx_admm, matrix_hfx_admm_asymm)
930 ALLOCATE (matrix_hfx_admm(ispin)%matrix)
931 CALL dbcsr_create(matrix_hfx_admm(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix)
932 CALL dbcsr_copy(matrix_hfx_admm(ispin)%matrix, matrix_s_aux_fit(1)%matrix)
933 CALL dbcsr_set(matrix_hfx_admm(ispin)%matrix, 0.0_dp)
935 ALLOCATE (matrix_hfx_admm_asymm(ispin)%matrix)
936 CALL dbcsr_create(matrix_hfx_admm_asymm(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix, &
937 matrix_type=dbcsr_type_antisymmetric)
938 CALL dbcsr_complete_redistribute(matrix_hfx_admm(ispin)%matrix, matrix_hfx_admm_asymm(ispin)%matrix)
942 ALLOCATE (mpe(nspins, 1), mhe(nspins, 1))
944 mhe(ispin, 1)%matrix => matrix_hfx_admm(ispin)%matrix
945 mpe(ispin, 1)%matrix => matrix_px1_admm(ispin)%matrix
947 IF (x_data(1, 1)%do_hfx_ri)
THEN
950 geometry_did_change=s_mstruct_changed, nspins=nspins, &
951 hf_fraction=x_data(1, 1)%general_parameter%fraction)
956 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
962 mhe(ispin, 1)%matrix => matrix_hfx_admm_asymm(ispin)%matrix
963 mpe(ispin, 1)%matrix => matrix_px1_admm_asymm(ispin)%matrix
965 IF (x_data(1, 1)%do_hfx_ri)
THEN
968 geometry_did_change=s_mstruct_changed, nspins=nspins, &
969 hf_fraction=x_data(1, 1)%general_parameter%fraction)
974 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
979 nao = admm_env%nao_orb
980 nao_aux = admm_env%nao_aux_fit
981 ALLOCATE (dbwork, dbwork_asymm)
982 CALL dbcsr_create(dbwork, template=matrix_hfx(1)%matrix)
983 CALL dbcsr_create(dbwork_asymm, template=matrix_hfx(1)%matrix, matrix_type=dbcsr_type_antisymmetric)
986 admm_env%work_aux_orb, nao)
987 CALL parallel_gemm(
'T',
'N', nao, nao, nao_aux, &
988 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
989 admm_env%work_orb_orb)
990 CALL dbcsr_copy(dbwork, matrix_hfx(1)%matrix)
991 CALL dbcsr_set(dbwork, 0.0_dp)
993 CALL dbcsr_add(matrix_hfx(ispin)%matrix, dbwork, 1.0_dp, 1.0_dp)
996 admm_env%work_aux_orb, nao)
997 CALL parallel_gemm(
'T',
'N', nao, nao, nao_aux, &
998 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
999 admm_env%work_orb_orb)
1000 CALL dbcsr_copy(dbwork_asymm, matrix_hfx_asymm(1)%matrix)
1001 CALL dbcsr_set(dbwork_asymm, 0.0_dp)
1002 CALL copy_fm_to_dbcsr(admm_env%work_orb_orb, dbwork_asymm, keep_sparsity=.true.)
1003 CALL dbcsr_add(matrix_hfx_asymm(ispin)%matrix, dbwork_asymm, 1.0_dp, 1.0_dp)
1005 CALL dbcsr_release(dbwork)
1006 CALL dbcsr_release(dbwork_asymm)
1007 DEALLOCATE (dbwork, dbwork_asymm)
1010 IF (debug_forces) fodeb(1:3) = force(1)%overlap_admm(1:3, 1)
1011 fval = 4.0_dp*real(nspins, kind=
dp)*0.5_dp
1014 IF (debug_forces)
THEN
1015 fodeb(1:3) = force(1)%overlap_admm(1:3, 1) - fodeb(1:3)
1016 CALL para_env%sum(fodeb)
1017 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: P*Hx(P)*S' ", fodeb
1020 use_virial = .false.
1022 fval = 2.0_dp*real(nspins, kind=
dp)*0.5_dp
1023 IF (debug_forces) fodeb(1:3) = force(1)%fock_4c(1:3, 1)
1024 DO ispin = 1, nspins
1025 mpe(ispin, 1)%matrix => matrix_px1_admm(ispin)%matrix
1027 IF (x_data(1, 1)%do_hfx_ri)
THEN
1029 x_data(1, 1)%general_parameter%fraction, &
1030 rho_ao=mpe, rho_ao_resp=mdum, &
1031 use_virial=use_virial, rescale_factor=fval)
1034 adiabatic_rescale_factor=fval)
1036 DO ispin = 1, nspins
1037 mpe(ispin, 1)%matrix => matrix_px1_admm_asymm(ispin)%matrix
1039 IF (x_data(1, 1)%do_hfx_ri)
THEN
1041 x_data(1, 1)%general_parameter%fraction, &
1042 rho_ao=mpe, rho_ao_resp=mdum, &
1043 use_virial=use_virial, rescale_factor=fval)
1046 adiabatic_rescale_factor=fval)
1048 IF (debug_forces)
THEN
1049 fodeb(1:3) = force(1)%fock_4c(1:3, 1) - fodeb(1:3)
1050 CALL para_env%sum(fodeb)
1051 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Px*hfx'*Px ", fodeb
1054 DEALLOCATE (mpe, mhe)
1060 ALLOCATE (mpe(nspins, 1), mhe(nspins, 1))
1061 DO ispin = 1, nspins
1062 mhe(ispin, 1)%matrix => matrix_hfx(ispin)%matrix
1063 mpe(ispin, 1)%matrix => matrix_px1(ispin)%matrix
1065 IF (x_data(1, 1)%do_hfx_ri)
THEN
1067 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhe, eh1, rho_ao=mpe, &
1068 geometry_did_change=s_mstruct_changed, nspins=nspins, &
1069 hf_fraction=x_data(1, 1)%general_parameter%fraction)
1074 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
1080 DO ispin = 1, nspins
1081 mhe(ispin, 1)%matrix => matrix_hfx_asymm(ispin)%matrix
1082 mpe(ispin, 1)%matrix => matrix_px1_asymm(ispin)%matrix
1084 IF (x_data(1, 1)%do_hfx_ri)
THEN
1086 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhe, eh1, rho_ao=mpe, &
1087 geometry_did_change=s_mstruct_changed, nspins=nspins, &
1088 hf_fraction=x_data(1, 1)%general_parameter%fraction)
1093 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
1098 use_virial = .false.
1100 fval = 2.0_dp*real(nspins, kind=
dp)*0.5_dp
1101 IF (debug_forces) fodeb(1:3) = force(1)%fock_4c(1:3, 1)
1102 DO ispin = 1, nspins
1103 mpe(ispin, 1)%matrix => matrix_px1(ispin)%matrix
1105 IF (x_data(1, 1)%do_hfx_ri)
THEN
1107 x_data(1, 1)%general_parameter%fraction, &
1108 rho_ao=mpe, rho_ao_resp=mdum, &
1109 use_virial=use_virial, rescale_factor=fval)
1112 adiabatic_rescale_factor=fval)
1114 DO ispin = 1, nspins
1115 mpe(ispin, 1)%matrix => matrix_px1_asymm(ispin)%matrix
1117 IF (x_data(1, 1)%do_hfx_ri)
THEN
1119 x_data(1, 1)%general_parameter%fraction, &
1120 rho_ao=mpe, rho_ao_resp=mdum, &
1121 use_virial=use_virial, rescale_factor=fval)
1124 adiabatic_rescale_factor=fval)
1126 IF (debug_forces)
THEN
1127 fodeb(1:3) = force(1)%fock_4c(1:3, 1) - fodeb(1:3)
1128 CALL para_env%sum(fodeb)
1129 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Px*hfx'*Px ", fodeb
1132 DEALLOCATE (mpe, mhe)
1134 fval = 2.0_dp*real(nspins, kind=
dp)*0.5_dp
1135 DO ispin = 1, nspins
1136 CALL dbcsr_scale(matrix_hfx(ispin)%matrix, fval)
1137 CALL dbcsr_scale(matrix_hfx_asymm(ispin)%matrix, fval)
1141 IF (gapw .OR. gapw_xc)
THEN
1150 IF (admm_env%do_gapw)
THEN
1151 IF (tddfpt_control%admm_xc_correction)
THEN
1163 cpabort(
"HFXSR not implemented")
1167 cpabort(
"HFXLR not implemented")
1171 NULLIFY (matrix_wx1)
1173 cpmos => ex_env%cpmos
1175 IF (nspins == 2) focc = 1.0_dp
1176 DO ispin = 1, nspins
1177 mos => gs_mos(ispin)%mos_occ
1180 CALL cp_fm_get_info(vcvec, matrix_struct=fm_struct, nrow_global=nao)
1182 ncol_global=norb, para_env=fm_struct%para_env)
1186 ALLOCATE (matrix_wx1(ispin)%matrix)
1187 CALL dbcsr_create(matrix=matrix_wx1(ispin)%matrix, template=matrix_s(1)%matrix)
1189 CALL dbcsr_set(matrix_wx1(ispin)%matrix, 0.0_dp)
1191 IF (.NOT. is_rks_triplets)
THEN
1193 cpmos(ispin), norb, alpha=focc, beta=1.0_dp)
1195 CALL parallel_gemm(
"T",
"N", norb, norb, nao, 1.0_dp, mos, vcvec, 0.0_dp, cvcmat)
1196 CALL parallel_gemm(
"N",
"N", nao, norb, norb, 1.0_dp, evect(ispin), cvcmat, 0.0_dp, vcvec)
1198 norb, alpha=-focc, beta=1.0_dp)
1201 ncol=norb, alpha=2.0_dp, symmetry_mode=1)
1206 cpmos(ispin), norb, alpha=focc, beta=1.0_dp)
1208 CALL parallel_gemm(
"T",
"N", norb, norb, nao, 1.0_dp, mos, vcvec, 0.0_dp, cvcmat)
1209 CALL parallel_gemm(
"N",
"N", nao, norb, norb, 1.0_dp, evect(ispin), cvcmat, 0.0_dp, vcvec)
1211 norb, alpha=-focc, beta=1.0_dp)
1214 ncol=norb, alpha=2.0_dp, symmetry_mode=1)
1217 cpmos(ispin), norb, alpha=focc, beta=1.0_dp)
1220 CALL parallel_gemm(
"T",
"N", norb, norb, nao, 1.0_dp, mos, vcvec, 0.0_dp, cvcmat)
1221 CALL parallel_gemm(
"N",
"N", nao, norb, norb, 1.0_dp, mos, cvcmat, 0.0_dp, vcvec)
1223 ncol=norb, alpha=1.0_dp, symmetry_mode=1)
1228 cpmos(ispin), norb, alpha=focc, beta=1.0_dp)
1231 cpmos(ispin), norb, alpha=focc, beta=1.0_dp)
1234 CALL parallel_gemm(
"T",
"N", norb, norb, nao, 1.0_dp, mos, vcvec, 0.0_dp, cvcmat)
1235 CALL parallel_gemm(
"N",
"N", nao, norb, norb, 1.0_dp, evect(ispin), cvcmat, 0.0_dp, vcvec)
1237 norb, alpha=-focc, beta=1.0_dp)
1240 ncol=norb, alpha=2.0_dp, symmetry_mode=1)
1243 CALL cp_fm_release(vcvec)
1244 CALL cp_fm_release(cvcmat)
1247 IF (.NOT. is_rks_triplets)
THEN
1251 ex_env%matrix_wx1 => matrix_wx1
1261 CALL timestop(handle)
1275 SUBROUTINE stda_force(qs_env, ex_env, gs_mos, stda_env, sub_env, work, debug_forces)
1277 TYPE(qs_environment_type),
POINTER :: qs_env
1278 TYPE(excited_energy_type),
POINTER :: ex_env
1279 TYPE(tddfpt_ground_state_mos),
DIMENSION(:), &
1281 TYPE(stda_env_type),
POINTER :: stda_env
1282 TYPE(tddfpt_subgroup_env_type) :: sub_env
1283 TYPE(tddfpt_work_matrices) :: work
1284 LOGICAL,
INTENT(IN) :: debug_forces
1286 CHARACTER(len=*),
PARAMETER :: routinen =
'stda_force'
1288 INTEGER :: atom_i, atom_j, blk, ewald_type, handle, i, ia, iatom, idimk, ikind, iounit, is, &
1289 ispin, jatom, jkind, jspin, nao, natom, norb, nsgf, nspins
1290 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: atom_of_kind, first_sgf, kind_of, &
1292 INTEGER,
DIMENSION(2) :: nactive, nlim
1293 LOGICAL :: calculate_forces, do_coulomb, do_ewald, &
1294 found, is_rks_triplets, use_virial
1295 REAL(kind=
dp) :: alpha, bp, dgabr, dr, eta, fdim, gabr, &
1296 hfx, rbeta, spinfac, xfac
1297 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: tcharge, tv
1298 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: gtcharge
1299 REAL(kind=
dp),
DIMENSION(3) :: fij, fodeb, rij
1300 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: gab, pblock
1301 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
1302 TYPE(cell_type),
POINTER :: cell
1303 TYPE(cp_fm_struct_type),
POINTER :: fmstruct, fmstruct_mat, fmstructjspin
1304 TYPE(cp_fm_type) :: cvcmat, cvec, cvecjspin, t0matrix, &
1305 t1matrix, vcvec, xvec
1306 TYPE(cp_fm_type),
ALLOCATABLE,
DIMENSION(:) :: xtransformed
1307 TYPE(cp_fm_type),
DIMENSION(:),
POINTER :: cpmos, x
1308 TYPE(cp_fm_type),
POINTER :: ct, ctjspin, ucmatrix, uxmatrix
1309 TYPE(cp_logger_type),
POINTER :: logger
1310 TYPE(dbcsr_iterator_type) :: iter
1311 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: gamma_matrix, matrix_plo, matrix_s, &
1313 TYPE(dbcsr_type) :: pdens, ptrans
1314 TYPE(dbcsr_type),
POINTER :: tempmat
1315 TYPE(dft_control_type),
POINTER :: dft_control
1316 TYPE(ewald_environment_type),
POINTER :: ewald_env
1317 TYPE(ewald_pw_type),
POINTER :: ewald_pw
1318 TYPE(mp_para_env_type),
POINTER :: para_env
1319 TYPE(neighbor_list_set_p_type),
DIMENSION(:), &
1320 POINTER :: n_list, sab_orb
1321 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
1322 TYPE(qs_force_type),
DIMENSION(:),
POINTER :: force
1323 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
1324 TYPE(qs_ks_env_type),
POINTER :: ks_env
1325 TYPE(stda_control_type),
POINTER :: stda_control
1326 TYPE(tddfpt2_control_type),
POINTER :: tddfpt_control
1327 TYPE(virial_type),
POINTER :: virial
1329 CALL timeset(routinen, handle)
1331 cpassert(
ASSOCIATED(ex_env))
1332 cpassert(
ASSOCIATED(gs_mos))
1335 IF (logger%para_env%is_source())
THEN
1341 CALL get_qs_env(qs_env, dft_control=dft_control)
1342 tddfpt_control => dft_control%tddfpt2_control
1343 stda_control => tddfpt_control%stda_control
1344 nspins = dft_control%nspins
1345 is_rks_triplets = tddfpt_control%rks_triplets .AND. (nspins == 1)
1349 nactive(:) = stda_env%nactive(:)
1352 IF (nspins == 2) spinfac = 1.0_dp
1353 NULLIFY (matrix_wx1)
1355 NULLIFY (matrix_plo)
1358 IF (nspins == 1 .AND. is_rks_triplets)
THEN
1359 do_coulomb = .false.
1363 do_ewald = stda_control%do_ewald
1365 CALL get_qs_env(qs_env, para_env=para_env, force=force)
1367 CALL get_qs_env(qs_env, natom=natom, cell=cell, &
1368 particle_set=particle_set, qs_kind_set=qs_kind_set)
1369 ALLOCATE (first_sgf(natom))
1370 ALLOCATE (last_sgf(natom))
1371 CALL get_particle_set(particle_set, qs_kind_set, first_sgf=first_sgf, last_sgf=last_sgf)
1373 CALL get_qs_env(qs_env, ks_env=ks_env, matrix_s=matrix_s, sab_orb=sab_orb, atomic_kind_set=atomic_kind_set)
1374 CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, kind_of=kind_of, atom_of_kind=atom_of_kind)
1378 ALLOCATE (xtransformed(nspins))
1379 DO ispin = 1, nspins
1381 ct => work%ctransformed(ispin)
1383 CALL cp_fm_create(matrix=xtransformed(ispin), matrix_struct=fmstruct, name=
"XTRANSFORMED")
1387 ALLOCATE (tcharge(natom), gtcharge(natom, 4))
1389 cpmos => ex_env%cpmos
1391 DO ispin = 1, nspins
1392 ct => work%ctransformed(ispin)
1393 CALL cp_fm_get_info(ct, matrix_struct=fmstruct, nrow_global=nsgf)
1398 ALLOCATE (matrix_wx1(ispin)%matrix)
1399 CALL dbcsr_create(matrix=matrix_wx1(ispin)%matrix, template=matrix_s(1)%matrix)
1401 CALL dbcsr_set(matrix_wx1(ispin)%matrix, 0.0_dp)
1402 ALLOCATE (matrix_plo(ispin)%matrix)
1403 CALL dbcsr_create(matrix=matrix_plo(ispin)%matrix, template=matrix_s(1)%matrix)
1405 CALL dbcsr_set(matrix_plo(ispin)%matrix, 0.0_dp)
1409 IF (do_coulomb)
THEN
1411 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1414 DO jspin = 1, nspins
1415 ctjspin => work%ctransformed(jspin)
1417 CALL cp_fm_get_info(ctjspin, matrix_struct=fmstructjspin, nrow_global=nsgf)
1426 DO is = first_sgf(ia), last_sgf(ia)
1427 tcharge(ia) = tcharge(ia) + tv(is)
1430 CALL cp_fm_release(cvecjspin)
1437 NULLIFY (gamma_matrix)
1438 CALL setup_gamma(qs_env, stda_env, sub_env, gamma_matrix, ndim=4)
1439 tempmat => gamma_matrix(1)%matrix
1440 CALL dbcsr_iterator_start(iter, tempmat)
1441 DO WHILE (dbcsr_iterator_blocks_left(iter))
1442 CALL dbcsr_iterator_next_block(iter, iatom, jatom, gab, blk)
1443 gtcharge(iatom, 1) = gtcharge(iatom, 1) + gab(1, 1)*tcharge(jatom)
1444 IF (iatom /= jatom)
THEN
1445 gtcharge(jatom, 1) = gtcharge(jatom, 1) + gab(1, 1)*tcharge(iatom)
1449 CALL dbcsr_get_block_p(matrix=gamma_matrix(idimk)%matrix, &
1450 row=iatom, col=jatom, block=gab, found=found)
1452 gtcharge(iatom, idimk) = gtcharge(iatom, idimk) + gab(1, 1)*tcharge(jatom)
1453 IF (iatom /= jatom)
THEN
1454 gtcharge(jatom, idimk) = gtcharge(jatom, idimk) + fdim*gab(1, 1)*tcharge(iatom)
1459 CALL dbcsr_iterator_stop(iter)
1463 ewald_env => work%ewald_env
1464 ewald_pw => work%ewald_pw
1465 CALL ewald_env_get(ewald_env, alpha=alpha, ewald_type=ewald_type)
1466 CALL get_qs_env(qs_env=qs_env, sab_orb=n_list, virial=virial)
1467 use_virial = .false.
1468 calculate_forces = .false.
1469 CALL tb_ewald_overlap(gtcharge, tcharge, alpha, n_list, virial, use_virial)
1471 gtcharge, tcharge, calculate_forces, virial, use_virial)
1473 IF (para_env%is_source())
THEN
1474 gtcharge(:, 1) = gtcharge(:, 1) - 2._dp*alpha*
oorootpi*tcharge(:)
1477 nlim =
get_limit(natom, para_env%num_pe, para_env%mepos)
1478 DO iatom = nlim(1), nlim(2)
1479 DO jatom = 1, iatom - 1
1480 rij = particle_set(iatom)%r - particle_set(jatom)%r
1481 rij =
pbc(rij, cell)
1482 dr = sqrt(sum(rij(:)**2))
1483 IF (dr > 1.e-6_dp)
THEN
1484 gtcharge(iatom, 1) = gtcharge(iatom, 1) + tcharge(jatom)/dr
1485 gtcharge(jatom, 1) = gtcharge(jatom, 1) + tcharge(iatom)/dr
1487 gtcharge(iatom, idimk) = gtcharge(iatom, idimk) + rij(idimk - 1)*tcharge(jatom)/dr**3
1488 gtcharge(jatom, idimk) = gtcharge(jatom, idimk) - rij(idimk - 1)*tcharge(iatom)/dr**3
1494 CALL para_env%sum(gtcharge(:, 1))
1499 DO is = first_sgf(ia), last_sgf(ia)
1500 tv(is) = gtcharge(ia, 1)
1505 ikind = kind_of(iatom)
1506 atom_i = atom_of_kind(iatom)
1508 fij(i) = spinfac*spinfac*gtcharge(iatom, i + 1)*tcharge(iatom)
1510 force(ikind)%rho_elec(1, atom_i) = force(ikind)%rho_elec(1, atom_i) - fij(1)
1511 force(ikind)%rho_elec(2, atom_i) = force(ikind)%rho_elec(2, atom_i) - fij(2)
1512 force(ikind)%rho_elec(3, atom_i) = force(ikind)%rho_elec(3, atom_i) - fij(3)
1515 IF (debug_forces)
THEN
1516 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1517 CALL para_env%sum(fodeb)
1518 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Coul[X] ", fodeb
1520 norb = nactive(ispin)
1522 CALL cp_fm_get_info(work%S_C0_C0T(ispin), matrix_struct=fmstruct)
1523 CALL cp_fm_create(t0matrix, matrix_struct=fmstruct, name=
"T0 SCRATCH")
1524 CALL cp_fm_create(t1matrix, matrix_struct=fmstruct, name=
"T1 SCRATCH")
1529 ct => work%ctransformed(ispin)
1530 CALL cp_fm_to_fm(ct, cvec)
1532 CALL parallel_gemm(
'T',
'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1533 cvec, 0.0_dp, ucmatrix)
1534 CALL parallel_gemm(
'T',
'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1535 x(ispin), 0.0_dp, uxmatrix)
1536 CALL parallel_gemm(
'N',
'T', nsgf, nsgf, norb, 1.0_dp, uxmatrix, ucmatrix, 0.0_dp, t0matrix)
1537 CALL cp_fm_to_fm(xtransformed(ispin), cvec)
1539 CALL parallel_gemm(
'T',
'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1540 cvec, 0.0_dp, uxmatrix)
1541 CALL parallel_gemm(
'T',
'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1542 gs_mos(ispin)%mos_occ, 0.0_dp, ucmatrix)
1543 CALL parallel_gemm(
'N',
'T', nsgf, nsgf, norb, 1.0_dp, ucmatrix, uxmatrix, 1.0_dp, t0matrix)
1546 CALL parallel_gemm(
'N',
'N', nsgf, nsgf, nsgf, spinfac, work%S_eigenvectors, t1matrix, &
1549 matrix_g=work%S_eigenvectors, ncol=nsgf, alpha=2.0_dp, symmetry_mode=1)
1551 DEALLOCATE (ucmatrix)
1553 DEALLOCATE (uxmatrix)
1554 CALL cp_fm_release(t0matrix)
1555 CALL cp_fm_release(t1matrix)
1558 CALL cp_fm_to_fm(xtransformed(ispin), cvec)
1562 ct => work%ctransformed(ispin)
1563 CALL cp_fm_to_fm(ct, cvec)
1566 CALL cp_fm_get_info(cvec, matrix_struct=fmstruct, nrow_global=nao)
1570 ncol_global=norb, para_env=fmstruct%para_env)
1573 CALL parallel_gemm(
"T",
"N", norb, norb, nao, 1.0_dp, gs_mos(ispin)%mos_occ, vcvec, 0.0_dp, cvcmat)
1574 CALL parallel_gemm(
"N",
"N", nao, norb, norb, 1.0_dp, x(ispin), cvcmat, 0.0_dp, vcvec)
1576 nactive(ispin), alpha=-2.0_dp*spinfac, beta=1.0_dp)
1580 matrix_g=vcvec, ncol=norb, alpha=2.0_dp*alpha, symmetry_mode=1)
1581 CALL cp_fm_release(vcvec)
1582 CALL cp_fm_release(cvcmat)
1587 IF (stda_env%do_exchange)
THEN
1589 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1591 norb = nactive(ispin)
1593 tempmat => work%shalf
1594 CALL dbcsr_create(pdens, template=tempmat, matrix_type=dbcsr_type_no_symmetry)
1596 ct => work%ctransformed(ispin)
1597 CALL dbcsr_set(pdens, 0.0_dp)
1599 1.0_dp, keep_sparsity=.false.)
1600 CALL dbcsr_filter(pdens, stda_env%eps_td_filter)
1603 bp = stda_env%beta_param
1604 hfx = stda_env%hfx_fraction
1605 CALL dbcsr_iterator_start(iter, pdens)
1606 DO WHILE (dbcsr_iterator_blocks_left(iter))
1607 CALL dbcsr_iterator_next_block(iter, iatom, jatom, pblock, blk)
1608 rij = particle_set(iatom)%r - particle_set(jatom)%r
1609 rij =
pbc(rij, cell)
1610 dr = sqrt(sum(rij(:)**2))
1611 ikind = kind_of(iatom)
1612 jkind = kind_of(jatom)
1613 eta = (stda_env%kind_param_set(ikind)%kind_param%hardness_param + &
1614 stda_env%kind_param_set(jkind)%kind_param%hardness_param)/2.0_dp
1616 IF (hfx > 0.0_dp)
THEN
1617 gabr = (1._dp/(rbeta + (hfx*eta)**(-bp)))**(1._dp/bp)
1619 IF (dr < 1.0e-6_dp)
THEN
1627 IF (dr > 1.0e-6_dp)
THEN
1628 IF (hfx > 0.0_dp)
THEN
1629 dgabr = -(1._dp/bp)*(1._dp/(rbeta + (hfx*eta)**(-bp)))**(1._dp/bp + 1._dp)
1630 dgabr = bp*rbeta/dr**2*dgabr
1631 dgabr = sum(pblock**2)*dgabr
1633 dgabr = -1.0_dp/dr**3
1634 dgabr = sum(pblock**2)*dgabr
1636 atom_i = atom_of_kind(iatom)
1637 atom_j = atom_of_kind(jatom)
1639 fij(i) = dgabr*rij(i)
1641 force(ikind)%rho_elec(1, atom_i) = force(ikind)%rho_elec(1, atom_i) - fij(1)
1642 force(ikind)%rho_elec(2, atom_i) = force(ikind)%rho_elec(2, atom_i) - fij(2)
1643 force(ikind)%rho_elec(3, atom_i) = force(ikind)%rho_elec(3, atom_i) - fij(3)
1644 force(jkind)%rho_elec(1, atom_j) = force(jkind)%rho_elec(1, atom_j) + fij(1)
1645 force(jkind)%rho_elec(2, atom_j) = force(jkind)%rho_elec(2, atom_j) + fij(2)
1646 force(jkind)%rho_elec(3, atom_j) = force(jkind)%rho_elec(3, atom_j) + fij(3)
1649 pblock = gabr*pblock
1651 CALL dbcsr_iterator_stop(iter)
1654 CALL dbcsr_create(ptrans, template=pdens)
1655 CALL dbcsr_transposed(ptrans, pdens)
1658 CALL cp_fm_get_info(work%S_C0_C0T(ispin), matrix_struct=fmstruct)
1659 CALL cp_fm_create(t0matrix, matrix_struct=fmstruct, name=
"T0 SCRATCH")
1660 CALL cp_fm_create(t1matrix, matrix_struct=fmstruct, name=
"T1 SCRATCH")
1665 ct => work%ctransformed(ispin)
1667 CALL parallel_gemm(
'T',
'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1668 cvec, 0.0_dp, ucmatrix)
1669 CALL parallel_gemm(
'T',
'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1670 x(ispin), 0.0_dp, uxmatrix)
1671 CALL parallel_gemm(
'N',
'T', nsgf, nsgf, norb, 1.0_dp, uxmatrix, ucmatrix, 0.0_dp, t0matrix)
1673 CALL parallel_gemm(
'T',
'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1674 cvec, 0.0_dp, uxmatrix)
1675 CALL parallel_gemm(
'T',
'N', nsgf, norb, nsgf, 1.0_dp, work%S_eigenvectors, &
1676 gs_mos(ispin)%mos_occ, 0.0_dp, ucmatrix)
1677 CALL parallel_gemm(
'N',
'T', nsgf, nsgf, norb, 1.0_dp, ucmatrix, uxmatrix, 1.0_dp, t0matrix)
1679 CALL parallel_gemm(
'N',
'N', nsgf, nsgf, nsgf, -1.0_dp, work%S_eigenvectors, t1matrix, &
1682 matrix_g=work%S_eigenvectors, ncol=nsgf, alpha=2.0_dp, symmetry_mode=1)
1684 DEALLOCATE (ucmatrix)
1686 DEALLOCATE (uxmatrix)
1687 CALL cp_fm_release(t0matrix)
1688 CALL cp_fm_release(t1matrix)
1694 alpha=-xfac, beta=1.0_dp)
1696 CALL cp_fm_get_info(cvec, matrix_struct=fmstruct, nrow_global=nao)
1702 ncol_global=norb, para_env=fmstruct%para_env)
1705 CALL parallel_gemm(
"T",
"N", norb, norb, nao, 1.0_dp, gs_mos(ispin)%mos_occ, vcvec, 0.0_dp, cvcmat)
1706 CALL parallel_gemm(
"N",
"N", nao, norb, norb, 1.0_dp, x(ispin), cvcmat, 0.0_dp, vcvec)
1708 norb, alpha=xfac, beta=1.0_dp)
1710 IF (nspins == 2)
THEN
1717 ncol=norb, alpha=2.0_dp*alpha, symmetry_mode=1)
1718 CALL cp_fm_release(vcvec)
1719 CALL cp_fm_release(cvcmat)
1721 CALL dbcsr_release(pdens)
1722 CALL dbcsr_release(ptrans)
1724 IF (debug_forces)
THEN
1725 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1726 CALL para_env%sum(fodeb)
1727 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Exch[X] ", fodeb
1731 CALL cp_fm_release(cvec)
1732 CALL cp_fm_release(xvec)
1736 CALL cp_fm_release(xtransformed)
1737 DEALLOCATE (tcharge, gtcharge)
1738 DEALLOCATE (first_sgf, last_sgf)
1741 IF (nspins == 2)
THEN
1742 CALL dbcsr_add(matrix_plo(1)%matrix, matrix_plo(2)%matrix, &
1743 alpha_scalar=1.0_dp, beta_scalar=1.0_dp)
1745 CALL dbcsr_scale(matrix_plo(1)%matrix, -1.0_dp)
1747 IF (debug_forces) fodeb(1:3) = force(1)%overlap(1:3, 1)
1749 matrix_name=
"OVERLAP MATRIX", &
1750 basis_type_a=
"ORB", basis_type_b=
"ORB", &
1751 sab_nl=sab_orb, calculate_forces=.true., &
1752 matrix_p=matrix_plo(1)%matrix)
1755 IF (debug_forces)
THEN
1756 fodeb(1:3) = force(1)%overlap(1:3, 1) - fodeb(1:3)
1757 CALL para_env%sum(fodeb)
1758 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Lowdin ", fodeb
1762 ex_env%matrix_wx1 => matrix_wx1
1764 CALL timestop(handle)
subroutine pbc(r, r_pbc, s, s_pbc, a, b, c, alpha, beta, gamma, debug, info, pbc0, h, hinv)
...
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.
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.
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.
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
Routines that link DBCSR and CP2K concepts together.
subroutine, public cp_dbcsr_alloc_block_from_nbl(matrix, sab_orb, desymmetrize)
allocate the blocks of a dbcsr based on the neighbor list
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_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
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)
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, atprop)
...
subroutine, public tb_spme_evaluate(ewald_env, ewald_pw, particle_set, box, gmcharge, mcharge, calculate_forces, virial, use_virial, atprop)
...
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)
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)
computes four center integrals for a full basis set and updates the Kohn-Sham-Matrix and energy....
subroutine, public hfx_ri_update_ks(qs_env, ri_data, ks_matrix, ehfx, mos, rho_ao, geometry_did_change, nspins, hf_fraction)
...
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
Types and set/get functions for HFX.
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
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_nonbond, sab_almo, sab_kp, sab_kp_nosym, 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, ecoul_1c, rho0_s_rs, rho0_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, 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, rhs)
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, 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, 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, rhs)
Set the QUICKSTEP environment.
https://en.wikipedia.org/wiki/Finite_difference_coefficient
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)
...
subroutine, public qs_fgxc_create(ks_env, rho0_struct, rho1_struct, xc_section, accuracy, is_triplet, fxc_rho, fxc_tau, gxc_rho, gxc_tau)
...
subroutine, public qs_fgxc_release(ks_env, fxc_rho, fxc_tau, gxc_rho, gxc_tau)
...
subroutine, public prepare_gapw_den(qs_env, local_rho_set, do_rho0, kind_set_external)
...
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
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...
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.
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.
subroutine, public integrate_vhg0_rspace(qs_env, v_rspace, para_env, calculate_forces, local_rho_set, local_rho_set_2nd, atener, kforce)
...
subroutine, public rho0_s_grid_create(pw_env, rho0_mpole)
...
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.
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...
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)
...
All kind of helpful little routines.
pure integer function, dimension(2), public get_limit(m, n, me)
divide m entries into n parts, return size of part me