95 SUBROUTINE qs_vxc_create(ks_env, rho_struct, xc_section, vxc_rho, vxc_tau, exc, &
96 just_energy, edisp, dispersion_env, adiabatic_rescale_factor, &
103 REAL(kind=
dp),
INTENT(out) :: exc
104 LOGICAL,
INTENT(in),
OPTIONAL :: just_energy
105 REAL(kind=
dp),
INTENT(out),
OPTIONAL :: edisp
107 REAL(kind=
dp),
INTENT(in),
OPTIONAL :: adiabatic_rescale_factor
108 TYPE(
pw_env_type),
OPTIONAL,
POINTER :: pw_env_external
110 CHARACTER(len=*),
PARAMETER :: routinen =
'qs_vxc_create'
112 INTEGER :: handle, ispin, mspin, myfun, &
114 LOGICAL :: compute_virial, do_adiabatic_rescaling, my_just_energy, rho_g_valid, &
115 sic_scaling_b_zero, tau_r_valid, uf_grid, vdw_nl
116 REAL(kind=
dp) :: exc_m, factor, &
117 my_adiabatic_rescale_factor, &
118 my_scaling, nelec_s_inv
119 REAL(kind=
dp),
DIMENSION(3, 3) :: virial_xc_tmp
123 TYPE(
pw_c1d_gs_type),
DIMENSION(:),
POINTER :: rho_g, rho_m_gspace, rho_struct_g
126 TYPE(
pw_pool_type),
POINTER :: auxbas_pw_pool, vdw_pw_pool, xc_pw_pool
127 TYPE(
pw_r3d_rs_type),
DIMENSION(:),
POINTER :: my_vxc_rho, my_vxc_tau, rho_m_rspace, &
128 rho_r, rho_struct_r, tau, tau_struct_r
132 CALL timeset(routinen, handle)
134 cpassert(.NOT.
ASSOCIATED(vxc_rho))
135 cpassert(.NOT.
ASSOCIATED(vxc_tau))
136 NULLIFY (dft_control, pw_env, auxbas_pw_pool, xc_pw_pool, vdw_pw_pool, cell, my_vxc_rho, &
137 tmp_pw, tmp_g, tmp_g2, my_vxc_tau, rho_g, rho_r, tau, rho_m_rspace, &
138 rho_m_gspace, rho_nlcc, rho_nlcc_g, rho_struct_r, rho_struct_g, tau_struct_r)
141 my_just_energy = .false.
142 IF (
PRESENT(just_energy)) my_just_energy = just_energy
143 my_adiabatic_rescale_factor = 1.0_dp
144 do_adiabatic_rescaling = .false.
145 IF (
PRESENT(adiabatic_rescale_factor))
THEN
146 my_adiabatic_rescale_factor = adiabatic_rescale_factor
147 do_adiabatic_rescaling = .true.
151 dft_control=dft_control, &
156 rho_nlcc_g=rho_nlcc_g)
159 tau_r_valid=tau_r_valid, &
160 rho_g_valid=rho_g_valid, &
161 rho_r=rho_struct_r, &
162 rho_g=rho_struct_g, &
165 compute_virial = virial%pv_calculate .AND. (.NOT. virial%pv_numer)
166 IF (compute_virial)
THEN
167 virial%pv_xc = 0.0_dp
177 cpassert(.NOT. (do_adiabatic_rescaling .AND. vdw_nl))
179 IF (.NOT. (
PRESENT(dispersion_env) .AND.
PRESENT(edisp)))
THEN
182 IF (
PRESENT(edisp)) edisp = 0.0_dp
184 IF (myfun /=
xc_none .OR. vdw_nl)
THEN
187 cpassert(
ASSOCIATED(rho_struct))
188 IF (dft_control%nspins /= 1 .AND. dft_control%nspins /= 2) &
189 cpabort(
"nspins must be 1 or 2")
190 mspin =
SIZE(rho_struct_r)
191 IF (dft_control%nspins == 2 .AND. mspin == 1) &
192 cpabort(
"Spin count mismatch")
201 SELECT CASE (dft_control%sic_method_id)
206 cpassert(.NOT. tau_r_valid)
208 my_scaling = 1.0_dp - dft_control%sic_scaling_b
210 cpassert(.NOT. tau_r_valid)
218 IF (dft_control%sic_scaling_b .EQ. 0.0_dp)
THEN
219 sic_scaling_b_zero = .true.
221 sic_scaling_b_zero = .false.
224 IF (
PRESENT(pw_env_external)) &
225 pw_env => pw_env_external
226 CALL pw_env_get(pw_env, xc_pw_pool=xc_pw_pool, auxbas_pw_pool=auxbas_pw_pool)
227 uf_grid = .NOT.
pw_grid_compare(auxbas_pw_pool%pw_grid, xc_pw_pool%pw_grid)
229 IF (.NOT. uf_grid)
THEN
230 rho_r => rho_struct_r
232 IF (tau_r_valid)
THEN
238 IF (rho_g_valid)
THEN
239 rho_g => rho_struct_g
242 cpassert(rho_g_valid)
243 ALLOCATE (rho_r(mspin))
244 ALLOCATE (rho_g(mspin))
246 CALL xc_pw_pool%create_pw(rho_g(ispin))
247 CALL pw_transfer(rho_struct_g(ispin), rho_g(ispin))
250 CALL xc_pw_pool%create_pw(rho_r(ispin))
253 IF (tau_r_valid)
THEN
255 cpabort(
"tau with finer grids not implemented")
260 IF (
ASSOCIATED(rho_nlcc))
THEN
263 CALL pw_axpy(rho_nlcc, rho_r(ispin), factor)
264 CALL pw_axpy(rho_nlcc_g, rho_g(ispin), factor)
272 IF (my_just_energy)
THEN
274 rho_g=rho_g, xc_section=xc_section, &
279 rho_g=rho_g, tau=tau, exc=exc, &
280 xc_section=xc_section, &
281 pw_pool=xc_pw_pool, &
282 compute_virial=compute_virial, &
283 virial_xc=virial%pv_xc)
287 IF (
ASSOCIATED(rho_nlcc))
THEN
290 CALL pw_axpy(rho_nlcc, rho_r(ispin), factor)
291 CALL pw_axpy(rho_nlcc_g, rho_g(ispin), factor)
300 CALL get_ks_env(ks_env=ks_env, para_env=para_env)
302 cpassert(dft_control%sic_method_id ==
sic_none)
304 CALL pw_env_get(pw_env, vdw_pw_pool=vdw_pw_pool)
305 IF (my_just_energy)
THEN
307 my_just_energy, vdw_pw_pool, xc_pw_pool, para_env)
310 my_just_energy, vdw_pw_pool, xc_pw_pool, para_env, virial=virial)
315 IF (.NOT. my_just_energy)
THEN
316 IF (do_adiabatic_rescaling)
THEN
317 IF (
ASSOCIATED(my_vxc_rho))
THEN
318 DO ispin = 1,
SIZE(my_vxc_rho)
319 CALL pw_scale(my_vxc_rho(ispin), my_adiabatic_rescale_factor)
325 IF (my_scaling .NE. 1.0_dp)
THEN
327 IF (
ASSOCIATED(my_vxc_rho))
THEN
328 DO ispin = 1,
SIZE(my_vxc_rho)
329 CALL pw_scale(my_vxc_rho(ispin), my_scaling)
332 IF (
ASSOCIATED(my_vxc_tau))
THEN
333 DO ispin = 1,
SIZE(my_vxc_tau)
334 CALL pw_scale(my_vxc_tau(ispin), my_scaling)
341 IF (
ASSOCIATED(my_vxc_rho))
THEN
342 vxc_rho => my_vxc_rho
345 IF (
ASSOCIATED(my_vxc_tau))
THEN
346 vxc_tau => my_vxc_tau
350 DO ispin = 1,
SIZE(rho_r)
351 CALL xc_pw_pool%give_back_pw(rho_r(ispin))
354 IF (
ASSOCIATED(rho_g))
THEN
355 DO ispin = 1,
SIZE(rho_g)
356 CALL xc_pw_pool%give_back_pw(rho_g(ispin))
363 IF (dft_control%sic_method_id .EQ.
sic_mauri_spz .AND. .NOT. sic_scaling_b_zero)
THEN
364 ALLOCATE (rho_m_rspace(2), rho_m_gspace(2))
365 CALL xc_pw_pool%create_pw(rho_m_gspace(1))
366 CALL xc_pw_pool%create_pw(rho_m_rspace(1))
367 CALL pw_copy(rho_struct_r(1), rho_m_rspace(1))
368 CALL pw_axpy(rho_struct_r(2), rho_m_rspace(1), alpha=-1._dp)
369 CALL pw_copy(rho_struct_g(1), rho_m_gspace(1))
370 CALL pw_axpy(rho_struct_g(2), rho_m_gspace(1), alpha=-1._dp)
372 CALL xc_pw_pool%create_pw(rho_m_gspace(2))
373 CALL xc_pw_pool%create_pw(rho_m_rspace(2))
377 IF (my_just_energy)
THEN
379 rho_g=rho_m_gspace, xc_section=xc_section, &
383 cpassert(.NOT. compute_virial)
384 CALL xc_vxc_pw_create1(vxc_rho=my_vxc_rho, vxc_tau=my_vxc_tau, rho_r=rho_m_rspace, &
385 rho_g=rho_m_gspace, tau=tau, exc=exc_m, &
386 xc_section=xc_section, &
387 pw_pool=xc_pw_pool, &
388 compute_virial=.false., &
389 virial_xc=virial_xc_tmp)
392 exc = exc - dft_control%sic_scaling_b*exc_m
395 IF (.NOT. my_just_energy)
THEN
396 CALL pw_axpy(my_vxc_rho(1), vxc_rho(1), -dft_control%sic_scaling_b)
397 CALL pw_axpy(my_vxc_rho(1), vxc_rho(2), dft_control%sic_scaling_b)
398 CALL my_vxc_rho(1)%release()
399 CALL my_vxc_rho(2)%release()
400 DEALLOCATE (my_vxc_rho)
404 CALL xc_pw_pool%give_back_pw(rho_m_rspace(ispin))
405 CALL xc_pw_pool%give_back_pw(rho_m_gspace(ispin))
407 DEALLOCATE (rho_m_rspace)
408 DEALLOCATE (rho_m_gspace)
413 IF (dft_control%sic_method_id .EQ.
sic_ad .AND. .NOT. sic_scaling_b_zero)
THEN
416 CALL get_ks_env(ks_env, nelectron_spin=nelec_spin)
418 ALLOCATE (rho_m_rspace(2), rho_m_gspace(2))
420 CALL xc_pw_pool%create_pw(rho_m_gspace(ispin))
421 CALL xc_pw_pool%create_pw(rho_m_rspace(ispin))
425 IF (nelec_spin(ispin) .GT. 0.0_dp)
THEN
426 nelec_s_inv = 1.0_dp/nelec_spin(ispin)
431 CALL pw_copy(rho_struct_r(ispin), rho_m_rspace(1))
432 CALL pw_copy(rho_struct_g(ispin), rho_m_gspace(1))
433 CALL pw_scale(rho_m_rspace(1), nelec_s_inv)
434 CALL pw_scale(rho_m_gspace(1), nelec_s_inv)
438 IF (my_just_energy)
THEN
440 rho_g=rho_m_gspace, xc_section=xc_section, &
444 cpassert(.NOT. compute_virial)
445 CALL xc_vxc_pw_create1(vxc_rho=my_vxc_rho, vxc_tau=my_vxc_tau, rho_r=rho_m_rspace, &
446 rho_g=rho_m_gspace, tau=tau, exc=exc_m, &
447 xc_section=xc_section, &
448 pw_pool=xc_pw_pool, &
449 compute_virial=.false., &
450 virial_xc=virial_xc_tmp)
453 exc = exc - dft_control%sic_scaling_b*nelec_spin(ispin)*exc_m
456 IF (.NOT. my_just_energy)
THEN
457 CALL pw_axpy(my_vxc_rho(1), vxc_rho(ispin), -dft_control%sic_scaling_b)
458 CALL my_vxc_rho(1)%release()
459 CALL my_vxc_rho(2)%release()
460 DEALLOCATE (my_vxc_rho)
465 CALL xc_pw_pool%give_back_pw(rho_m_rspace(ispin))
466 CALL xc_pw_pool%give_back_pw(rho_m_gspace(ispin))
468 DEALLOCATE (rho_m_rspace)
469 DEALLOCATE (rho_m_gspace)
474 IF (dft_control%sic_method_id .EQ.
sic_mauri_us .AND. .NOT. sic_scaling_b_zero)
THEN
476 rho_r(1) = rho_struct_r(2)
477 rho_r(2) = rho_struct_r(2)
478 IF (rho_g_valid)
THEN
480 rho_g(1) = rho_struct_g(2)
481 rho_g(2) = rho_struct_g(2)
484 IF (my_just_energy)
THEN
486 rho_g=rho_g, xc_section=xc_section, &
490 cpassert(.NOT. compute_virial)
492 rho_g=rho_g, tau=tau, exc=exc_m, &
493 xc_section=xc_section, &
494 pw_pool=xc_pw_pool, &
495 compute_virial=.false., &
496 virial_xc=virial_xc_tmp)
499 exc = exc + dft_control%sic_scaling_b*exc_m
502 IF (.NOT. my_just_energy)
THEN
504 CALL pw_axpy(my_vxc_rho(1), vxc_rho(2), 2.0_dp*dft_control%sic_scaling_b)
505 CALL my_vxc_rho(1)%release()
506 CALL my_vxc_rho(2)%release()
507 DEALLOCATE (my_vxc_rho)
509 DEALLOCATE (rho_r, rho_g)
516 IF (uf_grid .AND. (
ASSOCIATED(vxc_rho) .OR.
ASSOCIATED(vxc_tau)))
THEN
520 CALL xc_pw_pool%create_pw(tmp_g)
521 CALL auxbas_pw_pool%create_pw(tmp_g2)
522 IF (
ASSOCIATED(vxc_rho))
THEN
523 DO ispin = 1,
SIZE(vxc_rho)
524 CALL auxbas_pw_pool%create_pw(tmp_pw)
528 CALL xc_pw_pool%give_back_pw(vxc_rho(ispin))
529 vxc_rho(ispin) = tmp_pw
532 IF (
ASSOCIATED(vxc_tau))
THEN
533 DO ispin = 1,
SIZE(vxc_tau)
534 CALL auxbas_pw_pool%create_pw(tmp_pw)
538 CALL xc_pw_pool%give_back_pw(vxc_tau(ispin))
539 vxc_tau(ispin) = tmp_pw
542 CALL auxbas_pw_pool%give_back_pw(tmp_g2)
543 CALL xc_pw_pool%give_back_pw(tmp_g)
546 IF (
ASSOCIATED(tau) .AND. uf_grid)
THEN
547 DO ispin = 1,
SIZE(tau)
548 CALL xc_pw_pool%give_back_pw(tau(ispin))
555 CALL timestop(handle)
572 xc_ener, xc_den, vxc, vtau)
574 TYPE(qs_ks_env_type),
POINTER :: ks_env
575 TYPE(qs_rho_type),
POINTER :: rho_struct
576 TYPE(section_vals_type),
POINTER :: xc_section
577 TYPE(qs_dispersion_type),
OPTIONAL,
POINTER :: dispersion_env
578 TYPE(pw_r3d_rs_type),
INTENT(INOUT),
OPTIONAL :: xc_ener, xc_den
579 TYPE(pw_r3d_rs_type),
DIMENSION(:),
OPTIONAL :: vxc, vtau
581 CHARACTER(len=*),
PARAMETER :: routinen =
'qs_xc_density'
583 INTEGER :: handle, ispin, myfun, nspins, vdw
584 LOGICAL :: rho_g_valid, tau_r_valid, uf_grid, vdw_nl
585 REAL(kind=dp) :: edisp, exc, factor, rho_cutoff
586 REAL(kind=dp),
DIMENSION(3, 3) :: vdum
587 TYPE(cell_type),
POINTER :: cell
588 TYPE(dft_control_type),
POINTER :: dft_control
589 TYPE(mp_para_env_type),
POINTER :: para_env
590 TYPE(pw_c1d_gs_type),
DIMENSION(:),
POINTER :: rho_g
591 TYPE(pw_c1d_gs_type),
POINTER :: rho_nlcc_g
592 TYPE(pw_env_type),
POINTER :: pw_env
593 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool, vdw_pw_pool, xc_pw_pool
594 TYPE(pw_r3d_rs_type) :: exc_r
595 TYPE(pw_r3d_rs_type),
DIMENSION(:),
POINTER :: rho_r, tau_r, vxc_rho, vxc_tau
596 TYPE(pw_r3d_rs_type),
POINTER :: rho_nlcc
598 CALL timeset(routinen, handle)
600 CALL get_ks_env(ks_env, &
601 dft_control=dft_control, &
605 rho_nlcc_g=rho_nlcc_g)
607 CALL qs_rho_get(rho_struct, &
608 tau_r_valid=tau_r_valid, &
609 rho_g_valid=rho_g_valid, &
613 nspins = dft_control%nspins
615 CALL section_vals_val_get(xc_section,
"XC_FUNCTIONAL%_SECTION_PARAMETERS_", i_val=myfun)
616 CALL section_vals_val_get(xc_section,
"VDW_POTENTIAL%POTENTIAL_TYPE", i_val=vdw)
617 vdw_nl = (vdw == xc_vdw_fun_nonloc)
618 IF (
PRESENT(xc_ener))
THEN
619 IF (tau_r_valid)
THEN
620 CALL cp_warn(__location__,
"Tau contribution will not be correctly handled")
624 CALL cp_warn(__location__,
"vdW functional contribution will be ignored")
627 CALL pw_env_get(pw_env, xc_pw_pool=xc_pw_pool, auxbas_pw_pool=auxbas_pw_pool)
628 uf_grid = .NOT. pw_grid_compare(auxbas_pw_pool%pw_grid, xc_pw_pool%pw_grid)
630 CALL cp_warn(__location__,
"Fine grid option not possible with local energy")
631 cpabort(
"Fine Grid in Local Energy")
634 IF (
PRESENT(xc_ener))
THEN
635 CALL pw_zero(xc_ener)
637 IF (
PRESENT(xc_den))
THEN
640 IF (
PRESENT(vxc))
THEN
642 CALL pw_zero(vxc(ispin))
645 IF (
PRESENT(vtau))
THEN
647 CALL pw_zero(vtau(ispin))
651 IF (myfun /= xc_none)
THEN
653 cpassert(
ASSOCIATED(rho_struct))
654 cpassert(dft_control%sic_method_id == sic_none)
657 IF (
ASSOCIATED(rho_nlcc))
THEN
660 CALL pw_axpy(rho_nlcc, rho_r(ispin), factor)
661 CALL pw_axpy(rho_nlcc_g, rho_g(ispin), factor)
664 NULLIFY (vxc_rho, vxc_tau)
665 CALL xc_vxc_pw_create1(vxc_rho=vxc_rho, vxc_tau=vxc_tau, rho_r=rho_r, &
666 rho_g=rho_g, tau=tau_r, exc=exc, &
667 xc_section=xc_section, &
668 pw_pool=xc_pw_pool, &
669 compute_virial=.false., &
677 CALL get_ks_env(ks_env=ks_env, para_env=para_env)
679 cpassert(dft_control%sic_method_id == sic_none)
681 CALL pw_env_get(pw_env, vdw_pw_pool=vdw_pw_pool)
682 CALL calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edisp, dispersion_env, &
683 .false., vdw_pw_pool, xc_pw_pool, para_env)
687 IF (
ASSOCIATED(rho_nlcc))
THEN
689 DO ispin = 1, dft_control%nspins
690 CALL pw_axpy(rho_nlcc, rho_r(ispin), factor)
691 CALL pw_axpy(rho_nlcc_g, rho_g(ispin), factor)
695 IF (
PRESENT(xc_den))
THEN
696 CALL pw_copy(exc_r, xc_den)
697 rho_cutoff = 1.e-14_dp
698 CALL calc_xc_density(xc_den, rho_r, rho_cutoff)
700 IF (
PRESENT(xc_ener))
THEN
701 CALL pw_copy(exc_r, xc_ener)
703 CALL pw_multiply(xc_ener, vxc_rho(ispin), rho_r(ispin), alpha=-1.0_dp)
706 IF (
PRESENT(vxc))
THEN
708 CALL pw_copy(vxc_rho(ispin), vxc(ispin))
711 IF (
PRESENT(vtau))
THEN
713 CALL pw_copy(vxc_tau(ispin), vtau(ispin))
717 IF (
ASSOCIATED(vxc_rho))
THEN
719 CALL vxc_rho(ispin)%release()
723 IF (
ASSOCIATED(vxc_tau))
THEN
725 CALL vxc_tau(ispin)%release()
733 CALL timestop(handle)
subroutine, public get_ks_env(ks_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, complex_ks, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, kinetic, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_ks_im_kp, rho, rho_xc, vppl, rho_core, rho_nlcc, rho_nlcc_g, vee, neighbor_list_id, sab_orb, sab_all, sac_ae, sac_ppl, sac_lri, sap_ppnl, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_vdw, sab_scp, sab_almo, sab_kp, sab_kp_nosym, task_list, task_list_soft, kpoints, do_kpoints, atomic_kind_set, qs_kind_set, cell, cell_ref, use_ref_cell, particle_set, energy, force, local_particles, local_molecules, molecule_kind_set, molecule_set, subsys, cp_subsys, virial, results, atprop, nkind, natom, dft_control, dbcsr_dist, distribution_2d, pw_env, para_env, blacs_env, nelectron_total, nelectron_spin)
...