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, &
154 xcint_weights=weights, &
157 rho_nlcc_g=rho_nlcc_g)
160 tau_r_valid=tau_r_valid, &
161 rho_g_valid=rho_g_valid, &
162 rho_r=rho_struct_r, &
163 rho_g=rho_struct_g, &
166 compute_virial = virial%pv_calculate .AND. (.NOT. virial%pv_numer)
167 IF (compute_virial)
THEN
168 virial%pv_xc = 0.0_dp
178 cpassert(.NOT. (do_adiabatic_rescaling .AND. vdw_nl))
180 IF (.NOT. (
PRESENT(dispersion_env) .AND.
PRESENT(edisp)))
THEN
183 IF (
PRESENT(edisp)) edisp = 0.0_dp
185 IF (myfun /=
xc_none .OR. vdw_nl)
THEN
188 cpassert(
ASSOCIATED(rho_struct))
189 IF (dft_control%nspins /= 1 .AND. dft_control%nspins /= 2) &
190 cpabort(
"nspins must be 1 or 2")
191 mspin =
SIZE(rho_struct_r)
192 IF (dft_control%nspins == 2 .AND. mspin == 1) &
193 cpabort(
"Spin count mismatch")
202 SELECT CASE (dft_control%sic_method_id)
207 cpassert(.NOT. tau_r_valid)
209 my_scaling = 1.0_dp - dft_control%sic_scaling_b
211 cpassert(.NOT. tau_r_valid)
219 IF (dft_control%sic_scaling_b == 0.0_dp)
THEN
220 sic_scaling_b_zero = .true.
222 sic_scaling_b_zero = .false.
225 IF (
PRESENT(pw_env_external)) &
226 pw_env => pw_env_external
227 CALL pw_env_get(pw_env, xc_pw_pool=xc_pw_pool, auxbas_pw_pool=auxbas_pw_pool)
228 uf_grid = .NOT.
pw_grid_compare(auxbas_pw_pool%pw_grid, xc_pw_pool%pw_grid)
230 IF (.NOT. uf_grid)
THEN
231 rho_r => rho_struct_r
233 IF (tau_r_valid)
THEN
239 IF (rho_g_valid)
THEN
240 rho_g => rho_struct_g
243 cpassert(rho_g_valid)
244 ALLOCATE (rho_r(mspin))
245 ALLOCATE (rho_g(mspin))
247 CALL xc_pw_pool%create_pw(rho_g(ispin))
248 CALL pw_transfer(rho_struct_g(ispin), rho_g(ispin))
251 CALL xc_pw_pool%create_pw(rho_r(ispin))
254 IF (tau_r_valid)
THEN
256 cpabort(
"Tau (MGGA) with finer grids not implemented")
258 IF (
ASSOCIATED(weights))
THEN
259 cpabort(
"Accurate integration with finer grids not implemented")
264 IF (
ASSOCIATED(rho_nlcc))
THEN
267 CALL pw_axpy(rho_nlcc, rho_r(ispin), factor)
268 CALL pw_axpy(rho_nlcc_g, rho_g(ispin), factor)
276 IF (my_just_energy)
THEN
278 rho_g=rho_g, xc_section=xc_section, &
279 weights=weights, pw_pool=xc_pw_pool)
282 CALL xc_vxc_pw_create(vxc_rho=my_vxc_rho, vxc_tau=my_vxc_tau, rho_r=rho_r, &
283 rho_g=rho_g, tau=tau, exc=exc, &
284 xc_section=xc_section, &
285 weights=weights, pw_pool=xc_pw_pool, &
286 compute_virial=compute_virial, &
287 virial_xc=virial%pv_xc)
291 IF (
ASSOCIATED(rho_nlcc))
THEN
294 CALL pw_axpy(rho_nlcc, rho_r(ispin), factor)
295 CALL pw_axpy(rho_nlcc_g, rho_g(ispin), factor)
304 CALL get_ks_env(ks_env=ks_env, para_env=para_env)
306 cpassert(dft_control%sic_method_id ==
sic_none)
308 CALL pw_env_get(pw_env, vdw_pw_pool=vdw_pw_pool)
309 IF (my_just_energy)
THEN
311 my_just_energy, vdw_pw_pool, xc_pw_pool, para_env)
314 my_just_energy, vdw_pw_pool, xc_pw_pool, para_env, virial=virial)
319 IF (.NOT. my_just_energy)
THEN
320 IF (do_adiabatic_rescaling)
THEN
321 IF (
ASSOCIATED(my_vxc_rho))
THEN
322 DO ispin = 1,
SIZE(my_vxc_rho)
323 CALL pw_scale(my_vxc_rho(ispin), my_adiabatic_rescale_factor)
329 IF (my_scaling /= 1.0_dp)
THEN
331 IF (
ASSOCIATED(my_vxc_rho))
THEN
332 DO ispin = 1,
SIZE(my_vxc_rho)
333 CALL pw_scale(my_vxc_rho(ispin), my_scaling)
336 IF (
ASSOCIATED(my_vxc_tau))
THEN
337 DO ispin = 1,
SIZE(my_vxc_tau)
338 CALL pw_scale(my_vxc_tau(ispin), my_scaling)
345 IF (
ASSOCIATED(my_vxc_rho))
THEN
346 vxc_rho => my_vxc_rho
349 IF (
ASSOCIATED(my_vxc_tau))
THEN
350 vxc_tau => my_vxc_tau
354 DO ispin = 1,
SIZE(rho_r)
355 CALL xc_pw_pool%give_back_pw(rho_r(ispin))
358 IF (
ASSOCIATED(rho_g))
THEN
359 DO ispin = 1,
SIZE(rho_g)
360 CALL xc_pw_pool%give_back_pw(rho_g(ispin))
367 IF (dft_control%sic_method_id ==
sic_mauri_spz .AND. .NOT. sic_scaling_b_zero)
THEN
368 ALLOCATE (rho_m_rspace(2), rho_m_gspace(2))
369 CALL xc_pw_pool%create_pw(rho_m_gspace(1))
370 CALL xc_pw_pool%create_pw(rho_m_rspace(1))
371 CALL pw_copy(rho_struct_r(1), rho_m_rspace(1))
372 CALL pw_axpy(rho_struct_r(2), rho_m_rspace(1), alpha=-1._dp)
373 CALL pw_copy(rho_struct_g(1), rho_m_gspace(1))
374 CALL pw_axpy(rho_struct_g(2), rho_m_gspace(1), alpha=-1._dp)
376 CALL xc_pw_pool%create_pw(rho_m_gspace(2))
377 CALL xc_pw_pool%create_pw(rho_m_rspace(2))
381 IF (my_just_energy)
THEN
383 rho_g=rho_m_gspace, xc_section=xc_section, &
384 weights=weights, pw_pool=xc_pw_pool)
387 cpassert(.NOT. compute_virial)
388 CALL xc_vxc_pw_create(vxc_rho=my_vxc_rho, vxc_tau=my_vxc_tau, rho_r=rho_m_rspace, &
389 rho_g=rho_m_gspace, tau=tau, exc=exc_m, &
390 xc_section=xc_section, &
391 weights=weights, pw_pool=xc_pw_pool, &
392 compute_virial=.false., &
393 virial_xc=virial_xc_tmp)
396 exc = exc - dft_control%sic_scaling_b*exc_m
399 IF (.NOT. my_just_energy)
THEN
400 CALL pw_axpy(my_vxc_rho(1), vxc_rho(1), -dft_control%sic_scaling_b)
401 CALL pw_axpy(my_vxc_rho(1), vxc_rho(2), dft_control%sic_scaling_b)
402 CALL my_vxc_rho(1)%release()
403 CALL my_vxc_rho(2)%release()
404 DEALLOCATE (my_vxc_rho)
408 CALL xc_pw_pool%give_back_pw(rho_m_rspace(ispin))
409 CALL xc_pw_pool%give_back_pw(rho_m_gspace(ispin))
411 DEALLOCATE (rho_m_rspace)
412 DEALLOCATE (rho_m_gspace)
417 IF (dft_control%sic_method_id ==
sic_ad .AND. .NOT. sic_scaling_b_zero)
THEN
420 CALL get_ks_env(ks_env, nelectron_spin=nelec_spin)
422 ALLOCATE (rho_m_rspace(2), rho_m_gspace(2))
424 CALL xc_pw_pool%create_pw(rho_m_gspace(ispin))
425 CALL xc_pw_pool%create_pw(rho_m_rspace(ispin))
429 IF (nelec_spin(ispin) > 0.0_dp)
THEN
430 nelec_s_inv = 1.0_dp/nelec_spin(ispin)
435 CALL pw_copy(rho_struct_r(ispin), rho_m_rspace(1))
436 CALL pw_copy(rho_struct_g(ispin), rho_m_gspace(1))
437 CALL pw_scale(rho_m_rspace(1), nelec_s_inv)
438 CALL pw_scale(rho_m_gspace(1), nelec_s_inv)
442 IF (my_just_energy)
THEN
444 rho_g=rho_m_gspace, xc_section=xc_section, &
445 weights=weights, pw_pool=xc_pw_pool)
448 cpassert(.NOT. compute_virial)
449 CALL xc_vxc_pw_create(vxc_rho=my_vxc_rho, vxc_tau=my_vxc_tau, rho_r=rho_m_rspace, &
450 rho_g=rho_m_gspace, tau=tau, exc=exc_m, &
451 xc_section=xc_section, &
452 weights=weights, pw_pool=xc_pw_pool, &
453 compute_virial=.false., &
454 virial_xc=virial_xc_tmp)
457 exc = exc - dft_control%sic_scaling_b*nelec_spin(ispin)*exc_m
460 IF (.NOT. my_just_energy)
THEN
461 CALL pw_axpy(my_vxc_rho(1), vxc_rho(ispin), -dft_control%sic_scaling_b)
462 CALL my_vxc_rho(1)%release()
463 CALL my_vxc_rho(2)%release()
464 DEALLOCATE (my_vxc_rho)
469 CALL xc_pw_pool%give_back_pw(rho_m_rspace(ispin))
470 CALL xc_pw_pool%give_back_pw(rho_m_gspace(ispin))
472 DEALLOCATE (rho_m_rspace)
473 DEALLOCATE (rho_m_gspace)
478 IF (dft_control%sic_method_id ==
sic_mauri_us .AND. .NOT. sic_scaling_b_zero)
THEN
480 rho_r(1) = rho_struct_r(2)
481 rho_r(2) = rho_struct_r(2)
482 IF (rho_g_valid)
THEN
484 rho_g(1) = rho_struct_g(2)
485 rho_g(2) = rho_struct_g(2)
488 IF (my_just_energy)
THEN
490 rho_g=rho_g, xc_section=xc_section, &
491 weights=weights, pw_pool=xc_pw_pool)
494 cpassert(.NOT. compute_virial)
495 CALL xc_vxc_pw_create(vxc_rho=my_vxc_rho, vxc_tau=my_vxc_tau, rho_r=rho_r, &
496 rho_g=rho_g, tau=tau, exc=exc_m, &
497 xc_section=xc_section, &
498 weights=weights, pw_pool=xc_pw_pool, &
499 compute_virial=.false., &
500 virial_xc=virial_xc_tmp)
503 exc = exc + dft_control%sic_scaling_b*exc_m
506 IF (.NOT. my_just_energy)
THEN
508 CALL pw_axpy(my_vxc_rho(1), vxc_rho(2), 2.0_dp*dft_control%sic_scaling_b)
509 CALL my_vxc_rho(1)%release()
510 CALL my_vxc_rho(2)%release()
511 DEALLOCATE (my_vxc_rho)
513 DEALLOCATE (rho_r, rho_g)
520 IF (uf_grid .AND. (
ASSOCIATED(vxc_rho) .OR.
ASSOCIATED(vxc_tau)))
THEN
524 CALL xc_pw_pool%create_pw(tmp_g)
525 CALL auxbas_pw_pool%create_pw(tmp_g2)
526 IF (
ASSOCIATED(vxc_rho))
THEN
527 DO ispin = 1,
SIZE(vxc_rho)
528 CALL auxbas_pw_pool%create_pw(tmp_pw)
532 CALL xc_pw_pool%give_back_pw(vxc_rho(ispin))
533 vxc_rho(ispin) = tmp_pw
536 IF (
ASSOCIATED(vxc_tau))
THEN
537 DO ispin = 1,
SIZE(vxc_tau)
538 CALL auxbas_pw_pool%create_pw(tmp_pw)
542 CALL xc_pw_pool%give_back_pw(vxc_tau(ispin))
543 vxc_tau(ispin) = tmp_pw
546 CALL auxbas_pw_pool%give_back_pw(tmp_g2)
547 CALL xc_pw_pool%give_back_pw(tmp_g)
550 IF (
ASSOCIATED(tau) .AND. uf_grid)
THEN
551 DO ispin = 1,
SIZE(tau)
552 CALL xc_pw_pool%give_back_pw(tau(ispin))
559 CALL timestop(handle)
577 xc_ener, xc_den, exc, vxc, vtau)
579 TYPE(qs_ks_env_type),
POINTER :: ks_env
580 TYPE(qs_rho_type),
POINTER :: rho_struct
581 TYPE(section_vals_type),
POINTER :: xc_section
582 TYPE(qs_dispersion_type),
OPTIONAL,
POINTER :: dispersion_env
583 TYPE(pw_r3d_rs_type),
INTENT(INOUT),
OPTIONAL :: xc_ener, xc_den
584 TYPE(pw_r3d_rs_type),
OPTIONAL :: exc
585 TYPE(pw_r3d_rs_type),
DIMENSION(:),
OPTIONAL :: vxc, vtau
587 CHARACTER(len=*),
PARAMETER :: routinen =
'qs_xc_density'
589 INTEGER :: handle, ispin, myfun, nspins, vdw
590 LOGICAL :: rho_g_valid, tau_r_valid, uf_grid, vdw_nl
591 REAL(kind=dp) :: edisp, excint, factor, rho_cutoff
592 REAL(kind=dp),
DIMENSION(3, 3) :: vdum
593 TYPE(cell_type),
POINTER :: cell
594 TYPE(dft_control_type),
POINTER :: dft_control
595 TYPE(mp_para_env_type),
POINTER :: para_env
596 TYPE(pw_c1d_gs_type),
DIMENSION(:),
POINTER :: rho_g
597 TYPE(pw_c1d_gs_type),
POINTER :: rho_nlcc_g
598 TYPE(pw_env_type),
POINTER :: pw_env
599 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool, vdw_pw_pool, xc_pw_pool
600 TYPE(pw_r3d_rs_type) :: exc_r
601 TYPE(pw_r3d_rs_type),
DIMENSION(:),
POINTER :: rho_r, tau_r, vxc_rho, vxc_tau
602 TYPE(pw_r3d_rs_type),
POINTER :: rho_nlcc, weights
604 CALL timeset(routinen, handle)
606 CALL get_ks_env(ks_env, &
607 dft_control=dft_control, &
610 xcint_weights=weights, &
612 rho_nlcc_g=rho_nlcc_g)
614 CALL qs_rho_get(rho_struct, &
615 tau_r_valid=tau_r_valid, &
616 rho_g_valid=rho_g_valid, &
620 nspins = dft_control%nspins
622 CALL section_vals_val_get(xc_section,
"XC_FUNCTIONAL%_SECTION_PARAMETERS_", i_val=myfun)
623 CALL section_vals_val_get(xc_section,
"VDW_POTENTIAL%POTENTIAL_TYPE", i_val=vdw)
624 vdw_nl = (vdw == xc_vdw_fun_nonloc)
625 IF (
PRESENT(xc_ener))
THEN
626 IF (tau_r_valid)
THEN
627 CALL cp_warn(__location__,
"Tau contribution will not be correctly handled")
631 CALL cp_warn(__location__,
"vdW functional contribution will be ignored")
634 CALL pw_env_get(pw_env, xc_pw_pool=xc_pw_pool, auxbas_pw_pool=auxbas_pw_pool)
635 uf_grid = .NOT. pw_grid_compare(auxbas_pw_pool%pw_grid, xc_pw_pool%pw_grid)
637 CALL cp_warn(__location__,
"Fine grid option not possible with local energy")
638 cpabort(
"Fine Grid in Local Energy")
641 IF (
PRESENT(xc_ener))
THEN
642 CALL pw_zero(xc_ener)
644 IF (
PRESENT(xc_den))
THEN
647 IF (
PRESENT(exc))
THEN
650 IF (
PRESENT(vxc))
THEN
652 CALL pw_zero(vxc(ispin))
655 IF (
PRESENT(vtau))
THEN
657 CALL pw_zero(vtau(ispin))
661 IF (myfun /= xc_none)
THEN
663 cpassert(
ASSOCIATED(rho_struct))
664 cpassert(dft_control%sic_method_id == sic_none)
667 IF (
ASSOCIATED(rho_nlcc))
THEN
670 CALL pw_axpy(rho_nlcc, rho_r(ispin), factor)
671 CALL pw_axpy(rho_nlcc_g, rho_g(ispin), factor)
674 NULLIFY (vxc_rho, vxc_tau)
675 CALL xc_vxc_pw_create(vxc_rho=vxc_rho, vxc_tau=vxc_tau, rho_r=rho_r, &
676 rho_g=rho_g, tau=tau_r, exc=excint, &
677 xc_section=xc_section, &
678 weights=weights, pw_pool=xc_pw_pool, &
679 compute_virial=.false., &
687 CALL get_ks_env(ks_env=ks_env, para_env=para_env)
689 cpassert(dft_control%sic_method_id == sic_none)
691 CALL pw_env_get(pw_env, vdw_pw_pool=vdw_pw_pool)
692 CALL calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edisp, dispersion_env, &
693 .false., vdw_pw_pool, xc_pw_pool, para_env)
697 IF (
ASSOCIATED(rho_nlcc))
THEN
699 DO ispin = 1, dft_control%nspins
700 CALL pw_axpy(rho_nlcc, rho_r(ispin), factor)
701 CALL pw_axpy(rho_nlcc_g, rho_g(ispin), factor)
705 IF (
PRESENT(xc_den))
THEN
706 CALL pw_copy(exc_r, xc_den)
707 rho_cutoff = 1.e-14_dp
708 CALL calc_xc_density(xc_den, rho_r, rho_cutoff)
710 IF (
PRESENT(xc_ener))
THEN
711 CALL pw_copy(exc_r, xc_ener)
713 CALL pw_multiply(xc_ener, vxc_rho(ispin), rho_r(ispin), alpha=-1.0_dp)
716 IF (
PRESENT(exc))
THEN
717 CALL pw_copy(exc_r, exc)
719 IF (
PRESENT(vxc))
THEN
721 CALL pw_copy(vxc_rho(ispin), vxc(ispin))
724 IF (
PRESENT(vtau))
THEN
726 CALL pw_copy(vxc_tau(ispin), vtau(ispin))
730 IF (
ASSOCIATED(vxc_rho))
THEN
732 CALL vxc_rho(ispin)%release()
736 IF (
ASSOCIATED(vxc_tau))
THEN
738 CALL vxc_tau(ispin)%release()
746 CALL timestop(handle)
subroutine, public get_ks_env(ks_env, v_hartree_rspace, s_mstruct_changed, rho_changed, exc_accint, 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, xcint_weights, 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, sab_cneo, 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)
...