(git:d1312bc)
Loading...
Searching...
No Matches
qs_ks_utils.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief routines that build the Kohn-Sham matrix (i.e calculate the coulomb
10!> and xc parts
11!> \par History
12!> 05.2002 moved from qs_scf (see there the history) [fawzi]
13!> JGH [30.08.02] multi-grid arrays independent from density and potential
14!> 10.2002 introduced pools, uses updated rho as input,
15!> removed most temporary variables, renamed may vars,
16!> began conversion to LSD [fawzi]
17!> 10.2004 moved calculate_w_matrix here [Joost VandeVondele]
18!> introduced energy derivative wrt MOs [Joost VandeVondele]
19!> \author Fawzi Mohamed
20! **************************************************************************************************
21
23 USE admm_types, ONLY: admm_type,&
26 USE cell_types, ONLY: cell_type
28 USE cp_dbcsr_api, ONLY: &
31 USE cp_dbcsr_contrib, ONLY: dbcsr_dot,&
43 USE cp_fm_types, ONLY: cp_fm_create,&
52 USE cp_output_handling, ONLY: cp_p_file,&
58 USE hfx_types, ONLY: hfx_type
59 USE input_constants, ONLY: &
68 USE kinds, ONLY: default_string_length,&
69 dp
70 USE kpoint_types, ONLY: get_kpoint_info,&
81 USE ps_implicit_types, ONLY: mixed_bc,&
85 USE pw_env_types, ONLY: pw_env_get,&
87 USE pw_methods, ONLY: pw_axpy,&
88 pw_copy,&
91 pw_scale,&
98 USE pw_types, ONLY: pw_c1d_gs_type,&
107 USE qs_integrate_potential, ONLY: integrate_v_rspace,&
108 integrate_v_rspace_diagonal,&
109 integrate_v_rspace_one_center
110 USE qs_kind_types, ONLY: get_qs_kind_set,&
113 USE qs_ks_types, ONLY: get_ks_env,&
115 USE qs_mo_types, ONLY: get_mo_set,&
117 USE qs_rho_types, ONLY: qs_rho_get,&
120 USE virial_types, ONLY: virial_type
121 USE xc, ONLY: xc_exc_calc,&
123#include "./base/base_uses.f90"
124
125 IMPLICIT NONE
126
127 PRIVATE
128
129 LOGICAL, PARAMETER :: debug_this_module = .true.
130 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_ks_utils'
131
135
136CONTAINS
137
138! **************************************************************************************************
139!> \brief do ROKS calculations yielding low spin states
140!> \param energy ...
141!> \param qs_env ...
142!> \param dft_control ...
143!> \param do_hfx ...
144!> \param just_energy ...
145!> \param calculate_forces ...
146!> \param auxbas_pw_pool ...
147! **************************************************************************************************
148 SUBROUTINE low_spin_roks(energy, qs_env, dft_control, do_hfx, just_energy, &
149 calculate_forces, auxbas_pw_pool)
150
151 TYPE(qs_energy_type), POINTER :: energy
152 TYPE(qs_environment_type), POINTER :: qs_env
153 TYPE(dft_control_type), POINTER :: dft_control
154 LOGICAL, INTENT(IN) :: do_hfx, just_energy, calculate_forces
155 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
156
157 CHARACTER(*), PARAMETER :: routinen = 'low_spin_roks'
158
159 INTEGER :: handle, irep, ispin, iterm, k, k_alpha, &
160 k_beta, n_rep, nelectron, nspin, nterms
161 INTEGER, DIMENSION(:), POINTER :: ivec
162 INTEGER, DIMENSION(:, :, :), POINTER :: occupations
163 LOGICAL :: compute_virial, in_range, &
164 uniform_occupation
165 REAL(kind=dp) :: ehfx, exc
166 REAL(kind=dp), DIMENSION(3, 3) :: virial_xc_tmp
167 REAL(kind=dp), DIMENSION(:), POINTER :: energy_scaling, rvec, scaling
168 TYPE(cell_type), POINTER :: cell
169 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_h, matrix_hfx, matrix_p, mdummy, &
170 mo_derivs, rho_ao
171 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_p2
172 TYPE(dbcsr_type), POINTER :: dbcsr_deriv, fm_deriv, fm_scaled, &
173 mo_coeff
174 TYPE(hfx_type), DIMENSION(:, :), POINTER :: x_data
175 TYPE(mo_set_type), DIMENSION(:), POINTER :: mo_array
176 TYPE(mp_para_env_type), POINTER :: para_env
177 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
178 TYPE(pw_env_type), POINTER :: pw_env
179 TYPE(pw_pool_type), POINTER :: xc_pw_pool
180 TYPE(pw_r3d_rs_type) :: work_v_rspace
181 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau, vxc, vxc_tau
182 TYPE(pw_r3d_rs_type), POINTER :: weights
183 TYPE(qs_ks_env_type), POINTER :: ks_env
184 TYPE(qs_rho_type), POINTER :: rho
185 TYPE(section_vals_type), POINTER :: hfx_section, input, &
186 low_spin_roks_section, xc_section
187 TYPE(virial_type), POINTER :: virial
188
189 IF (.NOT. dft_control%low_spin_roks) RETURN
190
191 CALL timeset(routinen, handle)
192
193 NULLIFY (ks_env, rho_ao)
194
195 ! Test for not compatible options
196 IF (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc) THEN
197 CALL cp_abort(__location__, "GAPW/GAPW_XC are not compatible with low spin ROKS method.")
198 END IF
199 IF (dft_control%do_admm) THEN
200 CALL cp_abort(__location__, "ADMM not compatible with low spin ROKS method.")
201 END IF
202 IF (dft_control%do_admm) THEN
203 IF (qs_env%admm_env%aux_exch_func /= do_admm_aux_exch_func_none) THEN
204 CALL cp_abort(__location__, "ADMM with XC correction functional "// &
205 "not compatible with low spin ROKS method.")
206 END IF
207 END IF
208 IF (dft_control%qs_control%semi_empirical .OR. dft_control%qs_control%dftb .OR. &
209 dft_control%qs_control%xtb) THEN
210 CALL cp_abort(__location__, "SE/xTB/DFTB are not compatible with low spin ROKS method.")
211 END IF
212
213 CALL get_qs_env(qs_env, &
214 ks_env=ks_env, &
215 mo_derivs=mo_derivs, &
216 mos=mo_array, &
217 rho=rho, &
218 pw_env=pw_env, &
219 xcint_weights=weights, &
220 input=input, &
221 cell=cell, &
222 virial=virial)
223
224 CALL qs_rho_get(rho, rho_ao=rho_ao)
225
226 compute_virial = virial%pv_calculate .AND. (.NOT. virial%pv_numer)
227 xc_section => section_vals_get_subs_vals(input, "DFT%XC")
228 hfx_section => section_vals_get_subs_vals(input, "DFT%XC%HF")
229
230 ! No accurate integration possible (as there is no GAPW)
231 IF (ASSOCIATED(weights)) THEN
232 CALL cp_abort(__location__, "No accurate xc integration possible.")
233 END IF
234 ! some assumptions need to be checked
235 ! we have two spins
236 cpassert(SIZE(mo_array, 1) == 2)
237 nspin = 2
238 ! we want uniform occupations
239 CALL get_mo_set(mo_set=mo_array(1), uniform_occupation=uniform_occupation)
240 cpassert(uniform_occupation)
241 CALL get_mo_set(mo_set=mo_array(2), mo_coeff_b=mo_coeff, uniform_occupation=uniform_occupation)
242 cpassert(uniform_occupation)
243 IF (do_hfx .AND. calculate_forces .AND. compute_virial) THEN
244 CALL cp_abort(__location__, "ROKS virial with HFX not available.")
245 END IF
246
247 NULLIFY (dbcsr_deriv)
248 CALL dbcsr_init_p(dbcsr_deriv)
249 CALL dbcsr_copy(dbcsr_deriv, mo_derivs(1)%matrix)
250 CALL dbcsr_set(dbcsr_deriv, 0.0_dp)
251
252 ! basic info
253 CALL get_mo_set(mo_set=mo_array(1), mo_coeff_b=mo_coeff)
254 CALL dbcsr_get_info(mo_coeff, nfullcols_total=k_alpha)
255 CALL get_mo_set(mo_set=mo_array(2), mo_coeff_b=mo_coeff)
256 CALL dbcsr_get_info(mo_coeff, nfullcols_total=k_beta)
257
258 ! read the input
259 low_spin_roks_section => section_vals_get_subs_vals(input, "DFT%LOW_SPIN_ROKS")
260
261 CALL section_vals_val_get(low_spin_roks_section, "ENERGY_SCALING", r_vals=rvec)
262 nterms = SIZE(rvec)
263 ALLOCATE (energy_scaling(nterms))
264 energy_scaling = rvec !? just wondering, should this add up to 1, in which case we should cpp?
265
266 CALL section_vals_val_get(low_spin_roks_section, "SPIN_CONFIGURATION", n_rep_val=n_rep)
267 cpassert(n_rep == nterms)
268 CALL section_vals_val_get(low_spin_roks_section, "SPIN_CONFIGURATION", i_rep_val=1, i_vals=ivec)
269 nelectron = SIZE(ivec)
270 cpassert(nelectron == k_alpha - k_beta)
271 ALLOCATE (occupations(2, nelectron, nterms))
272 occupations = 0
273 DO iterm = 1, nterms
274 CALL section_vals_val_get(low_spin_roks_section, "SPIN_CONFIGURATION", i_rep_val=iterm, i_vals=ivec)
275 cpassert(nelectron == SIZE(ivec))
276 in_range = all(ivec >= 1) .AND. all(ivec <= 2)
277 cpassert(in_range)
278 DO k = 1, nelectron
279 occupations(ivec(k), k, iterm) = 1
280 END DO
281 END DO
282
283 ! set up general data structures
284 ! density matrices, kohn-sham matrices
285
286 NULLIFY (matrix_p)
287 CALL dbcsr_allocate_matrix_set(matrix_p, nspin)
288 DO ispin = 1, nspin
289 ALLOCATE (matrix_p(ispin)%matrix)
290 CALL dbcsr_copy(matrix_p(ispin)%matrix, rho_ao(1)%matrix, &
291 name="density matrix low spin roks")
292 CALL dbcsr_set(matrix_p(ispin)%matrix, 0.0_dp)
293 END DO
294
295 NULLIFY (matrix_h)
296 CALL dbcsr_allocate_matrix_set(matrix_h, nspin)
297 DO ispin = 1, nspin
298 ALLOCATE (matrix_h(ispin)%matrix)
299 CALL dbcsr_copy(matrix_h(ispin)%matrix, rho_ao(1)%matrix, &
300 name="KS matrix low spin roks")
301 CALL dbcsr_set(matrix_h(ispin)%matrix, 0.0_dp)
302 END DO
303
304 IF (do_hfx) THEN
305 NULLIFY (matrix_hfx)
306 CALL dbcsr_allocate_matrix_set(matrix_hfx, nspin)
307 DO ispin = 1, nspin
308 ALLOCATE (matrix_hfx(ispin)%matrix)
309 CALL dbcsr_copy(matrix_hfx(ispin)%matrix, rho_ao(1)%matrix, &
310 name="HFX matrix low spin roks")
311 END DO
312 END IF
313
314 ! grids in real and g space for rho and vxc
315 ! tau functionals are not supported
316 NULLIFY (tau, vxc_tau, vxc)
317 CALL pw_env_get(pw_env, xc_pw_pool=xc_pw_pool)
318
319 ALLOCATE (rho_r(nspin))
320 ALLOCATE (rho_g(nspin))
321 DO ispin = 1, nspin
322 CALL auxbas_pw_pool%create_pw(rho_r(ispin))
323 CALL auxbas_pw_pool%create_pw(rho_g(ispin))
324 END DO
325 CALL auxbas_pw_pool%create_pw(work_v_rspace)
326
327 ! get mo matrices needed to construct the density matrices
328 ! we will base all on the alpha spin matrix, obviously possible in ROKS
329 CALL get_mo_set(mo_set=mo_array(1), mo_coeff_b=mo_coeff)
330 NULLIFY (fm_scaled, fm_deriv)
331 CALL dbcsr_init_p(fm_scaled)
332 CALL dbcsr_init_p(fm_deriv)
333 CALL dbcsr_copy(fm_scaled, mo_coeff)
334 CALL dbcsr_copy(fm_deriv, mo_coeff)
335
336 ALLOCATE (scaling(k_alpha))
337
338 ! for each term, add it with the given scaling factor to the energy, and compute the required derivatives
339 DO iterm = 1, nterms
340
341 DO ispin = 1, nspin
342 ! compute the proper density matrices with the required occupations
343 CALL dbcsr_set(matrix_p(ispin)%matrix, 0.0_dp)
344 scaling = 1.0_dp
345 scaling(k_alpha - nelectron + 1:k_alpha) = occupations(ispin, :, iterm)
346 CALL dbcsr_copy(fm_scaled, mo_coeff)
347 CALL dbcsr_scale_by_vector(fm_scaled, scaling, side='right')
348 CALL dbcsr_multiply('n', 't', 1.0_dp, mo_coeff, fm_scaled, &
349 0.0_dp, matrix_p(ispin)%matrix, retain_sparsity=.true.)
350 ! compute the densities on the grid
351 CALL calculate_rho_elec(matrix_p=matrix_p(ispin)%matrix, &
352 rho=rho_r(ispin), rho_gspace=rho_g(ispin), &
353 ks_env=ks_env)
354 END DO
355
356 ! compute the exchange energies / potential if needed
357 IF (just_energy) THEN
358 exc = xc_exc_calc(rho_r=rho_r, rho_g=rho_g, tau=tau, xc_section=xc_section, &
359 weights=weights, pw_pool=xc_pw_pool)
360 ELSE
361 cpassert(.NOT. compute_virial)
362 CALL xc_vxc_pw_create(vxc_rho=vxc, rho_r=rho_r, &
363 rho_g=rho_g, tau=tau, vxc_tau=vxc_tau, exc=exc, xc_section=xc_section, &
364 weights=weights, pw_pool=xc_pw_pool, &
365 compute_virial=.false., virial_xc=virial_xc_tmp)
366 END IF
367
368 energy%exc = energy%exc + energy_scaling(iterm)*exc
369
370 IF (do_hfx) THEN
371 ! Add Hartree-Fock contribution
372 DO ispin = 1, nspin
373 CALL dbcsr_set(matrix_hfx(ispin)%matrix, 0.0_dp)
374 END DO
375 ehfx = energy%ex
376 CALL tddft_hfx_matrix(matrix_hfx, matrix_p, qs_env, &
377 recalc_integrals=.false., update_energy=.true.)
378 energy%ex = ehfx + energy_scaling(iterm)*energy%ex
379 END IF
380
381 ! add the corresponding derivatives to the MO derivatives
382 IF (.NOT. just_energy) THEN
383 ! get the potential in matrix form
384 DO ispin = 1, nspin
385 CALL dbcsr_set(matrix_h(ispin)%matrix, 0.0_dp)
386 ! use a work_v_rspace
387 CALL pw_axpy(vxc(ispin), work_v_rspace, energy_scaling(iterm)*vxc(ispin)%pw_grid%dvol, 0.0_dp)
388 CALL integrate_v_rspace(v_rspace=work_v_rspace, pmat=matrix_p(ispin), hmat=matrix_h(ispin), &
389 qs_env=qs_env, calculate_forces=calculate_forces)
390 CALL auxbas_pw_pool%give_back_pw(vxc(ispin))
391 END DO
392 DEALLOCATE (vxc)
393
394 IF (do_hfx) THEN
395 ! add HFX contribution
396 DO ispin = 1, nspin
397 CALL dbcsr_add(matrix_h(ispin)%matrix, matrix_hfx(ispin)%matrix, &
398 1.0_dp, energy_scaling(iterm))
399 END DO
400 IF (calculate_forces) THEN
401 CALL get_qs_env(qs_env, x_data=x_data, para_env=para_env)
402 IF (x_data(1, 1)%n_rep_hf /= 1) THEN
403 CALL cp_abort(__location__, "Multiple HFX section forces not compatible "// &
404 "with low spin ROKS method.")
405 END IF
406 IF (x_data(1, 1)%do_hfx_ri) THEN
407 CALL cp_abort(__location__, "HFX_RI forces not compatible with low spin ROKS method.")
408 ELSE
409 irep = 1
410 NULLIFY (mdummy)
411 matrix_p2(1:nspin, 1:1) => matrix_p(1:nspin)
412 CALL derivatives_four_center(qs_env, matrix_p2, mdummy, hfx_section, para_env, &
413 irep, compute_virial, &
414 adiabatic_rescale_factor=energy_scaling(iterm))
415 END IF
416 END IF
417
418 END IF
419
420 ! add this to the mo_derivs, again based on the alpha mo_coeff
421 DO ispin = 1, nspin
422 CALL dbcsr_multiply('n', 'n', 1.0_dp, matrix_h(ispin)%matrix, mo_coeff, &
423 0.0_dp, dbcsr_deriv, last_column=k_alpha)
424
425 scaling = 1.0_dp
426 scaling(k_alpha - nelectron + 1:k_alpha) = occupations(ispin, :, iterm)
427 CALL dbcsr_scale_by_vector(dbcsr_deriv, scaling, side='right')
428 CALL dbcsr_add(mo_derivs(1)%matrix, dbcsr_deriv, 1.0_dp, 1.0_dp)
429 END DO
430
431 END IF
432
433 END DO
434
435 ! release allocated memory
436 DO ispin = 1, nspin
437 CALL auxbas_pw_pool%give_back_pw(rho_r(ispin))
438 CALL auxbas_pw_pool%give_back_pw(rho_g(ispin))
439 END DO
440 DEALLOCATE (rho_r, rho_g)
441 CALL dbcsr_deallocate_matrix_set(matrix_p)
442 CALL dbcsr_deallocate_matrix_set(matrix_h)
443 IF (do_hfx) THEN
444 CALL dbcsr_deallocate_matrix_set(matrix_hfx)
445 END IF
446
447 CALL auxbas_pw_pool%give_back_pw(work_v_rspace)
448
449 CALL dbcsr_release_p(fm_deriv)
450 CALL dbcsr_release_p(fm_scaled)
451
452 DEALLOCATE (occupations)
453 DEALLOCATE (energy_scaling)
454 DEALLOCATE (scaling)
455
456 CALL dbcsr_release_p(dbcsr_deriv)
457
458 CALL timestop(handle)
459
460 END SUBROUTINE low_spin_roks
461! **************************************************************************************************
462!> \brief do sic calculations on explicit orbitals
463!> \param energy ...
464!> \param qs_env ...
465!> \param dft_control ...
466!> \param poisson_env ...
467!> \param just_energy ...
468!> \param calculate_forces ...
469!> \param auxbas_pw_pool ...
470! **************************************************************************************************
471 SUBROUTINE sic_explicit_orbitals(energy, qs_env, dft_control, poisson_env, just_energy, &
472 calculate_forces, auxbas_pw_pool)
473
474 TYPE(qs_energy_type), POINTER :: energy
475 TYPE(qs_environment_type), POINTER :: qs_env
476 TYPE(dft_control_type), POINTER :: dft_control
477 TYPE(pw_poisson_type), POINTER :: poisson_env
478 LOGICAL, INTENT(IN) :: just_energy, calculate_forces
479 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
480
481 CHARACTER(*), PARAMETER :: routinen = 'sic_explicit_orbitals'
482
483 INTEGER :: handle, i, iorb, k_alpha, k_beta, norb
484 INTEGER, ALLOCATABLE, DIMENSION(:, :) :: sic_orbital_list
485 LOGICAL :: compute_virial, uniform_occupation
486 REAL(kind=dp) :: ener, exc
487 REAL(kind=dp), DIMENSION(3, 3) :: virial_xc_tmp
488 TYPE(cell_type), POINTER :: cell
489 TYPE(cp_fm_struct_type), POINTER :: fm_struct_tmp
490 TYPE(cp_fm_type) :: matrix_hv, matrix_v
491 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: mo_derivs_local
492 TYPE(cp_fm_type), POINTER :: mo_coeff
493 TYPE(dbcsr_p_type) :: orb_density_matrix_p, orb_h_p
494 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: mo_derivs, rho_ao, tmp_dbcsr
495 TYPE(dbcsr_type), POINTER :: orb_density_matrix, orb_h
496 TYPE(mo_set_type), DIMENSION(:), POINTER :: mo_array
497 TYPE(pw_c1d_gs_type) :: work_v_gspace
498 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
499 TYPE(pw_c1d_gs_type), TARGET :: orb_rho_g, tmp_g
500 TYPE(pw_env_type), POINTER :: pw_env
501 TYPE(pw_pool_type), POINTER :: xc_pw_pool
502 TYPE(pw_r3d_rs_type) :: work_v_rspace
503 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau, vxc, vxc_tau
504 TYPE(pw_r3d_rs_type), POINTER :: weights
505 TYPE(pw_r3d_rs_type), TARGET :: orb_rho_r, tmp_r
506 TYPE(qs_ks_env_type), POINTER :: ks_env
507 TYPE(qs_rho_type), POINTER :: rho
508 TYPE(section_vals_type), POINTER :: input, xc_section
509 TYPE(virial_type), POINTER :: virial
510
511 IF (dft_control%sic_method_id /= sic_eo) RETURN
512
513 CALL timeset(routinen, handle)
514
515 NULLIFY (tau, vxc_tau, mo_derivs, ks_env, rho_ao)
516
517 ! generate the lists of orbitals that need sic treatment
518 CALL get_qs_env(qs_env, &
519 ks_env=ks_env, &
520 mo_derivs=mo_derivs, &
521 mos=mo_array, &
522 rho=rho, &
523 xcint_weights=weights, &
524 pw_env=pw_env, &
525 input=input, &
526 cell=cell, &
527 virial=virial)
528
529 CALL qs_rho_get(rho, rho_ao=rho_ao)
530
531 compute_virial = virial%pv_calculate .AND. (.NOT. virial%pv_numer)
532 xc_section => section_vals_get_subs_vals(input, "DFT%XC")
533
534 DO i = 1, SIZE(mo_array) !fm->dbcsr
535 IF (mo_array(i)%use_mo_coeff_b) THEN !fm->dbcsr
536 CALL copy_dbcsr_to_fm(mo_array(i)%mo_coeff_b, &
537 mo_array(i)%mo_coeff) !fm->dbcsr
538 END IF !fm->dbcsr
539 END DO !fm->dbcsr
540
541 CALL pw_env_get(pw_env, xc_pw_pool=xc_pw_pool)
542
543 ! we have two spins
544 cpassert(SIZE(mo_array, 1) == 2)
545 ! we want uniform occupations
546 CALL get_mo_set(mo_set=mo_array(1), uniform_occupation=uniform_occupation)
547 cpassert(uniform_occupation)
548 CALL get_mo_set(mo_set=mo_array(2), mo_coeff=mo_coeff, uniform_occupation=uniform_occupation)
549 cpassert(uniform_occupation)
550
551 NULLIFY (tmp_dbcsr)
552 CALL dbcsr_allocate_matrix_set(tmp_dbcsr, SIZE(mo_derivs, 1))
553 DO i = 1, SIZE(mo_derivs, 1) !fm->dbcsr
554 !
555 NULLIFY (tmp_dbcsr(i)%matrix)
556 CALL dbcsr_init_p(tmp_dbcsr(i)%matrix)
557 CALL dbcsr_copy(tmp_dbcsr(i)%matrix, mo_derivs(i)%matrix)
558 CALL dbcsr_set(tmp_dbcsr(i)%matrix, 0.0_dp)
559 END DO !fm->dbcsr
560
561 k_alpha = 0; k_beta = 0
562 SELECT CASE (dft_control%sic_list_id)
563 CASE (sic_list_all)
564
565 CALL get_mo_set(mo_set=mo_array(1), mo_coeff=mo_coeff)
566 CALL cp_fm_get_info(mo_coeff, ncol_global=k_alpha)
567
568 IF (SIZE(mo_array, 1) > 1) THEN
569 CALL get_mo_set(mo_set=mo_array(2), mo_coeff=mo_coeff)
570 CALL cp_fm_get_info(mo_coeff, ncol_global=k_beta)
571 END IF
572
573 norb = k_alpha + k_beta
574 ALLOCATE (sic_orbital_list(3, norb))
575
576 iorb = 0
577 DO i = 1, k_alpha
578 iorb = iorb + 1
579 sic_orbital_list(1, iorb) = 1
580 sic_orbital_list(2, iorb) = i
581 sic_orbital_list(3, iorb) = 1
582 END DO
583 DO i = 1, k_beta
584 iorb = iorb + 1
585 sic_orbital_list(1, iorb) = 2
586 sic_orbital_list(2, iorb) = i
587 IF (SIZE(mo_derivs, 1) == 1) THEN
588 sic_orbital_list(3, iorb) = 1
589 ELSE
590 sic_orbital_list(3, iorb) = 2
591 END IF
592 END DO
593
594 CASE (sic_list_unpaired)
595 ! we have two spins
596 cpassert(SIZE(mo_array, 1) == 2)
597 ! we have them restricted
598 cpassert(SIZE(mo_derivs, 1) == 1)
599 cpassert(dft_control%restricted)
600
601 CALL get_mo_set(mo_set=mo_array(1), mo_coeff=mo_coeff)
602 CALL cp_fm_get_info(mo_coeff, ncol_global=k_alpha)
603
604 CALL get_mo_set(mo_set=mo_array(2), mo_coeff=mo_coeff)
605 CALL cp_fm_get_info(mo_coeff, ncol_global=k_beta)
606
607 norb = k_alpha - k_beta
608 ALLOCATE (sic_orbital_list(3, norb))
609
610 iorb = 0
611 DO i = k_beta + 1, k_alpha
612 iorb = iorb + 1
613 sic_orbital_list(1, iorb) = 1
614 sic_orbital_list(2, iorb) = i
615 ! we are guaranteed to be restricted
616 sic_orbital_list(3, iorb) = 1
617 END DO
618
619 CASE DEFAULT
620 cpabort("Unknown dft_control%sic_list_id")
621 END SELECT
622
623 ! data needed for each of the orbs
624 CALL auxbas_pw_pool%create_pw(orb_rho_r)
625 CALL auxbas_pw_pool%create_pw(tmp_r)
626 CALL auxbas_pw_pool%create_pw(orb_rho_g)
627 CALL auxbas_pw_pool%create_pw(tmp_g)
628 CALL auxbas_pw_pool%create_pw(work_v_gspace)
629 CALL auxbas_pw_pool%create_pw(work_v_rspace)
630
631 ALLOCATE (orb_density_matrix)
632 CALL dbcsr_copy(orb_density_matrix, rho_ao(1)%matrix, &
633 name="orb_density_matrix")
634 CALL dbcsr_set(orb_density_matrix, 0.0_dp)
635 orb_density_matrix_p%matrix => orb_density_matrix
636
637 ALLOCATE (orb_h)
638 CALL dbcsr_copy(orb_h, rho_ao(1)%matrix, &
639 name="orb_density_matrix")
640 CALL dbcsr_set(orb_h, 0.0_dp)
641 orb_h_p%matrix => orb_h
642
643 CALL get_mo_set(mo_set=mo_array(1), mo_coeff=mo_coeff)
644
645 CALL cp_fm_struct_create(fm_struct_tmp, ncol_global=1, &
646 template_fmstruct=mo_coeff%matrix_struct)
647 CALL cp_fm_create(matrix_v, fm_struct_tmp, name="matrix_v")
648 CALL cp_fm_create(matrix_hv, fm_struct_tmp, name="matrix_hv")
649 CALL cp_fm_struct_release(fm_struct_tmp)
650
651 ALLOCATE (mo_derivs_local(SIZE(mo_array, 1)))
652 DO i = 1, SIZE(mo_array, 1)
653 CALL get_mo_set(mo_set=mo_array(i), mo_coeff=mo_coeff)
654 CALL cp_fm_create(mo_derivs_local(i), mo_coeff%matrix_struct)
655 END DO
656
657 ALLOCATE (rho_r(2))
658 rho_r(1) = orb_rho_r
659 rho_r(2) = tmp_r
660 CALL pw_zero(tmp_r)
661
662 ALLOCATE (rho_g(2))
663 rho_g(1) = orb_rho_g
664 rho_g(2) = tmp_g
665 CALL pw_zero(tmp_g)
666
667 NULLIFY (vxc)
668 ! now apply to SIC correction to each selected orbital
669 DO iorb = 1, norb
670 ! extract the proper orbital from the mo_coeff
671 CALL get_mo_set(mo_set=mo_array(sic_orbital_list(1, iorb)), mo_coeff=mo_coeff)
672 CALL cp_fm_to_fm(mo_coeff, matrix_v, 1, sic_orbital_list(2, iorb), 1)
673
674 ! construct the density matrix and the corresponding density
675 CALL dbcsr_set(orb_density_matrix, 0.0_dp)
676 CALL cp_dbcsr_plus_fm_fm_t(orb_density_matrix, matrix_v=matrix_v, ncol=1, &
677 alpha=1.0_dp)
678
679 CALL calculate_rho_elec(matrix_p=orb_density_matrix, &
680 rho=orb_rho_r, rho_gspace=orb_rho_g, &
681 ks_env=ks_env)
682
683 ! compute the energy functional for this orbital and its derivative
684
685 CALL pw_poisson_solve(poisson_env, orb_rho_g, ener, work_v_gspace)
686 ! no PBC correction is done here, see "calc_v_sic_rspace" for SIC methods
687 ! with PBC aware corrections
688 energy%hartree = energy%hartree - dft_control%sic_scaling_a*ener
689 IF (.NOT. just_energy) THEN
690 CALL pw_transfer(work_v_gspace, work_v_rspace)
691 CALL pw_scale(work_v_rspace, -dft_control%sic_scaling_a*work_v_rspace%pw_grid%dvol)
692 CALL dbcsr_set(orb_h, 0.0_dp)
693 END IF
694
695 IF (just_energy) THEN
696 exc = xc_exc_calc(rho_r=rho_r, rho_g=rho_g, tau=tau, xc_section=xc_section, &
697 weights=weights, pw_pool=xc_pw_pool)
698 ELSE
699 cpassert(.NOT. compute_virial)
700 CALL xc_vxc_pw_create(vxc_rho=vxc, rho_r=rho_r, &
701 rho_g=rho_g, tau=tau, vxc_tau=vxc_tau, exc=exc, xc_section=xc_section, &
702 weights=weights, pw_pool=xc_pw_pool, &
703 compute_virial=compute_virial, virial_xc=virial_xc_tmp)
704 ! add to the existing work_v_rspace
705 CALL pw_axpy(vxc(1), work_v_rspace, -dft_control%sic_scaling_b*vxc(1)%pw_grid%dvol)
706 END IF
707 energy%exc = energy%exc - dft_control%sic_scaling_b*exc
708
709 IF (.NOT. just_energy) THEN
710 ! note, orb_h (which is being pointed to with orb_h_p) is zeroed above
711 CALL integrate_v_rspace(v_rspace=work_v_rspace, pmat=orb_density_matrix_p, hmat=orb_h_p, &
712 qs_env=qs_env, calculate_forces=calculate_forces)
713
714 ! add this to the mo_derivs
715 CALL cp_dbcsr_sm_fm_multiply(orb_h, matrix_v, matrix_hv, 1)
716 ! silly trick, copy to an array of the right size and add to mo_derivs
717 CALL cp_fm_set_all(mo_derivs_local(sic_orbital_list(3, iorb)), 0.0_dp)
718 CALL cp_fm_to_fm(matrix_hv, mo_derivs_local(sic_orbital_list(3, iorb)), 1, 1, sic_orbital_list(2, iorb))
719 CALL copy_fm_to_dbcsr(mo_derivs_local(sic_orbital_list(3, iorb)), &
720 tmp_dbcsr(sic_orbital_list(3, iorb))%matrix)
721 CALL dbcsr_add(mo_derivs(sic_orbital_list(3, iorb))%matrix, &
722 tmp_dbcsr(sic_orbital_list(3, iorb))%matrix, 1.0_dp, 1.0_dp)
723 !
724 ! need to deallocate vxc
725 CALL xc_pw_pool%give_back_pw(vxc(1))
726 CALL xc_pw_pool%give_back_pw(vxc(2))
727 DEALLOCATE (vxc)
728
729 END IF
730
731 END DO
732
733 CALL auxbas_pw_pool%give_back_pw(orb_rho_r)
734 CALL auxbas_pw_pool%give_back_pw(tmp_r)
735 CALL auxbas_pw_pool%give_back_pw(orb_rho_g)
736 CALL auxbas_pw_pool%give_back_pw(tmp_g)
737 CALL auxbas_pw_pool%give_back_pw(work_v_gspace)
738 CALL auxbas_pw_pool%give_back_pw(work_v_rspace)
739
740 CALL dbcsr_deallocate_matrix(orb_density_matrix)
741 CALL dbcsr_deallocate_matrix(orb_h)
742 CALL cp_fm_release(matrix_v)
743 CALL cp_fm_release(matrix_hv)
744 CALL cp_fm_release(mo_derivs_local)
745 DEALLOCATE (rho_r)
746 DEALLOCATE (rho_g)
747
748 CALL dbcsr_deallocate_matrix_set(tmp_dbcsr) !fm->dbcsr
749
750 CALL timestop(handle)
751
752 END SUBROUTINE sic_explicit_orbitals
753
754! **************************************************************************************************
755!> \brief do sic calculations on the spin density
756!> \param v_sic_rspace ...
757!> \param energy ...
758!> \param qs_env ...
759!> \param dft_control ...
760!> \param rho ...
761!> \param poisson_env ...
762!> \param just_energy ...
763!> \param calculate_forces ...
764!> \param auxbas_pw_pool ...
765! **************************************************************************************************
766 SUBROUTINE calc_v_sic_rspace(v_sic_rspace, energy, &
767 qs_env, dft_control, rho, poisson_env, just_energy, &
768 calculate_forces, auxbas_pw_pool)
769
770 TYPE(pw_r3d_rs_type), POINTER :: v_sic_rspace
771 TYPE(qs_energy_type), POINTER :: energy
772 TYPE(qs_environment_type), POINTER :: qs_env
773 TYPE(dft_control_type), POINTER :: dft_control
774 TYPE(qs_rho_type), POINTER :: rho
775 TYPE(pw_poisson_type), POINTER :: poisson_env
776 LOGICAL, INTENT(IN) :: just_energy, calculate_forces
777 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
778
779 INTEGER :: i, nelec, nelec_a, nelec_b, nforce
780 REAL(kind=dp) :: ener, full_scaling, scaling
781 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: store_forces
782 TYPE(mo_set_type), DIMENSION(:), POINTER :: mo_array
783 TYPE(pw_c1d_gs_type) :: work_rho, work_v
784 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
785 TYPE(qs_force_type), DIMENSION(:), POINTER :: force
786
787 NULLIFY (mo_array, rho_g)
788
789 IF (dft_control%sic_method_id == sic_none) RETURN
790 IF (dft_control%sic_method_id == sic_eo) RETURN
791
792 IF (dft_control%qs_control%gapw) THEN
793 cpabort("sic and GAPW not yet compatible")
794 END IF
795
796 ! OK, right now we like two spins to do sic, could be relaxed for AD
797 cpassert(dft_control%nspins == 2)
798
799 CALL auxbas_pw_pool%create_pw(work_rho)
800 CALL auxbas_pw_pool%create_pw(work_v)
801
802 CALL qs_rho_get(rho, rho_g=rho_g)
803
804 ! Hartree sic corrections
805 SELECT CASE (dft_control%sic_method_id)
807 CALL pw_copy(rho_g(1), work_rho)
808 CALL pw_axpy(rho_g(2), work_rho, alpha=-1._dp)
809 CALL pw_poisson_solve(poisson_env, work_rho, ener, work_v)
810 CASE (sic_ad)
811 ! find out how many elecs we have
812 CALL get_qs_env(qs_env, mos=mo_array)
813 CALL get_mo_set(mo_set=mo_array(1), nelectron=nelec_a)
814 CALL get_mo_set(mo_set=mo_array(2), nelectron=nelec_b)
815 nelec = nelec_a + nelec_b
816 CALL pw_copy(rho_g(1), work_rho)
817 CALL pw_axpy(rho_g(2), work_rho)
818 scaling = 1.0_dp/real(nelec, kind=dp)
819 CALL pw_scale(work_rho, scaling)
820 CALL pw_poisson_solve(poisson_env, work_rho, ener, work_v)
821 CASE DEFAULT
822 cpabort("Unknown sic method id")
823 END SELECT
824
825 ! Correct for DDAP charges (if any)
826 ! storing whatever force might be there from previous decoupling
827 IF (calculate_forces) THEN
828 CALL get_qs_env(qs_env=qs_env, force=force)
829 nforce = 0
830 DO i = 1, SIZE(force)
831 nforce = nforce + SIZE(force(i)%ch_pulay, 2)
832 END DO
833 ALLOCATE (store_forces(3, nforce))
834 nforce = 0
835 DO i = 1, SIZE(force)
836 store_forces(1:3, nforce + 1:nforce + SIZE(force(i)%ch_pulay, 2)) = force(i)%ch_pulay(:, :)
837 force(i)%ch_pulay(:, :) = 0.0_dp
838 nforce = nforce + SIZE(force(i)%ch_pulay, 2)
839 END DO
840 END IF
841
842 CALL cp_ddapc_apply_cd(qs_env, &
843 work_rho, &
844 ener, &
845 v_hartree_gspace=work_v, &
846 calculate_forces=calculate_forces, &
847 itype_of_density="SPIN")
848
849 SELECT CASE (dft_control%sic_method_id)
851 full_scaling = -dft_control%sic_scaling_a
852 CASE (sic_ad)
853 full_scaling = -dft_control%sic_scaling_a*nelec
854 CASE DEFAULT
855 cpabort("Unknown sic method id")
856 END SELECT
857 energy%hartree = energy%hartree + full_scaling*ener
858
859 ! add scaled forces, restoring the old
860 IF (calculate_forces) THEN
861 nforce = 0
862 DO i = 1, SIZE(force)
863 force(i)%ch_pulay(:, :) = force(i)%ch_pulay(:, :)*full_scaling + &
864 store_forces(1:3, nforce + 1:nforce + SIZE(force(i)%ch_pulay, 2))
865 nforce = nforce + SIZE(force(i)%ch_pulay, 2)
866 END DO
867 END IF
868
869 IF (.NOT. just_energy) THEN
870 ALLOCATE (v_sic_rspace)
871 CALL auxbas_pw_pool%create_pw(v_sic_rspace)
872 CALL pw_transfer(work_v, v_sic_rspace)
873 ! also take into account the scaling (in addition to the volume element)
874 CALL pw_scale(v_sic_rspace, &
875 dft_control%sic_scaling_a*v_sic_rspace%pw_grid%dvol)
876 END IF
877
878 CALL auxbas_pw_pool%give_back_pw(work_rho)
879 CALL auxbas_pw_pool%give_back_pw(work_v)
880
881 END SUBROUTINE calc_v_sic_rspace
882
883! **************************************************************************************************
884!> \brief ...
885!> \param qs_env ...
886!> \param rho ...
887! **************************************************************************************************
888 SUBROUTINE print_densities(qs_env, rho)
889 TYPE(qs_environment_type), POINTER :: qs_env
890 TYPE(qs_rho_type), POINTER :: rho
891
892 INTEGER :: img, ispin, n_electrons, output_unit
893 REAL(dp) :: tot1_h, tot1_s, tot_rho_r, trace, &
894 trace_tmp
895 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_r_arr
896 TYPE(cell_type), POINTER :: cell
897 TYPE(cp_logger_type), POINTER :: logger
898 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_s, rho_ao
899 TYPE(dft_control_type), POINTER :: dft_control
900 TYPE(qs_charges_type), POINTER :: qs_charges
901 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
902 TYPE(section_vals_type), POINTER :: input, scf_section
903
904 NULLIFY (qs_charges, qs_kind_set, cell, input, logger, scf_section, matrix_s, &
905 dft_control, tot_rho_r_arr, rho_ao)
906
907 logger => cp_get_default_logger()
908
909 CALL get_qs_env(qs_env, &
910 qs_kind_set=qs_kind_set, &
911 cell=cell, qs_charges=qs_charges, &
912 input=input, &
913 matrix_s_kp=matrix_s, &
914 dft_control=dft_control)
915
916 CALL get_qs_kind_set(qs_kind_set, nelectron=n_electrons)
917
918 scf_section => section_vals_get_subs_vals(input, "DFT%SCF")
919 output_unit = cp_print_key_unit_nr(logger, scf_section, "PRINT%TOTAL_DENSITIES", &
920 extension=".scfLog")
921
922 CALL qs_rho_get(rho, tot_rho_r=tot_rho_r_arr, rho_ao_kp=rho_ao)
923 n_electrons = n_electrons - dft_control%charge
924 tot_rho_r = accurate_sum(tot_rho_r_arr)
925
926 trace = 0
927 IF (btest(cp_print_key_should_output(logger%iter_info, scf_section, "PRINT%TOTAL_DENSITIES"), cp_p_file)) THEN
928 DO ispin = 1, dft_control%nspins
929 DO img = 1, dft_control%nimages
930 CALL dbcsr_dot(rho_ao(ispin, img)%matrix, matrix_s(1, img)%matrix, trace_tmp)
931 trace = trace + trace_tmp
932 END DO
933 END DO
934 END IF
935
936 IF (output_unit > 0) THEN
937 WRITE (unit=output_unit, fmt="(/,T3,A,T41,F20.10)") "Trace(PS):", trace
938 WRITE (unit=output_unit, fmt="((T3,A,T41,2F20.10))") &
939 "Electronic density on regular grids: ", &
940 tot_rho_r, &
941 tot_rho_r + &
942 REAL(n_electrons, dp), &
943 "Core density on regular grids:", &
944 qs_charges%total_rho_core_rspace, &
945 qs_charges%total_rho_core_rspace + &
946 qs_charges%total_rho1_hard_nuc - &
947 REAL(n_electrons + dft_control%charge, dp)
948 END IF
949 IF (dft_control%qs_control%gapw) THEN
950 tot1_h = qs_charges%total_rho1_hard(1)
951 tot1_s = qs_charges%total_rho1_soft(1)
952 DO ispin = 2, dft_control%nspins
953 tot1_h = tot1_h + qs_charges%total_rho1_hard(ispin)
954 tot1_s = tot1_s + qs_charges%total_rho1_soft(ispin)
955 END DO
956 IF (output_unit > 0) THEN
957 WRITE (unit=output_unit, fmt="((T3,A,T41,2F20.10))") &
958 "Hard and soft densities (Lebedev):", &
959 tot1_h, tot1_s
960 WRITE (unit=output_unit, fmt="(T3,A,T41,F20.10)") &
961 "Total Rho_soft + Rho1_hard - Rho1_soft (r-space): ", &
962 tot_rho_r + tot1_h - tot1_s, &
963 "Total charge density (r-space): ", &
964 tot_rho_r + tot1_h - tot1_s &
965 + qs_charges%total_rho_core_rspace &
966 + qs_charges%total_rho1_hard_nuc
967 IF (qs_charges%total_rho1_hard_nuc /= 0.0_dp) THEN
968 WRITE (unit=output_unit, fmt="(T3,A,T41,F20.10)") &
969 "Total CNEO nuc. char. den. (Lebedev): ", &
970 qs_charges%total_rho1_hard_nuc, &
971 "Total CNEO soft char. den. (Lebedev): ", &
972 qs_charges%total_rho1_soft_nuc_lebedev, &
973 "Total CNEO soft char. den. (r-space): ", &
974 qs_charges%total_rho1_soft_nuc_rspace, &
975 "Total soft Rho_e+n+0 (g-space):", &
976 qs_charges%total_rho_gspace
977 ELSE
978 WRITE (unit=output_unit, fmt="(T3,A,T41,F20.10)") &
979 "Total Rho_soft + Rho0_soft (g-space):", &
980 qs_charges%total_rho_gspace
981 END IF
982 END IF
983 qs_charges%background = tot_rho_r + tot1_h - tot1_s + &
984 qs_charges%total_rho_core_rspace + &
985 qs_charges%total_rho1_hard_nuc
986 ! only add total_rho1_hard_nuc for gapw as cneo requires gapw
987 ELSE IF (dft_control%qs_control%gapw_xc) THEN
988 tot1_h = qs_charges%total_rho1_hard(1)
989 tot1_s = qs_charges%total_rho1_soft(1)
990 DO ispin = 2, dft_control%nspins
991 tot1_h = tot1_h + qs_charges%total_rho1_hard(ispin)
992 tot1_s = tot1_s + qs_charges%total_rho1_soft(ispin)
993 END DO
994 IF (output_unit > 0) THEN
995 WRITE (unit=output_unit, fmt="(/,(T3,A,T41,2F20.10))") &
996 "Hard and soft densities (Lebedev):", &
997 tot1_h, tot1_s
998 WRITE (unit=output_unit, fmt="(T3,A,T41,F20.10)") &
999 "Total Rho_soft + Rho1_hard - Rho1_soft (r-space): ", &
1000 accurate_sum(tot_rho_r_arr) + tot1_h - tot1_s
1001 END IF
1002 qs_charges%background = tot_rho_r + &
1003 qs_charges%total_rho_core_rspace
1004 ELSE
1005 IF (output_unit > 0) THEN
1006 WRITE (unit=output_unit, fmt="(T3,A,T41,F20.10)") &
1007 "Total charge density on r-space grids: ", &
1008 tot_rho_r + &
1009 qs_charges%total_rho_core_rspace, &
1010 "Total charge density g-space grids: ", &
1011 qs_charges%total_rho_gspace
1012 END IF
1013 qs_charges%background = tot_rho_r + &
1014 qs_charges%total_rho_core_rspace
1015 END IF
1016 IF (output_unit > 0) WRITE (unit=output_unit, fmt="()")
1017 qs_charges%background = qs_charges%background/cell%deth
1018
1019 CALL cp_print_key_finished_output(output_unit, logger, scf_section, &
1020 "PRINT%TOTAL_DENSITIES")
1021
1022 END SUBROUTINE print_densities
1023
1024! **************************************************************************************************
1025!> \brief Print detailed energies
1026!>
1027!> \param qs_env ...
1028!> \param dft_control ...
1029!> \param input ...
1030!> \param energy ...
1031!> \param mulliken_order_p ...
1032!> \par History
1033!> refactoring 04.03.2011 [MI]
1034!> \author
1035! **************************************************************************************************
1036 SUBROUTINE print_detailed_energy(qs_env, dft_control, input, energy, mulliken_order_p)
1037
1038 TYPE(qs_environment_type), POINTER :: qs_env
1039 TYPE(dft_control_type), POINTER :: dft_control
1040 TYPE(section_vals_type), POINTER :: input
1041 TYPE(qs_energy_type), POINTER :: energy
1042 REAL(kind=dp), INTENT(IN) :: mulliken_order_p
1043
1044 INTEGER :: bc, n, output_unit, psolver
1045 REAL(kind=dp) :: ddapc_order_p, implicit_ps_ehartree, &
1046 s2_order_p
1047 TYPE(cp_logger_type), POINTER :: logger
1048 TYPE(pw_env_type), POINTER :: pw_env
1049
1050 logger => cp_get_default_logger()
1051
1052 NULLIFY (pw_env)
1053 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env)
1054 psolver = pw_env%poisson_env%parameters%solver
1055
1056 output_unit = cp_print_key_unit_nr(logger, input, "DFT%SCF%PRINT%DETAILED_ENERGY", &
1057 extension=".scfLog")
1058 IF (output_unit > 0) THEN
1059 IF (dft_control%do_admm) THEN
1060 WRITE (unit=output_unit, fmt="((T3,A,T60,F20.10))") &
1061 "Wfn fit exchange-correlation energy: ", energy%exc_aux_fit
1062 IF (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc) THEN
1063 WRITE (unit=output_unit, fmt="((T3,A,T60,F20.10))") &
1064 "Wfn fit soft/hard atomic rho1 Exc contribution: ", energy%exc1_aux_fit
1065 END IF
1066 END IF
1067 IF (dft_control%do_admm) THEN
1068 IF (psolver == pw_poisson_implicit) THEN
1069 implicit_ps_ehartree = pw_env%poisson_env%implicit_env%ehartree
1070 bc = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
1071 SELECT CASE (bc)
1073 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1074 "Core Hamiltonian energy: ", energy%core, &
1075 "Hartree energy: ", implicit_ps_ehartree, &
1076 "Electric enthalpy: ", energy%hartree, &
1077 "Exchange-correlation energy: ", energy%exc + energy%exc_aux_fit
1078 CASE (periodic_bc, neumann_bc)
1079 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1080 "Core Hamiltonian energy: ", energy%core, &
1081 "Hartree energy: ", energy%hartree, &
1082 "Exchange-correlation energy: ", energy%exc + energy%exc_aux_fit
1083 END SELECT
1084 ELSE
1085 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1086 "Core Hamiltonian energy: ", energy%core, &
1087 "Hartree energy: ", energy%hartree, &
1088 "Exchange-correlation energy: ", energy%exc + energy%exc_aux_fit
1089 END IF
1090 ELSE
1091 !ZMP to print some variables at each step
1092 IF (dft_control%apply_external_density) THEN
1093 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1094 "DOING ZMP CALCULATION FROM EXTERNAL DENSITY "
1095 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1096 "Core Hamiltonian energy: ", energy%core, &
1097 "Hartree energy: ", energy%hartree
1098 ELSE IF (dft_control%apply_external_vxc) THEN
1099 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1100 "DOING ZMP READING EXTERNAL VXC "
1101 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1102 "Core Hamiltonian energy: ", energy%core, &
1103 "Hartree energy: ", energy%hartree
1104 ELSE
1105 IF (psolver == pw_poisson_implicit) THEN
1106 implicit_ps_ehartree = pw_env%poisson_env%implicit_env%ehartree
1107 bc = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
1108 SELECT CASE (bc)
1110 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1111 "Core Hamiltonian energy: ", energy%core, &
1112 "Hartree energy: ", implicit_ps_ehartree, &
1113 "Electric enthalpy: ", energy%hartree, &
1114 "Exchange-correlation energy: ", energy%exc
1115 CASE (periodic_bc, neumann_bc)
1116 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1117 "Core Hamiltonian energy: ", energy%core, &
1118 "Hartree energy: ", energy%hartree, &
1119 "Exchange-correlation energy: ", energy%exc
1120 END SELECT
1121 ELSE
1122 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1123 "Core Hamiltonian energy: ", energy%core, &
1124 "Hartree energy: ", energy%hartree, &
1125 "Exchange-correlation energy: ", energy%exc
1126 END IF
1127 END IF
1128 END IF
1129
1130 IF (dft_control%apply_external_density) THEN
1131 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1132 "Integral of the (density * v_xc): ", energy%exc
1133 END IF
1134
1135 IF (energy%e_hartree /= 0.0_dp) THEN
1136 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1137 "Coulomb (electron-electron) energy: ", energy%e_hartree
1138 END IF
1139 IF (energy%dispersion /= 0.0_dp) THEN
1140 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1141 "Dispersion energy: ", energy%dispersion
1142 END IF
1143 IF (energy%efield /= 0.0_dp) THEN
1144 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1145 "Electric field interaction energy: ", energy%efield
1146 END IF
1147 IF (energy%gcp /= 0.0_dp) THEN
1148 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1149 "gCP energy: ", energy%gcp
1150 END IF
1151 IF (dft_control%qs_control%gapw) THEN
1152 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1153 "GAPW| Exc from hard and soft atomic rho1: ", energy%exc1 + energy%exc1_aux_fit, &
1154 "GAPW| local Eh = 1 center integrals: ", energy%hartree_1c
1155 END IF
1156 IF (dft_control%qs_control%gapw_xc) THEN
1157 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1158 "GAPW| Exc from hard and soft atomic rho1: ", energy%exc1 + energy%exc1_aux_fit
1159 END IF
1160 IF (dft_control%dft_plus_u) THEN
1161 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1162 "DFT+U energy:", energy%dft_plus_u
1163 END IF
1164 IF (qs_env%qmmm) THEN
1165 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1166 "QM/MM Electrostatic energy: ", energy%qmmm_el
1167 IF (qs_env%qmmm_env_qm%image_charge) THEN
1168 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1169 "QM/MM image charge energy: ", energy%image_charge
1170 END IF
1171 END IF
1172 IF (dft_control%qs_control%mulliken_restraint) THEN
1173 WRITE (unit=output_unit, fmt="(T3,A,T41,2F20.10)") &
1174 "Mulliken restraint (order_p,energy) : ", mulliken_order_p, energy%mulliken
1175 END IF
1176 IF (dft_control%qs_control%ddapc_restraint) THEN
1177 DO n = 1, SIZE(dft_control%qs_control%ddapc_restraint_control)
1178 ddapc_order_p = &
1179 dft_control%qs_control%ddapc_restraint_control(n)%ddapc_order_p
1180 WRITE (unit=output_unit, fmt="(T3,A,T41,2F20.10)") &
1181 "DDAPC restraint (order_p,energy) : ", ddapc_order_p, energy%ddapc_restraint(n)
1182 END DO
1183 END IF
1184 IF (dft_control%qs_control%s2_restraint) THEN
1185 s2_order_p = dft_control%qs_control%s2_restraint_control%s2_order_p
1186 WRITE (unit=output_unit, fmt="(T3,A,T41,2F20.10)") &
1187 "S2 restraint (order_p,energy) : ", s2_order_p, energy%s2_restraint
1188 END IF
1189 IF (energy%core_cneo /= 0.0_dp) THEN
1190 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1191 "CNEO| quantum nuclear core energy: ", energy%core_cneo
1192 END IF
1193
1194 END IF ! output_unit
1195 CALL cp_print_key_finished_output(output_unit, logger, input, &
1196 "DFT%SCF%PRINT%DETAILED_ENERGY")
1197
1198 END SUBROUTINE print_detailed_energy
1199
1200! **************************************************************************************************
1201!> \brief compute matrix_vxc, defined via the potential created by qs_vxc_create
1202!> ignores things like tau functional, gapw, sic, ...
1203!> so only OK for GGA & GPW right now
1204!> \param qs_env ...
1205!> \param v_rspace ...
1206!> \param matrix_vxc ...
1207!> \par History
1208!> created 23.10.2012 [Joost VandeVondele]
1209!> \author
1210! **************************************************************************************************
1211 SUBROUTINE compute_matrix_vxc(qs_env, v_rspace, matrix_vxc)
1212 TYPE(qs_environment_type), POINTER :: qs_env
1213 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(IN) :: v_rspace
1214 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_vxc
1215
1216 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_matrix_vxc'
1217
1218 INTEGER :: handle, ispin
1219 LOGICAL :: gapw
1220 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks
1221 TYPE(dft_control_type), POINTER :: dft_control
1222
1223 CALL timeset(routinen, handle)
1224
1225 ! create the matrix using matrix_ks as a template
1226 IF (ASSOCIATED(matrix_vxc)) THEN
1227 CALL dbcsr_deallocate_matrix_set(matrix_vxc)
1228 END IF
1229 CALL get_qs_env(qs_env, matrix_ks=matrix_ks)
1230 ALLOCATE (matrix_vxc(SIZE(matrix_ks)))
1231 DO ispin = 1, SIZE(matrix_ks)
1232 NULLIFY (matrix_vxc(ispin)%matrix)
1233 CALL dbcsr_init_p(matrix_vxc(ispin)%matrix)
1234 CALL dbcsr_copy(matrix_vxc(ispin)%matrix, matrix_ks(ispin)%matrix, &
1235 name="Matrix VXC of spin "//cp_to_string(ispin))
1236 CALL dbcsr_set(matrix_vxc(ispin)%matrix, 0.0_dp)
1237 END DO
1238
1239 ! and integrate
1240 CALL get_qs_env(qs_env, dft_control=dft_control)
1241 gapw = dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc
1242 DO ispin = 1, SIZE(matrix_ks)
1243 CALL integrate_v_rspace(v_rspace=v_rspace(ispin), &
1244 hmat=matrix_vxc(ispin), &
1245 qs_env=qs_env, &
1246 calculate_forces=.false., &
1247 gapw=gapw)
1248 ! scale by the volume element... should really become part of integrate_v_rspace
1249 CALL dbcsr_scale(matrix_vxc(ispin)%matrix, v_rspace(ispin)%pw_grid%dvol)
1250 END DO
1251
1252 CALL timestop(handle)
1253
1254 END SUBROUTINE compute_matrix_vxc
1255
1256! **************************************************************************************************
1257!> \brief Build the XC potential matrix for k-point/image-resolved KS matrices.
1258!> \param qs_env Quickstep environment
1259!> \param v_rspace XC potential on the real-space grid
1260!> \param matrix_vxc_kp k-point/image-resolved XC potential matrix
1261!> \author
1262! **************************************************************************************************
1263 SUBROUTINE compute_matrix_vxc_kp(qs_env, v_rspace, matrix_vxc_kp)
1264 TYPE(qs_environment_type), POINTER :: qs_env
1265 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(IN) :: v_rspace
1266 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_vxc_kp
1267
1268 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_matrix_vxc_kp'
1269
1270 INTEGER :: handle, img, ispin
1271 LOGICAL :: gapw
1272 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ksmat
1273 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_ks_kp
1274 TYPE(dft_control_type), POINTER :: dft_control
1275
1276 CALL timeset(routinen, handle)
1277
1278 ! create the matrix using matrix_ks as a template
1279 IF (ASSOCIATED(matrix_vxc_kp)) THEN
1280 CALL dbcsr_deallocate_matrix_set(matrix_vxc_kp)
1281 END IF
1282 CALL get_qs_env(qs_env, dft_control=dft_control, matrix_ks_kp=matrix_ks_kp)
1283 ALLOCATE (matrix_vxc_kp(SIZE(matrix_ks_kp, 1), SIZE(matrix_ks_kp, 2)))
1284 DO img = 1, SIZE(matrix_ks_kp, 2)
1285 DO ispin = 1, SIZE(matrix_ks_kp, 1)
1286 NULLIFY (matrix_vxc_kp(ispin, img)%matrix)
1287 CALL dbcsr_init_p(matrix_vxc_kp(ispin, img)%matrix)
1288 CALL dbcsr_copy(matrix_vxc_kp(ispin, img)%matrix, matrix_ks_kp(ispin, img)%matrix, &
1289 name="Matrix VXC of spin "//cp_to_string(ispin)//" image "//cp_to_string(img))
1290 CALL dbcsr_set(matrix_vxc_kp(ispin, img)%matrix, 0.0_dp)
1291 END DO
1292 END DO
1293
1294 ! and integrate
1295 gapw = dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc
1296 DO ispin = 1, SIZE(matrix_ks_kp, 1)
1297 ksmat => matrix_vxc_kp(ispin, :)
1298 CALL integrate_v_rspace(v_rspace=v_rspace(ispin), &
1299 hmat_kp=ksmat, &
1300 qs_env=qs_env, &
1301 calculate_forces=.false., &
1302 gapw=gapw)
1303 ! scale by the volume element... should really become part of integrate_v_rspace
1304 DO img = 1, SIZE(matrix_ks_kp, 2)
1305 CALL dbcsr_scale(matrix_vxc_kp(ispin, img)%matrix, v_rspace(ispin)%pw_grid%dvol)
1306 END DO
1307 END DO
1308
1309 CALL timestop(handle)
1310
1311 END SUBROUTINE compute_matrix_vxc_kp
1312
1313! **************************************************************************************************
1314!> \brief Sum up all potentials defined on the grid and integrate
1315!>
1316!> \param qs_env ...
1317!> \param ks_matrix ...
1318!> \param rho ...
1319!> \param my_rho ...
1320!> \param vppl_rspace ...
1321!> \param v_rspace_new ...
1322!> \param v_rspace_new_aux_fit ...
1323!> \param v_tau_rspace ...
1324!> \param v_tau_rspace_aux_fit ...
1325!> \param v_sic_rspace ...
1326!> \param v_spin_ddapc_rest_r ...
1327!> \param v_sccs_rspace ...
1328!> \param v_rspace_embed ...
1329!> \param cdft_control ...
1330!> \param calculate_forces ...
1331!> \par History
1332!> - refactoring 04.03.2011 [MI]
1333!> - SCCS implementation (16.10.2013,MK)
1334!> \author
1335! **************************************************************************************************
1336 SUBROUTINE sum_up_and_integrate(qs_env, ks_matrix, rho, my_rho, &
1337 vppl_rspace, v_rspace_new, &
1338 v_rspace_new_aux_fit, v_tau_rspace, &
1339 v_tau_rspace_aux_fit, &
1340 v_sic_rspace, v_spin_ddapc_rest_r, &
1341 v_sccs_rspace, v_rspace_embed, cdft_control, &
1342 calculate_forces)
1343
1344 TYPE(qs_environment_type), POINTER :: qs_env
1345 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ks_matrix
1346 TYPE(qs_rho_type), POINTER :: rho
1347 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: my_rho
1348 TYPE(pw_r3d_rs_type), POINTER :: vppl_rspace
1349 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_rspace_new, v_rspace_new_aux_fit, &
1350 v_tau_rspace, v_tau_rspace_aux_fit
1351 TYPE(pw_r3d_rs_type), POINTER :: v_sic_rspace, v_spin_ddapc_rest_r, &
1352 v_sccs_rspace
1353 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_rspace_embed
1354 TYPE(cdft_control_type), POINTER :: cdft_control
1355 LOGICAL, INTENT(in) :: calculate_forces
1356
1357 CHARACTER(LEN=*), PARAMETER :: routinen = 'sum_up_and_integrate'
1358
1359 CHARACTER(LEN=default_string_length) :: basis_type
1360 INTEGER :: handle, igroup, ikind, img, ispin, &
1361 nkind, nspins
1362 INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index
1363 LOGICAL :: do_ppl, gapw, gapw_xc, lrigpw, rigpw, &
1364 use_work_v_rspace
1365 REAL(kind=dp) :: csign, dvol, fadm
1366 TYPE(admm_type), POINTER :: admm_env
1367 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1368 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ksmat, rho_ao, rho_ao_nokp, smat
1369 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_ks_aux_fit, &
1370 matrix_ks_aux_fit_dft, rho_ao_aux, &
1371 rho_ao_kp
1372 TYPE(dft_control_type), POINTER :: dft_control
1373 TYPE(kpoint_type), POINTER :: kpoints
1374 TYPE(lri_density_type), POINTER :: lri_density
1375 TYPE(lri_environment_type), POINTER :: lri_env
1376 TYPE(lri_kind_type), DIMENSION(:), POINTER :: lri_v_int
1377 TYPE(mp_para_env_type), POINTER :: para_env
1378 TYPE(pw_env_type), POINTER :: pw_env
1379 TYPE(pw_poisson_type), POINTER :: poisson_env
1380 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1381 TYPE(pw_r3d_rs_type), POINTER :: v_rspace, v_rspace_used, vee
1382 TYPE(pw_r3d_rs_type), TARGET :: v_rspace_work
1383 TYPE(qs_ks_env_type), POINTER :: ks_env
1384 TYPE(qs_rho_type), POINTER :: rho_aux_fit
1385 TYPE(task_list_type), POINTER :: task_list
1386
1387 CALL timeset(routinen, handle)
1388
1389 NULLIFY (auxbas_pw_pool, dft_control, pw_env, matrix_ks_aux_fit, &
1390 v_rspace, rho_aux_fit, vee, rho_ao, rho_ao_kp, rho_ao_aux, &
1391 ksmat, matrix_ks_aux_fit_dft, lri_env, lri_density, atomic_kind_set, &
1392 rho_ao_nokp, ks_env, admm_env, task_list, v_rspace_used)
1393
1394 CALL get_qs_env(qs_env, &
1395 dft_control=dft_control, &
1396 pw_env=pw_env, &
1397 v_hartree_rspace=v_rspace, &
1398 vee=vee)
1399
1400 CALL qs_rho_get(rho, rho_ao_kp=rho_ao_kp)
1401 CALL pw_env_get(pw_env, poisson_env=poisson_env, auxbas_pw_pool=auxbas_pw_pool)
1402 gapw = dft_control%qs_control%gapw
1403 gapw_xc = dft_control%qs_control%gapw_xc
1404 do_ppl = dft_control%qs_control%do_ppl_method == do_ppl_grid
1405
1406 rigpw = dft_control%qs_control%rigpw
1407 lrigpw = dft_control%qs_control%lrigpw
1408 IF (lrigpw .OR. rigpw) THEN
1409 CALL get_qs_env(qs_env, &
1410 lri_env=lri_env, &
1411 lri_density=lri_density, &
1412 atomic_kind_set=atomic_kind_set)
1413 END IF
1414
1415 nspins = dft_control%nspins
1416
1417 ! sum up potentials and integrate
1418 IF (ASSOCIATED(v_rspace_new)) THEN
1419 DO ispin = 1, nspins
1420 IF (gapw_xc) THEN
1421 ! SIC not implemented (or at least not tested)
1422 cpassert(dft_control%sic_method_id == sic_none)
1423 !Only the xc potential, because it has to be integrated with the soft basis
1424 CALL pw_scale(v_rspace_new(ispin), v_rspace_new(ispin)%pw_grid%dvol)
1425
1426 ! add the xc part due to v_rspace soft
1427 rho_ao => rho_ao_kp(ispin, :)
1428 ksmat => ks_matrix(ispin, :)
1429 CALL integrate_v_rspace(v_rspace=v_rspace_new(ispin), &
1430 pmat_kp=rho_ao, hmat_kp=ksmat, &
1431 qs_env=qs_env, &
1432 calculate_forces=calculate_forces, &
1433 gapw=gapw_xc)
1434
1435 ! Now the Hartree potential to be integrated with the full basis
1436 CALL pw_copy(v_rspace, v_rspace_new(ispin))
1437 ELSE
1438 ! Add v_hartree + v_xc = v_rspace_new
1439 CALL pw_axpy(v_rspace, v_rspace_new(ispin), 1.0_dp, v_rspace_new(ispin)%pw_grid%dvol)
1440 END IF ! gapw_xc
1441 IF (dft_control%qs_control%ddapc_explicit_potential) THEN
1442 IF (dft_control%qs_control%ddapc_restraint_is_spin) THEN
1443 IF (ispin == 1) THEN
1444 CALL pw_axpy(v_spin_ddapc_rest_r, v_rspace_new(ispin), 1.0_dp)
1445 ELSE
1446 CALL pw_axpy(v_spin_ddapc_rest_r, v_rspace_new(ispin), -1.0_dp)
1447 END IF
1448 ELSE
1449 CALL pw_axpy(v_spin_ddapc_rest_r, v_rspace_new(ispin), 1.0_dp)
1450 END IF
1451 END IF
1452 ! CDFT constraint contribution
1453 IF (dft_control%qs_control%cdft) THEN
1454 DO igroup = 1, SIZE(cdft_control%group)
1455 SELECT CASE (cdft_control%group(igroup)%constraint_type)
1457 csign = 1.0_dp
1459 IF (ispin == 1) THEN
1460 csign = 1.0_dp
1461 ELSE
1462 csign = -1.0_dp
1463 END IF
1465 csign = 1.0_dp
1466 IF (ispin == 2) cycle
1468 csign = 1.0_dp
1469 IF (ispin == 1) cycle
1470 CASE DEFAULT
1471 cpabort("Unknown constraint type.")
1472 END SELECT
1473 CALL pw_axpy(cdft_control%group(igroup)%weight, v_rspace_new(ispin), &
1474 csign*cdft_control%strength(igroup))
1475 END DO
1476 END IF
1477 ! functional derivative of the Hartree energy wrt the density in the presence of dielectric
1478 ! (vhartree + v_eps); v_eps is nonzero only if the dielectric constant is defind as a function
1479 ! of the charge density
1480 IF (poisson_env%parameters%solver == pw_poisson_implicit) THEN
1481 dvol = poisson_env%implicit_env%v_eps%pw_grid%dvol
1482 CALL pw_axpy(poisson_env%implicit_env%v_eps, v_rspace_new(ispin), dvol)
1483 END IF
1484 ! Add SCCS contribution
1485 IF (dft_control%do_sccs) THEN
1486 CALL pw_axpy(v_sccs_rspace, v_rspace_new(ispin))
1487 END IF
1488 ! External electrostatic potential
1489 IF (dft_control%apply_external_potential) THEN
1490 CALL qmmm_modify_hartree_pot(v_hartree=v_rspace_new(ispin), &
1491 v_qmmm=vee, scale=-1.0_dp)
1492 END IF
1493 IF (do_ppl) THEN
1494 cpassert(.NOT. gapw)
1495 CALL pw_axpy(vppl_rspace, v_rspace_new(ispin), vppl_rspace%pw_grid%dvol)
1496 END IF
1497 ! the electrostatic sic contribution
1498 SELECT CASE (dft_control%sic_method_id)
1499 CASE (sic_none)
1500 !
1502 IF (ispin == 1) THEN
1503 CALL pw_axpy(v_sic_rspace, v_rspace_new(ispin), -1.0_dp)
1504 ELSE
1505 CALL pw_axpy(v_sic_rspace, v_rspace_new(ispin), 1.0_dp)
1506 END IF
1507 CASE (sic_ad)
1508 CALL pw_axpy(v_sic_rspace, v_rspace_new(ispin), -1.0_dp)
1509 CASE (sic_eo)
1510 ! NOTHING TO BE DONE
1511 END SELECT
1512 ! DFT embedding
1513 IF (dft_control%apply_embed_pot) THEN
1514 CALL pw_axpy(v_rspace_embed(ispin), v_rspace_new(ispin), v_rspace_embed(ispin)%pw_grid%dvol)
1515 CALL auxbas_pw_pool%give_back_pw(v_rspace_embed(ispin))
1516 END IF
1517 IF (lrigpw) THEN
1518 lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds
1519 CALL get_qs_env(qs_env, nkind=nkind, para_env=para_env)
1520 DO ikind = 1, nkind
1521 lri_v_int(ikind)%v_int = 0.0_dp
1522 END DO
1523 CALL integrate_v_rspace_one_center(v_rspace_new(ispin), qs_env, &
1524 lri_v_int, calculate_forces, "LRI_AUX")
1525 DO ikind = 1, nkind
1526 CALL para_env%sum(lri_v_int(ikind)%v_int)
1527 END DO
1528 IF (lri_env%exact_1c_terms) THEN
1529 rho_ao => my_rho(ispin, :)
1530 ksmat => ks_matrix(ispin, :)
1531 CALL integrate_v_rspace_diagonal(v_rspace_new(ispin), ksmat(1)%matrix, &
1532 rho_ao(1)%matrix, qs_env, &
1533 calculate_forces, "ORB")
1534 END IF
1535 IF (lri_env%ppl_ri) THEN
1536 CALL v_int_ppl_update(qs_env, lri_v_int, calculate_forces)
1537 END IF
1538 ELSE IF (rigpw) THEN
1539 lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds
1540 CALL get_qs_env(qs_env, nkind=nkind, para_env=para_env)
1541 DO ikind = 1, nkind
1542 lri_v_int(ikind)%v_int = 0.0_dp
1543 END DO
1544 CALL integrate_v_rspace_one_center(v_rspace_new(ispin), qs_env, &
1545 lri_v_int, calculate_forces, "RI_HXC")
1546 DO ikind = 1, nkind
1547 CALL para_env%sum(lri_v_int(ikind)%v_int)
1548 END DO
1549 ELSE
1550 rho_ao => my_rho(ispin, :)
1551 ksmat => ks_matrix(ispin, :)
1552 CALL integrate_v_rspace(v_rspace=v_rspace_new(ispin), &
1553 pmat_kp=rho_ao, hmat_kp=ksmat, &
1554 qs_env=qs_env, &
1555 calculate_forces=calculate_forces, &
1556 gapw=gapw)
1557 END IF
1558 CALL auxbas_pw_pool%give_back_pw(v_rspace_new(ispin))
1559 END DO ! ispin
1560
1561 SELECT CASE (dft_control%sic_method_id)
1562 CASE (sic_none)
1564 CALL auxbas_pw_pool%give_back_pw(v_sic_rspace)
1565 DEALLOCATE (v_sic_rspace)
1566 END SELECT
1567 DEALLOCATE (v_rspace_new)
1568
1569 ELSE
1570 ! not implemented (or at least not tested)
1571 cpassert(dft_control%sic_method_id == sic_none)
1572 cpassert(.NOT. dft_control%qs_control%ddapc_restraint_is_spin)
1573 DO ispin = 1, nspins
1574 use_work_v_rspace = dft_control%qs_control%cdft
1575 IF (use_work_v_rspace) THEN
1576 CALL auxbas_pw_pool%create_pw(v_rspace_work)
1577 CALL pw_copy(v_rspace, v_rspace_work)
1578 v_rspace_used => v_rspace_work
1579 ELSE
1580 v_rspace_used => v_rspace
1581 END IF
1582 ! CDFT constraint contribution
1583 IF (dft_control%qs_control%cdft) THEN
1584 DO igroup = 1, SIZE(cdft_control%group)
1585 SELECT CASE (cdft_control%group(igroup)%constraint_type)
1587 csign = 1.0_dp
1589 IF (ispin == 1) THEN
1590 csign = 1.0_dp
1591 ELSE
1592 csign = -1.0_dp
1593 END IF
1595 csign = 1.0_dp
1596 IF (ispin == 2) cycle
1598 csign = 1.0_dp
1599 IF (ispin == 1) cycle
1600 CASE DEFAULT
1601 cpabort("Unknown constraint type.")
1602 END SELECT
1603 CALL pw_axpy(cdft_control%group(igroup)%weight, v_rspace_used, &
1604 csign*cdft_control%strength(igroup))
1605 END DO
1606 END IF
1607 ! extra contribution attributed to the dependency of the dielectric constant to the charge density
1608 IF (poisson_env%parameters%solver == pw_poisson_implicit) THEN
1609 dvol = poisson_env%implicit_env%v_eps%pw_grid%dvol
1610 CALL pw_axpy(poisson_env%implicit_env%v_eps, v_rspace_used, dvol)
1611 END IF
1612 ! Add SCCS contribution
1613 IF (dft_control%do_sccs) THEN
1614 CALL pw_axpy(v_sccs_rspace, v_rspace_used)
1615 END IF
1616 ! DFT embedding
1617 IF (dft_control%apply_embed_pot) THEN
1618 CALL pw_axpy(v_rspace_embed(ispin), v_rspace_used, v_rspace_embed(ispin)%pw_grid%dvol)
1619 CALL auxbas_pw_pool%give_back_pw(v_rspace_embed(ispin))
1620 END IF
1621 IF (lrigpw) THEN
1622 lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds
1623 CALL get_qs_env(qs_env, nkind=nkind, para_env=para_env)
1624 DO ikind = 1, nkind
1625 lri_v_int(ikind)%v_int = 0.0_dp
1626 END DO
1627 CALL integrate_v_rspace_one_center(v_rspace_used, qs_env, &
1628 lri_v_int, calculate_forces, "LRI_AUX")
1629 DO ikind = 1, nkind
1630 CALL para_env%sum(lri_v_int(ikind)%v_int)
1631 END DO
1632 IF (lri_env%exact_1c_terms) THEN
1633 rho_ao => my_rho(ispin, :)
1634 ksmat => ks_matrix(ispin, :)
1635 CALL integrate_v_rspace_diagonal(v_rspace_used, ksmat(1)%matrix, &
1636 rho_ao(1)%matrix, qs_env, &
1637 calculate_forces, "ORB")
1638 END IF
1639 IF (lri_env%ppl_ri) THEN
1640 CALL v_int_ppl_update(qs_env, lri_v_int, calculate_forces)
1641 END IF
1642 ELSE IF (rigpw) THEN
1643 lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds
1644 CALL get_qs_env(qs_env, nkind=nkind, para_env=para_env)
1645 DO ikind = 1, nkind
1646 lri_v_int(ikind)%v_int = 0.0_dp
1647 END DO
1648 CALL integrate_v_rspace_one_center(v_rspace_used, qs_env, &
1649 lri_v_int, calculate_forces, "RI_HXC")
1650 DO ikind = 1, nkind
1651 CALL para_env%sum(lri_v_int(ikind)%v_int)
1652 END DO
1653 ELSE
1654 rho_ao => my_rho(ispin, :)
1655 ksmat => ks_matrix(ispin, :)
1656 CALL integrate_v_rspace(v_rspace=v_rspace_used, &
1657 pmat_kp=rho_ao, &
1658 hmat_kp=ksmat, &
1659 qs_env=qs_env, &
1660 calculate_forces=calculate_forces, &
1661 gapw=gapw)
1662 END IF
1663 IF (use_work_v_rspace) CALL auxbas_pw_pool%give_back_pw(v_rspace_work)
1664 END DO
1665 END IF ! ASSOCIATED(v_rspace_new)
1666
1667 ! **** LRIGPW: KS matrix from integrated potential
1668 IF (lrigpw) THEN
1669 CALL get_qs_env(qs_env, ks_env=ks_env)
1670 CALL get_ks_env(ks_env=ks_env, kpoints=kpoints)
1671 CALL get_kpoint_info(kpoint=kpoints, cell_to_index=cell_to_index)
1672 DO ispin = 1, nspins
1673 ksmat => ks_matrix(ispin, :)
1674 CALL calculate_lri_ks_matrix(lri_env, lri_v_int, ksmat, atomic_kind_set, &
1675 cell_to_index=cell_to_index)
1676 END DO
1677 IF (calculate_forces) THEN
1678 CALL calculate_lri_forces(lri_env, lri_density, qs_env, rho_ao_kp, atomic_kind_set)
1679 END IF
1680 ELSE IF (rigpw) THEN
1681 CALL get_qs_env(qs_env, matrix_s=smat)
1682 DO ispin = 1, nspins
1683 CALL calculate_ri_ks_matrix(lri_env, lri_v_int, ks_matrix(ispin, 1)%matrix, &
1684 smat(1)%matrix, atomic_kind_set, ispin)
1685 END DO
1686 IF (calculate_forces) THEN
1687 rho_ao_nokp => rho_ao_kp(:, 1)
1688 CALL calculate_ri_forces(lri_env, lri_density, qs_env, rho_ao_nokp, atomic_kind_set)
1689 END IF
1690 END IF
1691
1692 IF (ASSOCIATED(v_tau_rspace)) THEN
1693 IF (lrigpw .OR. rigpw) THEN
1694 cpabort("LRIGPW/RIGPW not implemented for meta-GGAs")
1695 END IF
1696 DO ispin = 1, nspins
1697 CALL pw_scale(v_tau_rspace(ispin), v_tau_rspace(ispin)%pw_grid%dvol)
1698
1699 rho_ao => rho_ao_kp(ispin, :)
1700 ksmat => ks_matrix(ispin, :)
1701 CALL integrate_v_rspace(v_rspace=v_tau_rspace(ispin), &
1702 pmat_kp=rho_ao, hmat_kp=ksmat, &
1703 qs_env=qs_env, &
1704 calculate_forces=calculate_forces, compute_tau=.true., &
1705 gapw=gapw)
1706 CALL auxbas_pw_pool%give_back_pw(v_tau_rspace(ispin))
1707 END DO
1708 DEALLOCATE (v_tau_rspace)
1709 END IF
1710
1711 ! Add contributions from ADMM if requested
1712 IF (dft_control%do_admm) THEN
1713 CALL get_qs_env(qs_env, admm_env=admm_env)
1714 CALL get_admm_env(admm_env, matrix_ks_aux_fit_kp=matrix_ks_aux_fit, rho_aux_fit=rho_aux_fit, &
1715 matrix_ks_aux_fit_dft_kp=matrix_ks_aux_fit_dft)
1716 CALL qs_rho_get(rho_aux_fit, rho_ao_kp=rho_ao_aux)
1717 IF (ASSOCIATED(v_rspace_new_aux_fit)) THEN
1718 DO ispin = 1, nspins
1719 ! Calculate the xc potential
1720 CALL pw_scale(v_rspace_new_aux_fit(ispin), v_rspace_new_aux_fit(ispin)%pw_grid%dvol)
1721
1722 ! set matrix_ks_aux_fit_dft = matrix_ks_aux_fit(k_HF)
1723 DO img = 1, dft_control%nimages
1724 CALL dbcsr_copy(matrix_ks_aux_fit_dft(ispin, img)%matrix, matrix_ks_aux_fit(ispin, img)%matrix, &
1725 name="DFT exch. part of matrix_ks_aux_fit")
1726 END DO
1727
1728 ! Add potential to ks_matrix aux_fit, skip integration if no DFT correction
1729
1730 IF (admm_env%aux_exch_func /= do_admm_aux_exch_func_none) THEN
1731
1732 !GPW by default. IF GAPW, then take relevant task list and basis
1733 CALL get_admm_env(admm_env, task_list_aux_fit=task_list)
1734 basis_type = "AUX_FIT"
1735 IF (admm_env%do_gapw) THEN
1736 task_list => admm_env%admm_gapw_env%task_list
1737 basis_type = "AUX_FIT_SOFT"
1738 END IF
1739 fadm = 1.0_dp
1740 ! Calculate bare scaling of force according to Merlot, 1. IF: ADMMP, 2. IF: ADMMS,
1741 IF (admm_env%do_admmp) THEN
1742 fadm = admm_env%gsi(ispin)**2
1743 ELSE IF (admm_env%do_admms) THEN
1744 fadm = (admm_env%gsi(ispin))**(2.0_dp/3.0_dp)
1745 END IF
1746
1747 rho_ao => rho_ao_aux(ispin, :)
1748 ksmat => matrix_ks_aux_fit(ispin, :)
1749
1750 CALL integrate_v_rspace(v_rspace=v_rspace_new_aux_fit(ispin), &
1751 pmat_kp=rho_ao, &
1752 hmat_kp=ksmat, &
1753 qs_env=qs_env, &
1754 calculate_forces=calculate_forces, &
1755 force_adm=fadm, &
1756 gapw=.false., & !even if actual GAPW calculation, want to use AUX_FIT_SOFT
1757 basis_type=basis_type, &
1758 task_list_external=task_list)
1759 END IF
1760
1761 ! matrix_ks_aux_fit_dft(x_DFT)=matrix_ks_aux_fit_dft(old,k_HF)-matrix_ks_aux_fit(k_HF-x_DFT)
1762 DO img = 1, dft_control%nimages
1763 CALL dbcsr_add(matrix_ks_aux_fit_dft(ispin, img)%matrix, &
1764 matrix_ks_aux_fit(ispin, img)%matrix, 1.0_dp, -1.0_dp)
1765 END DO
1766
1767 CALL auxbas_pw_pool%give_back_pw(v_rspace_new_aux_fit(ispin))
1768 END DO
1769 DEALLOCATE (v_rspace_new_aux_fit)
1770 END IF
1771 ! Clean up v_tau_rspace_aux_fit, which is actually not needed
1772 IF (ASSOCIATED(v_tau_rspace_aux_fit)) THEN
1773 DO ispin = 1, nspins
1774 CALL auxbas_pw_pool%give_back_pw(v_tau_rspace_aux_fit(ispin))
1775 END DO
1776 DEALLOCATE (v_tau_rspace_aux_fit)
1777 END IF
1778 END IF
1779
1780 IF (dft_control%apply_embed_pot) DEALLOCATE (v_rspace_embed)
1781
1782 CALL timestop(handle)
1783
1784 END SUBROUTINE sum_up_and_integrate
1785
1786!**************************************************************************
1787!> \brief Calculate the ZMP potential and energy as in Zhao, Morrison Parr
1788!> PRA 50i, 2138 (1994)
1789!> V_c^\lambda defined as int_rho-rho_0/r-r' or rho-rho_0 times a Lagrange
1790!> multiplier, plus Fermi-Amaldi potential that should give the V_xc in the
1791!> limit \lambda --> \infty
1792!>
1793!> \param qs_env ...
1794!> \param v_rspace_new ...
1795!> \param rho ...
1796!> \param exc ...
1797!> \author D. Varsano [daniele.varsano@nano.cnr.it]
1798! **************************************************************************************************
1799 SUBROUTINE calculate_zmp_potential(qs_env, v_rspace_new, rho, exc)
1800
1801 TYPE(qs_environment_type), POINTER :: qs_env
1802 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_rspace_new
1803 TYPE(qs_rho_type), POINTER :: rho
1804 REAL(kind=dp) :: exc
1805
1806 CHARACTER(*), PARAMETER :: routinen = 'calculate_zmp_potential'
1807
1808 INTEGER :: handle, my_val, nelectron, nspins
1809 INTEGER, DIMENSION(2) :: nelectron_spin
1810 LOGICAL :: do_zmp_read, fermi_amaldi
1811 REAL(kind=dp) :: lambda
1812 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_ext_r
1813 TYPE(dft_control_type), POINTER :: dft_control
1814 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_ext_g, rho_g
1815 TYPE(pw_env_type), POINTER :: pw_env
1816 TYPE(pw_poisson_type), POINTER :: poisson_env
1817 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1818 TYPE(pw_r3d_rs_type) :: v_xc_rspace
1819 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
1820 TYPE(qs_ks_env_type), POINTER :: ks_env
1821 TYPE(section_vals_type), POINTER :: ext_den_section, input
1822
1823!, v_h_gspace, &
1824
1825 CALL timeset(routinen, handle)
1826 NULLIFY (auxbas_pw_pool)
1827 NULLIFY (pw_env)
1828 NULLIFY (poisson_env)
1829 NULLIFY (v_rspace_new)
1830 NULLIFY (dft_control)
1831 NULLIFY (rho_r, rho_g, tot_rho_ext_r, rho_ext_g)
1832 CALL get_qs_env(qs_env=qs_env, &
1833 pw_env=pw_env, &
1834 ks_env=ks_env, &
1835 rho=rho, &
1836 input=input, &
1837 nelectron_spin=nelectron_spin, &
1838 dft_control=dft_control)
1839 CALL pw_env_get(pw_env=pw_env, &
1840 auxbas_pw_pool=auxbas_pw_pool, &
1841 poisson_env=poisson_env)
1842 CALL qs_rho_get(rho, rho_r=rho_r, rho_g=rho_g)
1843 nspins = 1
1844 ALLOCATE (v_rspace_new(nspins))
1845 CALL auxbas_pw_pool%create_pw(pw=v_rspace_new(1))
1846 CALL auxbas_pw_pool%create_pw(pw=v_xc_rspace)
1847
1848 CALL pw_zero(v_rspace_new(1))
1849 do_zmp_read = dft_control%apply_external_vxc
1850 IF (do_zmp_read) THEN
1851 CALL pw_copy(qs_env%external_vxc, v_rspace_new(1))
1852 exc = accurate_dot_product(v_rspace_new(1)%array, rho_r(1)%array)* &
1853 v_rspace_new(1)%pw_grid%dvol
1854 ELSE
1855 block
1856 REAL(kind=dp) :: factor
1857 TYPE(pw_c1d_gs_type) :: rho_eff_gspace, v_xc_gspace
1858 CALL auxbas_pw_pool%create_pw(pw=rho_eff_gspace)
1859 CALL auxbas_pw_pool%create_pw(pw=v_xc_gspace)
1860 CALL pw_zero(rho_eff_gspace)
1861 CALL pw_zero(v_xc_gspace)
1862 CALL pw_zero(v_xc_rspace)
1863 factor = pw_integrate_function(rho_g(1))
1864 CALL qs_rho_get(qs_env%rho_external, &
1865 rho_g=rho_ext_g, &
1866 tot_rho_r=tot_rho_ext_r)
1867 factor = tot_rho_ext_r(1)/factor
1868
1869 CALL pw_axpy(rho_g(1), rho_eff_gspace, alpha=factor)
1870 CALL pw_axpy(rho_ext_g(1), rho_eff_gspace, alpha=-1.0_dp)
1871 ext_den_section => section_vals_get_subs_vals(input, "DFT%EXTERNAL_DENSITY")
1872 CALL section_vals_val_get(ext_den_section, "LAMBDA", r_val=lambda)
1873 CALL section_vals_val_get(ext_den_section, "ZMP_CONSTRAINT", i_val=my_val)
1874 CALL section_vals_val_get(ext_den_section, "FERMI_AMALDI", l_val=fermi_amaldi)
1875
1876 CALL pw_scale(rho_eff_gspace, a=lambda)
1877 nelectron = nelectron_spin(1)
1878 factor = -1.0_dp/nelectron
1879 CALL pw_axpy(rho_g(1), rho_eff_gspace, alpha=factor)
1880
1881 CALL pw_poisson_solve(poisson_env, rho_eff_gspace, vhartree=v_xc_gspace)
1882 CALL pw_transfer(v_xc_gspace, v_rspace_new(1))
1883 CALL pw_copy(v_rspace_new(1), v_xc_rspace)
1884
1885 exc = 0.0_dp
1886 exc = pw_integral_ab(v_rspace_new(1), rho_r(1))
1887
1888!Note that this is not the xc energy but \int(\rho*v_xc)
1889!Vxc---> v_rspace_new
1890!Exc---> energy%exc
1891 CALL auxbas_pw_pool%give_back_pw(rho_eff_gspace)
1892 CALL auxbas_pw_pool%give_back_pw(v_xc_gspace)
1893 END block
1894 END IF
1895
1896 CALL auxbas_pw_pool%give_back_pw(v_xc_rspace)
1897
1898 CALL timestop(handle)
1899
1900 END SUBROUTINE calculate_zmp_potential
1901
1902! **************************************************************************************************
1903!> \brief ...
1904!> \param qs_env ...
1905!> \param rho ...
1906!> \param v_rspace_embed ...
1907!> \param dft_control ...
1908!> \param embed_corr ...
1909!> \param just_energy ...
1910! **************************************************************************************************
1911 SUBROUTINE get_embed_potential_energy(qs_env, rho, v_rspace_embed, dft_control, embed_corr, &
1912 just_energy)
1913 TYPE(qs_environment_type), POINTER :: qs_env
1914 TYPE(qs_rho_type), POINTER :: rho
1915 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_rspace_embed
1916 TYPE(dft_control_type), POINTER :: dft_control
1917 REAL(kind=dp) :: embed_corr
1918 LOGICAL :: just_energy
1919
1920 CHARACTER(*), PARAMETER :: routinen = 'get_embed_potential_energy'
1921
1922 INTEGER :: handle, ispin
1923 REAL(kind=dp) :: embed_corr_local
1924 TYPE(pw_env_type), POINTER :: pw_env
1925 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1926 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
1927
1928 CALL timeset(routinen, handle)
1929
1930 NULLIFY (auxbas_pw_pool)
1931 NULLIFY (pw_env)
1932 NULLIFY (rho_r)
1933 CALL get_qs_env(qs_env=qs_env, &
1934 pw_env=pw_env, &
1935 rho=rho)
1936 CALL pw_env_get(pw_env=pw_env, &
1937 auxbas_pw_pool=auxbas_pw_pool)
1938 CALL qs_rho_get(rho, rho_r=rho_r)
1939 ALLOCATE (v_rspace_embed(dft_control%nspins))
1940
1941 embed_corr = 0.0_dp
1942
1943 DO ispin = 1, dft_control%nspins
1944 CALL auxbas_pw_pool%create_pw(pw=v_rspace_embed(ispin))
1945 CALL pw_zero(v_rspace_embed(ispin))
1946
1947 CALL pw_copy(qs_env%embed_pot, v_rspace_embed(ispin))
1948 embed_corr_local = 0.0_dp
1949
1950 ! Spin embedding potential in open-shell case
1951 IF (dft_control%nspins == 2) THEN
1952 IF (ispin == 1) CALL pw_axpy(qs_env%spin_embed_pot, v_rspace_embed(ispin), 1.0_dp)
1953 IF (ispin == 2) CALL pw_axpy(qs_env%spin_embed_pot, v_rspace_embed(ispin), -1.0_dp)
1954 END IF
1955 ! Integrate the density*potential
1956 embed_corr_local = pw_integral_ab(v_rspace_embed(ispin), rho_r(ispin))
1957
1958 embed_corr = embed_corr + embed_corr_local
1959
1960 END DO
1961
1962 ! If only energy requiested we delete the potential
1963 IF (just_energy) THEN
1964 DO ispin = 1, dft_control%nspins
1965 CALL auxbas_pw_pool%give_back_pw(v_rspace_embed(ispin))
1966 END DO
1967 DEALLOCATE (v_rspace_embed)
1968 END IF
1969
1970 CALL timestop(handle)
1971
1972 END SUBROUTINE get_embed_potential_energy
1973
1974END MODULE qs_ks_utils
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:599
Define the atomic kind types and their sub types.
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_release_p(matrix)
...
subroutine, public dbcsr_scale(matrix, alpha_scalar)
...
subroutine, public dbcsr_deallocate_matrix(matrix)
...
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_multiply(transa, transb, alpha, matrix_a, matrix_b, beta, matrix_c, first_row, last_row, first_column, last_column, first_k, last_k, retain_sparsity, filter_eps, flop)
...
subroutine, public dbcsr_get_info(matrix, nblkrows_total, nblkcols_total, nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, nfullrows_local, nfullcols_local, my_prow, my_pcol, local_rows, local_cols, proc_row_dist, proc_col_dist, row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, distribution, name, matrix_type, group)
...
subroutine, public dbcsr_init_p(matrix)
...
subroutine, public dbcsr_set(matrix, alpha)
...
subroutine, public dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
...
subroutine, public dbcsr_dot(matrix_a, matrix_b, trace)
Computes the dot product of two matrices, also known as the trace of their matrix product.
subroutine, public dbcsr_scale_by_vector(matrix, alpha, side)
Scales the rows/columns of given matrix.
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.
Density Derived atomic point charges from a QM calculation (see Bloechl, J. Chem. Phys....
Definition cp_ddapc.F:15
subroutine, public cp_ddapc_apply_cd(qs_env, rho_tot_gspace, energy, v_hartree_gspace, calculate_forces, itype_of_density)
Routine to couple/decouple periodic images with the Bloechl scheme.
Definition cp_ddapc.F:226
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_set_all(matrix, alpha, beta)
set all elements of a matrix to the same value, and optionally the diagonal to a different one
subroutine, public cp_fm_create(matrix, matrix_struct, name, 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 ...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
integer, parameter, public cp_p_file
integer function, public cp_print_key_should_output(iteration_info, basis_section, print_key_path, used_print_key, first_time)
returns what should be done with the given property if btest(res,cp_p_store) then the property should...
Utilities for hfx and admm methods.
subroutine, public tddft_hfx_matrix(matrix_ks, rho_ao, qs_env, update_energy, recalc_integrals, external_hfx_sections, external_x_data, external_para_env)
Add the hfx contributions to the Hamiltonian.
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....
Types and set/get functions for HFX.
Definition hfx_types.F:16
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public sic_list_unpaired
integer, parameter, public sic_mauri_spz
integer, parameter, public cdft_beta_constraint
integer, parameter, public cdft_magnetization_constraint
integer, parameter, public sic_list_all
integer, parameter, public cdft_charge_constraint
integer, parameter, public sic_eo
integer, parameter, public do_ppl_grid
integer, parameter, public do_admm_aux_exch_func_none
integer, parameter, public sic_mauri_us
integer, parameter, public sic_none
integer, parameter, public cdft_alpha_constraint
integer, parameter, public sic_ad
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_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
sums arrays of real/complex numbers with much reduced round-off as compared to a naive implementation...
Definition kahan_sum.F:29
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
Types and basic routines needed for a kpoint calculation.
subroutine, public get_kpoint_info(kpoint, kp_scheme, nkp_grid, kp_shift, symmetry, verbose, full_grid, use_real_wfn, eps_geo, parallel_group_size, kp_range, nkp, xkp, wkp, para_env, blacs_env_all, para_env_kp, para_env_inter_kp, blacs_env, kp_env, kp_aux_env, mpools, iogrp, nkp_groups, kp_dist, cell_to_index, index_to_cell, sab_nl, sab_nl_nosym, inversion_symmetry_only, symmetry_backend, symmetry_reduction_method, gamma_centered)
Retrieve information from a kpoint environment.
Calculates integral matrices for LRIGPW method lri : local resolution of the identity.
subroutine, public v_int_ppl_update(qs_env, lri_v_int, calculate_forces)
...
contains the types and subroutines for dealing with the lri_env lri : local resolution of the identit...
Calculates forces for LRIGPW method lri : local resolution of the identity.
Definition lri_forces.F:16
subroutine, public calculate_lri_forces(lri_env, lri_density, qs_env, pmatrix, atomic_kind_set)
calculates the lri forces
Definition lri_forces.F:81
subroutine, public calculate_ri_forces(lri_env, lri_density, qs_env, pmatrix, atomic_kind_set)
calculates the ri forces
Definition lri_forces.F:673
routines that build the Kohn-Sham matrix for the LRIGPW and xc parts
subroutine, public calculate_lri_ks_matrix(lri_env, lri_v_int, h_matrix, atomic_kind_set, cell_to_index)
update of LRIGPW KS matrix
subroutine, public calculate_ri_ks_matrix(lri_env, lri_v_int, h_matrix, s_matrix, atomic_kind_set, ispin)
update of RIGPW KS matrix
Interface to the message passing library MPI.
Types containing essential information for running implicit (iterative) Poisson solver.
integer, parameter, public neumann_bc
integer, parameter, public mixed_bc
integer, parameter, public mixed_periodic_bc
integer, parameter, public periodic_bc
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
integer, parameter, public pw_poisson_implicit
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Defines CDFT control structures.
container for information about total charges on the grids
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, mimic, 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, matrix_vhxc, 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, xcint_weights, 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.
Integrate single or product functions over a potential on a RS grid.
Define the quickstep kind type and their sub types.
subroutine, public get_qs_kind_set(qs_kind_set, all_potential_present, tnadd_potential_present, gth_potential_present, sgp_potential_present, paw_atom_present, dft_plus_u_atom_present, maxcgf, maxsgf, maxco, maxco_proj, maxgtops, maxlgto, maxlprj, maxnset, maxsgf_set, ncgf, npgf, nset, nsgf, nshell, maxpol, maxlppl, maxlppnl, maxppnl, nelectron, maxder, max_ngrid_rad, max_sph_harm, maxg_iso_not0, lmax_rho0, basis_rcut, do_mtlr_present, basis_type, total_zeff_corr, npgf_seg, cneo_potential_present, nkind_q, natom_q)
Get attributes of an atomic kind set.
subroutine, public qmmm_modify_hartree_pot(v_hartree, v_qmmm, scale)
Modify the hartree potential in order to include the QM/MM correction.
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_vhxc, 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)
...
routines that build the Kohn-Sham matrix (i.e calculate the coulomb and xc parts
Definition qs_ks_utils.F:22
subroutine, public print_densities(qs_env, rho)
...
subroutine, public get_embed_potential_energy(qs_env, rho, v_rspace_embed, dft_control, embed_corr, just_energy)
...
subroutine, public compute_matrix_vxc_kp(qs_env, v_rspace, matrix_vxc_kp)
Build the XC potential matrix for k-point/image-resolved KS matrices.
subroutine, public low_spin_roks(energy, qs_env, dft_control, do_hfx, just_energy, calculate_forces, auxbas_pw_pool)
do ROKS calculations yielding low spin states
subroutine, public sum_up_and_integrate(qs_env, ks_matrix, rho, my_rho, vppl_rspace, v_rspace_new, v_rspace_new_aux_fit, v_tau_rspace, v_tau_rspace_aux_fit, v_sic_rspace, v_spin_ddapc_rest_r, v_sccs_rspace, v_rspace_embed, cdft_control, calculate_forces)
Sum up all potentials defined on the grid and integrate.
subroutine, public print_detailed_energy(qs_env, dft_control, input, energy, mulliken_order_p)
Print detailed energies.
subroutine, public calculate_zmp_potential(qs_env, v_rspace_new, rho, exc)
Calculate the ZMP potential and energy as in Zhao, Morrison Parr PRA 50i, 2138 (1994) V_c^\lambda def...
subroutine, public calc_v_sic_rspace(v_sic_rspace, energy, qs_env, dft_control, rho, poisson_env, just_energy, calculate_forces, auxbas_pw_pool)
do sic calculations on the spin density
subroutine, public sic_explicit_orbitals(energy, qs_env, dft_control, poisson_env, just_energy, calculate_forces, auxbas_pw_pool)
do sic calculations on explicit orbitals
subroutine, public compute_matrix_vxc(qs_env, v_rspace, matrix_vxc)
compute matrix_vxc, defined via the potential created by qs_vxc_create ignores things like tau functi...
Definition and initialisation of the mo data type.
Definition qs_mo_types.F:22
subroutine, public get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, uniform_occupation, kts, mu, flexible_electron_count)
Get the components of a MO set data structure.
superstucture that hold various representations of the density and keeps track of which ones are vali...
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...
types for task lists
Exchange and Correlation functional calculations.
Definition xc.F:17
real(kind=dp) function, public xc_exc_calc(rho_r, rho_g, tau, xc_section, weights, pw_pool)
calculates just the exchange and correlation energy (no vxc)
Definition xc.F:791
subroutine, public xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section, weights, pw_pool, compute_virial, virial_xc, exc_r)
Exchange and Correlation functional calculations.
Definition xc.F:474
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...
stores some data used in construction of Kohn-Sham matrix
Definition hfx_types.F:514
Contains information about kpoints.
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 ...
Container for information about total charges on the grids.
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.