(git:c28f603)
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("")
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) &
793 cpabort("sic and GAPW not yet compatible")
794
795 ! OK, right now we like two spins to do sic, could be relaxed for AD
796 cpassert(dft_control%nspins == 2)
797
798 CALL auxbas_pw_pool%create_pw(work_rho)
799 CALL auxbas_pw_pool%create_pw(work_v)
800
801 CALL qs_rho_get(rho, rho_g=rho_g)
802
803 ! Hartree sic corrections
804 SELECT CASE (dft_control%sic_method_id)
806 CALL pw_copy(rho_g(1), work_rho)
807 CALL pw_axpy(rho_g(2), work_rho, alpha=-1._dp)
808 CALL pw_poisson_solve(poisson_env, work_rho, ener, work_v)
809 CASE (sic_ad)
810 ! find out how many elecs we have
811 CALL get_qs_env(qs_env, mos=mo_array)
812 CALL get_mo_set(mo_set=mo_array(1), nelectron=nelec_a)
813 CALL get_mo_set(mo_set=mo_array(2), nelectron=nelec_b)
814 nelec = nelec_a + nelec_b
815 CALL pw_copy(rho_g(1), work_rho)
816 CALL pw_axpy(rho_g(2), work_rho)
817 scaling = 1.0_dp/real(nelec, kind=dp)
818 CALL pw_scale(work_rho, scaling)
819 CALL pw_poisson_solve(poisson_env, work_rho, ener, work_v)
820 CASE DEFAULT
821 cpabort("Unknown sic method id")
822 END SELECT
823
824 ! Correct for DDAP charges (if any)
825 ! storing whatever force might be there from previous decoupling
826 IF (calculate_forces) THEN
827 CALL get_qs_env(qs_env=qs_env, force=force)
828 nforce = 0
829 DO i = 1, SIZE(force)
830 nforce = nforce + SIZE(force(i)%ch_pulay, 2)
831 END DO
832 ALLOCATE (store_forces(3, nforce))
833 nforce = 0
834 DO i = 1, SIZE(force)
835 store_forces(1:3, nforce + 1:nforce + SIZE(force(i)%ch_pulay, 2)) = force(i)%ch_pulay(:, :)
836 force(i)%ch_pulay(:, :) = 0.0_dp
837 nforce = nforce + SIZE(force(i)%ch_pulay, 2)
838 END DO
839 END IF
840
841 CALL cp_ddapc_apply_cd(qs_env, &
842 work_rho, &
843 ener, &
844 v_hartree_gspace=work_v, &
845 calculate_forces=calculate_forces, &
846 itype_of_density="SPIN")
847
848 SELECT CASE (dft_control%sic_method_id)
850 full_scaling = -dft_control%sic_scaling_a
851 CASE (sic_ad)
852 full_scaling = -dft_control%sic_scaling_a*nelec
853 CASE DEFAULT
854 cpabort("Unknown sic method id")
855 END SELECT
856 energy%hartree = energy%hartree + full_scaling*ener
857
858 ! add scaled forces, restoring the old
859 IF (calculate_forces) THEN
860 nforce = 0
861 DO i = 1, SIZE(force)
862 force(i)%ch_pulay(:, :) = force(i)%ch_pulay(:, :)*full_scaling + &
863 store_forces(1:3, nforce + 1:nforce + SIZE(force(i)%ch_pulay, 2))
864 nforce = nforce + SIZE(force(i)%ch_pulay, 2)
865 END DO
866 END IF
867
868 IF (.NOT. just_energy) THEN
869 ALLOCATE (v_sic_rspace)
870 CALL auxbas_pw_pool%create_pw(v_sic_rspace)
871 CALL pw_transfer(work_v, v_sic_rspace)
872 ! also take into account the scaling (in addition to the volume element)
873 CALL pw_scale(v_sic_rspace, &
874 dft_control%sic_scaling_a*v_sic_rspace%pw_grid%dvol)
875 END IF
876
877 CALL auxbas_pw_pool%give_back_pw(work_rho)
878 CALL auxbas_pw_pool%give_back_pw(work_v)
879
880 END SUBROUTINE calc_v_sic_rspace
881
882! **************************************************************************************************
883!> \brief ...
884!> \param qs_env ...
885!> \param rho ...
886! **************************************************************************************************
887 SUBROUTINE print_densities(qs_env, rho)
888 TYPE(qs_environment_type), POINTER :: qs_env
889 TYPE(qs_rho_type), POINTER :: rho
890
891 INTEGER :: img, ispin, n_electrons, output_unit
892 REAL(dp) :: tot1_h, tot1_s, tot_rho_r, trace, &
893 trace_tmp
894 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_r_arr
895 TYPE(cell_type), POINTER :: cell
896 TYPE(cp_logger_type), POINTER :: logger
897 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_s, rho_ao
898 TYPE(dft_control_type), POINTER :: dft_control
899 TYPE(qs_charges_type), POINTER :: qs_charges
900 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
901 TYPE(section_vals_type), POINTER :: input, scf_section
902
903 NULLIFY (qs_charges, qs_kind_set, cell, input, logger, scf_section, matrix_s, &
904 dft_control, tot_rho_r_arr, rho_ao)
905
906 logger => cp_get_default_logger()
907
908 CALL get_qs_env(qs_env, &
909 qs_kind_set=qs_kind_set, &
910 cell=cell, qs_charges=qs_charges, &
911 input=input, &
912 matrix_s_kp=matrix_s, &
913 dft_control=dft_control)
914
915 CALL get_qs_kind_set(qs_kind_set, nelectron=n_electrons)
916
917 scf_section => section_vals_get_subs_vals(input, "DFT%SCF")
918 output_unit = cp_print_key_unit_nr(logger, scf_section, "PRINT%TOTAL_DENSITIES", &
919 extension=".scfLog")
920
921 CALL qs_rho_get(rho, tot_rho_r=tot_rho_r_arr, rho_ao_kp=rho_ao)
922 n_electrons = n_electrons - dft_control%charge
923 tot_rho_r = accurate_sum(tot_rho_r_arr)
924
925 trace = 0
926 IF (btest(cp_print_key_should_output(logger%iter_info, scf_section, "PRINT%TOTAL_DENSITIES"), cp_p_file)) THEN
927 DO ispin = 1, dft_control%nspins
928 DO img = 1, dft_control%nimages
929 CALL dbcsr_dot(rho_ao(ispin, img)%matrix, matrix_s(1, img)%matrix, trace_tmp)
930 trace = trace + trace_tmp
931 END DO
932 END DO
933 END IF
934
935 IF (output_unit > 0) THEN
936 WRITE (unit=output_unit, fmt="(/,T3,A,T41,F20.10)") "Trace(PS):", trace
937 WRITE (unit=output_unit, fmt="((T3,A,T41,2F20.10))") &
938 "Electronic density on regular grids: ", &
939 tot_rho_r, &
940 tot_rho_r + &
941 REAL(n_electrons, dp), &
942 "Core density on regular grids:", &
943 qs_charges%total_rho_core_rspace, &
944 qs_charges%total_rho_core_rspace + &
945 qs_charges%total_rho1_hard_nuc - &
946 REAL(n_electrons + dft_control%charge, dp)
947 END IF
948 IF (dft_control%qs_control%gapw) THEN
949 tot1_h = qs_charges%total_rho1_hard(1)
950 tot1_s = qs_charges%total_rho1_soft(1)
951 DO ispin = 2, dft_control%nspins
952 tot1_h = tot1_h + qs_charges%total_rho1_hard(ispin)
953 tot1_s = tot1_s + qs_charges%total_rho1_soft(ispin)
954 END DO
955 IF (output_unit > 0) THEN
956 WRITE (unit=output_unit, fmt="((T3,A,T41,2F20.10))") &
957 "Hard and soft densities (Lebedev):", &
958 tot1_h, tot1_s
959 WRITE (unit=output_unit, fmt="(T3,A,T41,F20.10)") &
960 "Total Rho_soft + Rho1_hard - Rho1_soft (r-space): ", &
961 tot_rho_r + tot1_h - tot1_s, &
962 "Total charge density (r-space): ", &
963 tot_rho_r + tot1_h - tot1_s &
964 + qs_charges%total_rho_core_rspace &
965 + qs_charges%total_rho1_hard_nuc
966 IF (qs_charges%total_rho1_hard_nuc /= 0.0_dp) THEN
967 WRITE (unit=output_unit, fmt="(T3,A,T41,F20.10)") &
968 "Total CNEO nuc. char. den. (Lebedev): ", &
969 qs_charges%total_rho1_hard_nuc, &
970 "Total CNEO soft char. den. (Lebedev): ", &
971 qs_charges%total_rho1_soft_nuc_lebedev, &
972 "Total CNEO soft char. den. (r-space): ", &
973 qs_charges%total_rho1_soft_nuc_rspace, &
974 "Total soft Rho_e+n+0 (g-space):", &
975 qs_charges%total_rho_gspace
976 ELSE
977 WRITE (unit=output_unit, fmt="(T3,A,T41,F20.10)") &
978 "Total Rho_soft + Rho0_soft (g-space):", &
979 qs_charges%total_rho_gspace
980 END IF
981 END IF
982 qs_charges%background = tot_rho_r + tot1_h - tot1_s + &
983 qs_charges%total_rho_core_rspace + &
984 qs_charges%total_rho1_hard_nuc
985 ! only add total_rho1_hard_nuc for gapw as cneo requires gapw
986 ELSE IF (dft_control%qs_control%gapw_xc) THEN
987 tot1_h = qs_charges%total_rho1_hard(1)
988 tot1_s = qs_charges%total_rho1_soft(1)
989 DO ispin = 2, dft_control%nspins
990 tot1_h = tot1_h + qs_charges%total_rho1_hard(ispin)
991 tot1_s = tot1_s + qs_charges%total_rho1_soft(ispin)
992 END DO
993 IF (output_unit > 0) THEN
994 WRITE (unit=output_unit, fmt="(/,(T3,A,T41,2F20.10))") &
995 "Hard and soft densities (Lebedev):", &
996 tot1_h, tot1_s
997 WRITE (unit=output_unit, fmt="(T3,A,T41,F20.10)") &
998 "Total Rho_soft + Rho1_hard - Rho1_soft (r-space): ", &
999 accurate_sum(tot_rho_r_arr) + tot1_h - tot1_s
1000 END IF
1001 qs_charges%background = tot_rho_r + &
1002 qs_charges%total_rho_core_rspace
1003 ELSE
1004 IF (output_unit > 0) THEN
1005 WRITE (unit=output_unit, fmt="(T3,A,T41,F20.10)") &
1006 "Total charge density on r-space grids: ", &
1007 tot_rho_r + &
1008 qs_charges%total_rho_core_rspace, &
1009 "Total charge density g-space grids: ", &
1010 qs_charges%total_rho_gspace
1011 END IF
1012 qs_charges%background = tot_rho_r + &
1013 qs_charges%total_rho_core_rspace
1014 END IF
1015 IF (output_unit > 0) WRITE (unit=output_unit, fmt="()")
1016 qs_charges%background = qs_charges%background/cell%deth
1017
1018 CALL cp_print_key_finished_output(output_unit, logger, scf_section, &
1019 "PRINT%TOTAL_DENSITIES")
1020
1021 END SUBROUTINE print_densities
1022
1023! **************************************************************************************************
1024!> \brief Print detailed energies
1025!>
1026!> \param qs_env ...
1027!> \param dft_control ...
1028!> \param input ...
1029!> \param energy ...
1030!> \param mulliken_order_p ...
1031!> \par History
1032!> refactoring 04.03.2011 [MI]
1033!> \author
1034! **************************************************************************************************
1035 SUBROUTINE print_detailed_energy(qs_env, dft_control, input, energy, mulliken_order_p)
1036
1037 TYPE(qs_environment_type), POINTER :: qs_env
1038 TYPE(dft_control_type), POINTER :: dft_control
1039 TYPE(section_vals_type), POINTER :: input
1040 TYPE(qs_energy_type), POINTER :: energy
1041 REAL(kind=dp), INTENT(IN) :: mulliken_order_p
1042
1043 INTEGER :: bc, n, output_unit, psolver
1044 REAL(kind=dp) :: ddapc_order_p, implicit_ps_ehartree, &
1045 s2_order_p
1046 TYPE(cp_logger_type), POINTER :: logger
1047 TYPE(pw_env_type), POINTER :: pw_env
1048
1049 logger => cp_get_default_logger()
1050
1051 NULLIFY (pw_env)
1052 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env)
1053 psolver = pw_env%poisson_env%parameters%solver
1054
1055 output_unit = cp_print_key_unit_nr(logger, input, "DFT%SCF%PRINT%DETAILED_ENERGY", &
1056 extension=".scfLog")
1057 IF (output_unit > 0) THEN
1058 IF (dft_control%do_admm) THEN
1059 WRITE (unit=output_unit, fmt="((T3,A,T60,F20.10))") &
1060 "Wfn fit exchange-correlation energy: ", energy%exc_aux_fit
1061 IF (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc) THEN
1062 WRITE (unit=output_unit, fmt="((T3,A,T60,F20.10))") &
1063 "Wfn fit soft/hard atomic rho1 Exc contribution: ", energy%exc1_aux_fit
1064 END IF
1065 END IF
1066 IF (dft_control%do_admm) THEN
1067 IF (psolver == pw_poisson_implicit) THEN
1068 implicit_ps_ehartree = pw_env%poisson_env%implicit_env%ehartree
1069 bc = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
1070 SELECT CASE (bc)
1072 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1073 "Core Hamiltonian energy: ", energy%core, &
1074 "Hartree energy: ", implicit_ps_ehartree, &
1075 "Electric enthalpy: ", energy%hartree, &
1076 "Exchange-correlation energy: ", energy%exc + energy%exc_aux_fit
1077 CASE (periodic_bc, neumann_bc)
1078 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1079 "Core Hamiltonian energy: ", energy%core, &
1080 "Hartree energy: ", energy%hartree, &
1081 "Exchange-correlation energy: ", energy%exc + energy%exc_aux_fit
1082 END SELECT
1083 ELSE
1084 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1085 "Core Hamiltonian energy: ", energy%core, &
1086 "Hartree energy: ", energy%hartree, &
1087 "Exchange-correlation energy: ", energy%exc + energy%exc_aux_fit
1088 END IF
1089 ELSE
1090!ZMP to print some variables at each step
1091 IF (dft_control%apply_external_density) THEN
1092 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1093 "DOING ZMP CALCULATION FROM EXTERNAL DENSITY "
1094 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1095 "Core Hamiltonian energy: ", energy%core, &
1096 "Hartree energy: ", energy%hartree
1097 ELSE IF (dft_control%apply_external_vxc) THEN
1098 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1099 "DOING ZMP READING EXTERNAL VXC "
1100 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1101 "Core Hamiltonian energy: ", energy%core, &
1102 "Hartree energy: ", energy%hartree
1103 ELSE
1104 IF (psolver == pw_poisson_implicit) THEN
1105 implicit_ps_ehartree = pw_env%poisson_env%implicit_env%ehartree
1106 bc = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
1107 SELECT CASE (bc)
1109 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1110 "Core Hamiltonian energy: ", energy%core, &
1111 "Hartree energy: ", implicit_ps_ehartree, &
1112 "Electric enthalpy: ", energy%hartree, &
1113 "Exchange-correlation energy: ", energy%exc
1114 CASE (periodic_bc, neumann_bc)
1115 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1116 "Core Hamiltonian energy: ", energy%core, &
1117 "Hartree energy: ", energy%hartree, &
1118 "Exchange-correlation energy: ", energy%exc
1119 END SELECT
1120 ELSE
1121 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1122 "Core Hamiltonian energy: ", energy%core, &
1123 "Hartree energy: ", energy%hartree, &
1124 "Exchange-correlation energy: ", energy%exc
1125 END IF
1126 END IF
1127 END IF
1128
1129 IF (dft_control%apply_external_density) THEN
1130 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1131 "Integral of the (density * v_xc): ", energy%exc
1132 END IF
1133
1134 IF (energy%e_hartree /= 0.0_dp) &
1135 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1136 "Coulomb (electron-electron) energy: ", energy%e_hartree
1137 IF (energy%dispersion /= 0.0_dp) &
1138 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1139 "Dispersion energy: ", energy%dispersion
1140 IF (energy%efield /= 0.0_dp) &
1141 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1142 "Electric field interaction energy: ", energy%efield
1143 IF (energy%gcp /= 0.0_dp) &
1144 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1145 "gCP energy: ", energy%gcp
1146 IF (dft_control%qs_control%gapw) THEN
1147 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1148 "GAPW| Exc from hard and soft atomic rho1: ", energy%exc1 + energy%exc1_aux_fit, &
1149 "GAPW| local Eh = 1 center integrals: ", energy%hartree_1c
1150 END IF
1151 IF (dft_control%qs_control%gapw_xc) 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 END IF
1155 IF (dft_control%dft_plus_u) THEN
1156 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1157 "DFT+U energy:", energy%dft_plus_u
1158 END IF
1159 IF (qs_env%qmmm) THEN
1160 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1161 "QM/MM Electrostatic energy: ", energy%qmmm_el
1162 IF (qs_env%qmmm_env_qm%image_charge) THEN
1163 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1164 "QM/MM image charge energy: ", energy%image_charge
1165 END IF
1166 END IF
1167 IF (dft_control%qs_control%mulliken_restraint) THEN
1168 WRITE (unit=output_unit, fmt="(T3,A,T41,2F20.10)") &
1169 "Mulliken restraint (order_p,energy) : ", mulliken_order_p, energy%mulliken
1170 END IF
1171 IF (dft_control%qs_control%ddapc_restraint) THEN
1172 DO n = 1, SIZE(dft_control%qs_control%ddapc_restraint_control)
1173 ddapc_order_p = &
1174 dft_control%qs_control%ddapc_restraint_control(n)%ddapc_order_p
1175 WRITE (unit=output_unit, fmt="(T3,A,T41,2F20.10)") &
1176 "DDAPC restraint (order_p,energy) : ", ddapc_order_p, energy%ddapc_restraint(n)
1177 END DO
1178 END IF
1179 IF (dft_control%qs_control%s2_restraint) THEN
1180 s2_order_p = dft_control%qs_control%s2_restraint_control%s2_order_p
1181 WRITE (unit=output_unit, fmt="(T3,A,T41,2F20.10)") &
1182 "S2 restraint (order_p,energy) : ", s2_order_p, energy%s2_restraint
1183 END IF
1184 IF (energy%core_cneo /= 0.0_dp) THEN
1185 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1186 "CNEO| quantum nuclear core energy: ", energy%core_cneo
1187 END IF
1188
1189 END IF ! output_unit
1190 CALL cp_print_key_finished_output(output_unit, logger, input, &
1191 "DFT%SCF%PRINT%DETAILED_ENERGY")
1192
1193 END SUBROUTINE print_detailed_energy
1194
1195! **************************************************************************************************
1196!> \brief compute matrix_vxc, defined via the potential created by qs_vxc_create
1197!> ignores things like tau functional, gapw, sic, ...
1198!> so only OK for GGA & GPW right now
1199!> \param qs_env ...
1200!> \param v_rspace ...
1201!> \param matrix_vxc ...
1202!> \par History
1203!> created 23.10.2012 [Joost VandeVondele]
1204!> \author
1205! **************************************************************************************************
1206 SUBROUTINE compute_matrix_vxc(qs_env, v_rspace, matrix_vxc)
1207 TYPE(qs_environment_type), POINTER :: qs_env
1208 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(IN) :: v_rspace
1209 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_vxc
1210
1211 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_matrix_vxc'
1212
1213 INTEGER :: handle, ispin
1214 LOGICAL :: gapw
1215 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks
1216 TYPE(dft_control_type), POINTER :: dft_control
1217
1218 CALL timeset(routinen, handle)
1219
1220 ! create the matrix using matrix_ks as a template
1221 IF (ASSOCIATED(matrix_vxc)) THEN
1222 CALL dbcsr_deallocate_matrix_set(matrix_vxc)
1223 END IF
1224 CALL get_qs_env(qs_env, matrix_ks=matrix_ks)
1225 ALLOCATE (matrix_vxc(SIZE(matrix_ks)))
1226 DO ispin = 1, SIZE(matrix_ks)
1227 NULLIFY (matrix_vxc(ispin)%matrix)
1228 CALL dbcsr_init_p(matrix_vxc(ispin)%matrix)
1229 CALL dbcsr_copy(matrix_vxc(ispin)%matrix, matrix_ks(ispin)%matrix, &
1230 name="Matrix VXC of spin "//cp_to_string(ispin))
1231 CALL dbcsr_set(matrix_vxc(ispin)%matrix, 0.0_dp)
1232 END DO
1233
1234 ! and integrate
1235 CALL get_qs_env(qs_env, dft_control=dft_control)
1236 gapw = dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc
1237 DO ispin = 1, SIZE(matrix_ks)
1238 CALL integrate_v_rspace(v_rspace=v_rspace(ispin), &
1239 hmat=matrix_vxc(ispin), &
1240 qs_env=qs_env, &
1241 calculate_forces=.false., &
1242 gapw=gapw)
1243 ! scale by the volume element... should really become part of integrate_v_rspace
1244 CALL dbcsr_scale(matrix_vxc(ispin)%matrix, v_rspace(ispin)%pw_grid%dvol)
1245 END DO
1246
1247 CALL timestop(handle)
1248
1249 END SUBROUTINE compute_matrix_vxc
1250
1251! **************************************************************************************************
1252!> \brief Build the XC potential matrix for k-point/image-resolved KS matrices.
1253!> \param qs_env Quickstep environment
1254!> \param v_rspace XC potential on the real-space grid
1255!> \param matrix_vxc_kp k-point/image-resolved XC potential matrix
1256!> \author
1257! **************************************************************************************************
1258 SUBROUTINE compute_matrix_vxc_kp(qs_env, v_rspace, matrix_vxc_kp)
1259 TYPE(qs_environment_type), POINTER :: qs_env
1260 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(IN) :: v_rspace
1261 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_vxc_kp
1262
1263 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_matrix_vxc_kp'
1264
1265 INTEGER :: handle, img, ispin
1266 LOGICAL :: gapw
1267 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ksmat
1268 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_ks_kp
1269 TYPE(dft_control_type), POINTER :: dft_control
1270
1271 CALL timeset(routinen, handle)
1272
1273 ! create the matrix using matrix_ks as a template
1274 IF (ASSOCIATED(matrix_vxc_kp)) THEN
1275 CALL dbcsr_deallocate_matrix_set(matrix_vxc_kp)
1276 END IF
1277 CALL get_qs_env(qs_env, dft_control=dft_control, matrix_ks_kp=matrix_ks_kp)
1278 ALLOCATE (matrix_vxc_kp(SIZE(matrix_ks_kp, 1), SIZE(matrix_ks_kp, 2)))
1279 DO img = 1, SIZE(matrix_ks_kp, 2)
1280 DO ispin = 1, SIZE(matrix_ks_kp, 1)
1281 NULLIFY (matrix_vxc_kp(ispin, img)%matrix)
1282 CALL dbcsr_init_p(matrix_vxc_kp(ispin, img)%matrix)
1283 CALL dbcsr_copy(matrix_vxc_kp(ispin, img)%matrix, matrix_ks_kp(ispin, img)%matrix, &
1284 name="Matrix VXC of spin "//cp_to_string(ispin)//" image "//cp_to_string(img))
1285 CALL dbcsr_set(matrix_vxc_kp(ispin, img)%matrix, 0.0_dp)
1286 END DO
1287 END DO
1288
1289 ! and integrate
1290 gapw = dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc
1291 DO ispin = 1, SIZE(matrix_ks_kp, 1)
1292 ksmat => matrix_vxc_kp(ispin, :)
1293 CALL integrate_v_rspace(v_rspace=v_rspace(ispin), &
1294 hmat_kp=ksmat, &
1295 qs_env=qs_env, &
1296 calculate_forces=.false., &
1297 gapw=gapw)
1298 ! scale by the volume element... should really become part of integrate_v_rspace
1299 DO img = 1, SIZE(matrix_ks_kp, 2)
1300 CALL dbcsr_scale(matrix_vxc_kp(ispin, img)%matrix, v_rspace(ispin)%pw_grid%dvol)
1301 END DO
1302 END DO
1303
1304 CALL timestop(handle)
1305
1306 END SUBROUTINE compute_matrix_vxc_kp
1307
1308! **************************************************************************************************
1309!> \brief Sum up all potentials defined on the grid and integrate
1310!>
1311!> \param qs_env ...
1312!> \param ks_matrix ...
1313!> \param rho ...
1314!> \param my_rho ...
1315!> \param vppl_rspace ...
1316!> \param v_rspace_new ...
1317!> \param v_rspace_new_aux_fit ...
1318!> \param v_tau_rspace ...
1319!> \param v_tau_rspace_aux_fit ...
1320!> \param v_sic_rspace ...
1321!> \param v_spin_ddapc_rest_r ...
1322!> \param v_sccs_rspace ...
1323!> \param v_rspace_embed ...
1324!> \param cdft_control ...
1325!> \param calculate_forces ...
1326!> \par History
1327!> - refactoring 04.03.2011 [MI]
1328!> - SCCS implementation (16.10.2013,MK)
1329!> \author
1330! **************************************************************************************************
1331 SUBROUTINE sum_up_and_integrate(qs_env, ks_matrix, rho, my_rho, &
1332 vppl_rspace, v_rspace_new, &
1333 v_rspace_new_aux_fit, v_tau_rspace, &
1334 v_tau_rspace_aux_fit, &
1335 v_sic_rspace, v_spin_ddapc_rest_r, &
1336 v_sccs_rspace, v_rspace_embed, cdft_control, &
1337 calculate_forces)
1338
1339 TYPE(qs_environment_type), POINTER :: qs_env
1340 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ks_matrix
1341 TYPE(qs_rho_type), POINTER :: rho
1342 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: my_rho
1343 TYPE(pw_r3d_rs_type), POINTER :: vppl_rspace
1344 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_rspace_new, v_rspace_new_aux_fit, &
1345 v_tau_rspace, v_tau_rspace_aux_fit
1346 TYPE(pw_r3d_rs_type), POINTER :: v_sic_rspace, v_spin_ddapc_rest_r, &
1347 v_sccs_rspace
1348 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_rspace_embed
1349 TYPE(cdft_control_type), POINTER :: cdft_control
1350 LOGICAL, INTENT(in) :: calculate_forces
1351
1352 CHARACTER(LEN=*), PARAMETER :: routinen = 'sum_up_and_integrate'
1353
1354 CHARACTER(LEN=default_string_length) :: basis_type
1355 INTEGER :: handle, igroup, ikind, img, ispin, &
1356 nkind, nspins
1357 INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index
1358 LOGICAL :: do_ppl, gapw, gapw_xc, lrigpw, rigpw, &
1359 use_work_v_rspace
1360 REAL(kind=dp) :: csign, dvol, fadm
1361 TYPE(admm_type), POINTER :: admm_env
1362 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1363 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ksmat, rho_ao, rho_ao_nokp, smat
1364 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_ks_aux_fit, &
1365 matrix_ks_aux_fit_dft, rho_ao_aux, &
1366 rho_ao_kp
1367 TYPE(dft_control_type), POINTER :: dft_control
1368 TYPE(kpoint_type), POINTER :: kpoints
1369 TYPE(lri_density_type), POINTER :: lri_density
1370 TYPE(lri_environment_type), POINTER :: lri_env
1371 TYPE(lri_kind_type), DIMENSION(:), POINTER :: lri_v_int
1372 TYPE(mp_para_env_type), POINTER :: para_env
1373 TYPE(pw_env_type), POINTER :: pw_env
1374 TYPE(pw_poisson_type), POINTER :: poisson_env
1375 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1376 TYPE(pw_r3d_rs_type), POINTER :: v_rspace, v_rspace_used, vee
1377 TYPE(pw_r3d_rs_type), TARGET :: v_rspace_work
1378 TYPE(qs_ks_env_type), POINTER :: ks_env
1379 TYPE(qs_rho_type), POINTER :: rho_aux_fit
1380 TYPE(task_list_type), POINTER :: task_list
1381
1382 CALL timeset(routinen, handle)
1383
1384 NULLIFY (auxbas_pw_pool, dft_control, pw_env, matrix_ks_aux_fit, &
1385 v_rspace, rho_aux_fit, vee, rho_ao, rho_ao_kp, rho_ao_aux, &
1386 ksmat, matrix_ks_aux_fit_dft, lri_env, lri_density, atomic_kind_set, &
1387 rho_ao_nokp, ks_env, admm_env, task_list, v_rspace_used)
1388
1389 CALL get_qs_env(qs_env, &
1390 dft_control=dft_control, &
1391 pw_env=pw_env, &
1392 v_hartree_rspace=v_rspace, &
1393 vee=vee)
1394
1395 CALL qs_rho_get(rho, rho_ao_kp=rho_ao_kp)
1396 CALL pw_env_get(pw_env, poisson_env=poisson_env, auxbas_pw_pool=auxbas_pw_pool)
1397 gapw = dft_control%qs_control%gapw
1398 gapw_xc = dft_control%qs_control%gapw_xc
1399 do_ppl = dft_control%qs_control%do_ppl_method == do_ppl_grid
1400
1401 rigpw = dft_control%qs_control%rigpw
1402 lrigpw = dft_control%qs_control%lrigpw
1403 IF (lrigpw .OR. rigpw) THEN
1404 CALL get_qs_env(qs_env, &
1405 lri_env=lri_env, &
1406 lri_density=lri_density, &
1407 atomic_kind_set=atomic_kind_set)
1408 END IF
1409
1410 nspins = dft_control%nspins
1411
1412 ! sum up potentials and integrate
1413 IF (ASSOCIATED(v_rspace_new)) THEN
1414 DO ispin = 1, nspins
1415 IF (gapw_xc) THEN
1416 ! SIC not implemented (or at least not tested)
1417 cpassert(dft_control%sic_method_id == sic_none)
1418 !Only the xc potential, because it has to be integrated with the soft basis
1419 CALL pw_scale(v_rspace_new(ispin), v_rspace_new(ispin)%pw_grid%dvol)
1420
1421 ! add the xc part due to v_rspace soft
1422 rho_ao => rho_ao_kp(ispin, :)
1423 ksmat => ks_matrix(ispin, :)
1424 CALL integrate_v_rspace(v_rspace=v_rspace_new(ispin), &
1425 pmat_kp=rho_ao, hmat_kp=ksmat, &
1426 qs_env=qs_env, &
1427 calculate_forces=calculate_forces, &
1428 gapw=gapw_xc)
1429
1430 ! Now the Hartree potential to be integrated with the full basis
1431 CALL pw_copy(v_rspace, v_rspace_new(ispin))
1432 ELSE
1433 ! Add v_hartree + v_xc = v_rspace_new
1434 CALL pw_axpy(v_rspace, v_rspace_new(ispin), 1.0_dp, v_rspace_new(ispin)%pw_grid%dvol)
1435 END IF ! gapw_xc
1436 IF (dft_control%qs_control%ddapc_explicit_potential) THEN
1437 IF (dft_control%qs_control%ddapc_restraint_is_spin) THEN
1438 IF (ispin == 1) THEN
1439 CALL pw_axpy(v_spin_ddapc_rest_r, v_rspace_new(ispin), 1.0_dp)
1440 ELSE
1441 CALL pw_axpy(v_spin_ddapc_rest_r, v_rspace_new(ispin), -1.0_dp)
1442 END IF
1443 ELSE
1444 CALL pw_axpy(v_spin_ddapc_rest_r, v_rspace_new(ispin), 1.0_dp)
1445 END IF
1446 END IF
1447 ! CDFT constraint contribution
1448 IF (dft_control%qs_control%cdft) THEN
1449 DO igroup = 1, SIZE(cdft_control%group)
1450 SELECT CASE (cdft_control%group(igroup)%constraint_type)
1452 csign = 1.0_dp
1454 IF (ispin == 1) THEN
1455 csign = 1.0_dp
1456 ELSE
1457 csign = -1.0_dp
1458 END IF
1460 csign = 1.0_dp
1461 IF (ispin == 2) cycle
1463 csign = 1.0_dp
1464 IF (ispin == 1) cycle
1465 CASE DEFAULT
1466 cpabort("Unknown constraint type.")
1467 END SELECT
1468 CALL pw_axpy(cdft_control%group(igroup)%weight, v_rspace_new(ispin), &
1469 csign*cdft_control%strength(igroup))
1470 END DO
1471 END IF
1472 ! functional derivative of the Hartree energy wrt the density in the presence of dielectric
1473 ! (vhartree + v_eps); v_eps is nonzero only if the dielectric constant is defind as a function
1474 ! of the charge density
1475 IF (poisson_env%parameters%solver == pw_poisson_implicit) THEN
1476 dvol = poisson_env%implicit_env%v_eps%pw_grid%dvol
1477 CALL pw_axpy(poisson_env%implicit_env%v_eps, v_rspace_new(ispin), dvol)
1478 END IF
1479 ! Add SCCS contribution
1480 IF (dft_control%do_sccs) THEN
1481 CALL pw_axpy(v_sccs_rspace, v_rspace_new(ispin))
1482 END IF
1483 ! External electrostatic potential
1484 IF (dft_control%apply_external_potential) THEN
1485 CALL qmmm_modify_hartree_pot(v_hartree=v_rspace_new(ispin), &
1486 v_qmmm=vee, scale=-1.0_dp)
1487 END IF
1488 IF (do_ppl) THEN
1489 cpassert(.NOT. gapw)
1490 CALL pw_axpy(vppl_rspace, v_rspace_new(ispin), vppl_rspace%pw_grid%dvol)
1491 END IF
1492 ! the electrostatic sic contribution
1493 SELECT CASE (dft_control%sic_method_id)
1494 CASE (sic_none)
1495 !
1497 IF (ispin == 1) THEN
1498 CALL pw_axpy(v_sic_rspace, v_rspace_new(ispin), -1.0_dp)
1499 ELSE
1500 CALL pw_axpy(v_sic_rspace, v_rspace_new(ispin), 1.0_dp)
1501 END IF
1502 CASE (sic_ad)
1503 CALL pw_axpy(v_sic_rspace, v_rspace_new(ispin), -1.0_dp)
1504 CASE (sic_eo)
1505 ! NOTHING TO BE DONE
1506 END SELECT
1507 ! DFT embedding
1508 IF (dft_control%apply_embed_pot) THEN
1509 CALL pw_axpy(v_rspace_embed(ispin), v_rspace_new(ispin), v_rspace_embed(ispin)%pw_grid%dvol)
1510 CALL auxbas_pw_pool%give_back_pw(v_rspace_embed(ispin))
1511 END IF
1512 IF (lrigpw) THEN
1513 lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds
1514 CALL get_qs_env(qs_env, nkind=nkind, para_env=para_env)
1515 DO ikind = 1, nkind
1516 lri_v_int(ikind)%v_int = 0.0_dp
1517 END DO
1518 CALL integrate_v_rspace_one_center(v_rspace_new(ispin), qs_env, &
1519 lri_v_int, calculate_forces, "LRI_AUX")
1520 DO ikind = 1, nkind
1521 CALL para_env%sum(lri_v_int(ikind)%v_int)
1522 END DO
1523 IF (lri_env%exact_1c_terms) THEN
1524 rho_ao => my_rho(ispin, :)
1525 ksmat => ks_matrix(ispin, :)
1526 CALL integrate_v_rspace_diagonal(v_rspace_new(ispin), ksmat(1)%matrix, &
1527 rho_ao(1)%matrix, qs_env, &
1528 calculate_forces, "ORB")
1529 END IF
1530 IF (lri_env%ppl_ri) THEN
1531 CALL v_int_ppl_update(qs_env, lri_v_int, calculate_forces)
1532 END IF
1533 ELSEIF (rigpw) THEN
1534 lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds
1535 CALL get_qs_env(qs_env, nkind=nkind, para_env=para_env)
1536 DO ikind = 1, nkind
1537 lri_v_int(ikind)%v_int = 0.0_dp
1538 END DO
1539 CALL integrate_v_rspace_one_center(v_rspace_new(ispin), qs_env, &
1540 lri_v_int, calculate_forces, "RI_HXC")
1541 DO ikind = 1, nkind
1542 CALL para_env%sum(lri_v_int(ikind)%v_int)
1543 END DO
1544 ELSE
1545 rho_ao => my_rho(ispin, :)
1546 ksmat => ks_matrix(ispin, :)
1547 CALL integrate_v_rspace(v_rspace=v_rspace_new(ispin), &
1548 pmat_kp=rho_ao, hmat_kp=ksmat, &
1549 qs_env=qs_env, &
1550 calculate_forces=calculate_forces, &
1551 gapw=gapw)
1552 END IF
1553 CALL auxbas_pw_pool%give_back_pw(v_rspace_new(ispin))
1554 END DO ! ispin
1555
1556 SELECT CASE (dft_control%sic_method_id)
1557 CASE (sic_none)
1559 CALL auxbas_pw_pool%give_back_pw(v_sic_rspace)
1560 DEALLOCATE (v_sic_rspace)
1561 END SELECT
1562 DEALLOCATE (v_rspace_new)
1563
1564 ELSE
1565 ! not implemented (or at least not tested)
1566 cpassert(dft_control%sic_method_id == sic_none)
1567 cpassert(.NOT. dft_control%qs_control%ddapc_restraint_is_spin)
1568 DO ispin = 1, nspins
1569 use_work_v_rspace = dft_control%qs_control%cdft
1570 IF (use_work_v_rspace) THEN
1571 CALL auxbas_pw_pool%create_pw(v_rspace_work)
1572 CALL pw_copy(v_rspace, v_rspace_work)
1573 v_rspace_used => v_rspace_work
1574 ELSE
1575 v_rspace_used => v_rspace
1576 END IF
1577 ! CDFT constraint contribution
1578 IF (dft_control%qs_control%cdft) THEN
1579 DO igroup = 1, SIZE(cdft_control%group)
1580 SELECT CASE (cdft_control%group(igroup)%constraint_type)
1582 csign = 1.0_dp
1584 IF (ispin == 1) THEN
1585 csign = 1.0_dp
1586 ELSE
1587 csign = -1.0_dp
1588 END IF
1590 csign = 1.0_dp
1591 IF (ispin == 2) cycle
1593 csign = 1.0_dp
1594 IF (ispin == 1) cycle
1595 CASE DEFAULT
1596 cpabort("Unknown constraint type.")
1597 END SELECT
1598 CALL pw_axpy(cdft_control%group(igroup)%weight, v_rspace_used, &
1599 csign*cdft_control%strength(igroup))
1600 END DO
1601 END IF
1602 ! extra contribution attributed to the dependency of the dielectric constant to the charge density
1603 IF (poisson_env%parameters%solver == pw_poisson_implicit) THEN
1604 dvol = poisson_env%implicit_env%v_eps%pw_grid%dvol
1605 CALL pw_axpy(poisson_env%implicit_env%v_eps, v_rspace_used, dvol)
1606 END IF
1607 ! Add SCCS contribution
1608 IF (dft_control%do_sccs) THEN
1609 CALL pw_axpy(v_sccs_rspace, v_rspace_used)
1610 END IF
1611 ! DFT embedding
1612 IF (dft_control%apply_embed_pot) THEN
1613 CALL pw_axpy(v_rspace_embed(ispin), v_rspace_used, v_rspace_embed(ispin)%pw_grid%dvol)
1614 CALL auxbas_pw_pool%give_back_pw(v_rspace_embed(ispin))
1615 END IF
1616 IF (lrigpw) THEN
1617 lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds
1618 CALL get_qs_env(qs_env, nkind=nkind, para_env=para_env)
1619 DO ikind = 1, nkind
1620 lri_v_int(ikind)%v_int = 0.0_dp
1621 END DO
1622 CALL integrate_v_rspace_one_center(v_rspace_used, qs_env, &
1623 lri_v_int, calculate_forces, "LRI_AUX")
1624 DO ikind = 1, nkind
1625 CALL para_env%sum(lri_v_int(ikind)%v_int)
1626 END DO
1627 IF (lri_env%exact_1c_terms) THEN
1628 rho_ao => my_rho(ispin, :)
1629 ksmat => ks_matrix(ispin, :)
1630 CALL integrate_v_rspace_diagonal(v_rspace_used, ksmat(1)%matrix, &
1631 rho_ao(1)%matrix, qs_env, &
1632 calculate_forces, "ORB")
1633 END IF
1634 IF (lri_env%ppl_ri) THEN
1635 CALL v_int_ppl_update(qs_env, lri_v_int, calculate_forces)
1636 END IF
1637 ELSEIF (rigpw) THEN
1638 lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds
1639 CALL get_qs_env(qs_env, nkind=nkind, para_env=para_env)
1640 DO ikind = 1, nkind
1641 lri_v_int(ikind)%v_int = 0.0_dp
1642 END DO
1643 CALL integrate_v_rspace_one_center(v_rspace_used, qs_env, &
1644 lri_v_int, calculate_forces, "RI_HXC")
1645 DO ikind = 1, nkind
1646 CALL para_env%sum(lri_v_int(ikind)%v_int)
1647 END DO
1648 ELSE
1649 rho_ao => my_rho(ispin, :)
1650 ksmat => ks_matrix(ispin, :)
1651 CALL integrate_v_rspace(v_rspace=v_rspace_used, &
1652 pmat_kp=rho_ao, &
1653 hmat_kp=ksmat, &
1654 qs_env=qs_env, &
1655 calculate_forces=calculate_forces, &
1656 gapw=gapw)
1657 END IF
1658 IF (use_work_v_rspace) CALL auxbas_pw_pool%give_back_pw(v_rspace_work)
1659 END DO
1660 END IF ! ASSOCIATED(v_rspace_new)
1661
1662 ! **** LRIGPW: KS matrix from integrated potential
1663 IF (lrigpw) THEN
1664 CALL get_qs_env(qs_env, ks_env=ks_env)
1665 CALL get_ks_env(ks_env=ks_env, kpoints=kpoints)
1666 CALL get_kpoint_info(kpoint=kpoints, cell_to_index=cell_to_index)
1667 DO ispin = 1, nspins
1668 ksmat => ks_matrix(ispin, :)
1669 CALL calculate_lri_ks_matrix(lri_env, lri_v_int, ksmat, atomic_kind_set, &
1670 cell_to_index=cell_to_index)
1671 END DO
1672 IF (calculate_forces) THEN
1673 CALL calculate_lri_forces(lri_env, lri_density, qs_env, rho_ao_kp, atomic_kind_set)
1674 END IF
1675 ELSEIF (rigpw) THEN
1676 CALL get_qs_env(qs_env, matrix_s=smat)
1677 DO ispin = 1, nspins
1678 CALL calculate_ri_ks_matrix(lri_env, lri_v_int, ks_matrix(ispin, 1)%matrix, &
1679 smat(1)%matrix, atomic_kind_set, ispin)
1680 END DO
1681 IF (calculate_forces) THEN
1682 rho_ao_nokp => rho_ao_kp(:, 1)
1683 CALL calculate_ri_forces(lri_env, lri_density, qs_env, rho_ao_nokp, atomic_kind_set)
1684 END IF
1685 END IF
1686
1687 IF (ASSOCIATED(v_tau_rspace)) THEN
1688 IF (lrigpw .OR. rigpw) THEN
1689 cpabort("LRIGPW/RIGPW not implemented for meta-GGAs")
1690 END IF
1691 DO ispin = 1, nspins
1692 CALL pw_scale(v_tau_rspace(ispin), v_tau_rspace(ispin)%pw_grid%dvol)
1693
1694 rho_ao => rho_ao_kp(ispin, :)
1695 ksmat => ks_matrix(ispin, :)
1696 CALL integrate_v_rspace(v_rspace=v_tau_rspace(ispin), &
1697 pmat_kp=rho_ao, hmat_kp=ksmat, &
1698 qs_env=qs_env, &
1699 calculate_forces=calculate_forces, compute_tau=.true., &
1700 gapw=gapw)
1701 CALL auxbas_pw_pool%give_back_pw(v_tau_rspace(ispin))
1702 END DO
1703 DEALLOCATE (v_tau_rspace)
1704 END IF
1705
1706 ! Add contributions from ADMM if requested
1707 IF (dft_control%do_admm) THEN
1708 CALL get_qs_env(qs_env, admm_env=admm_env)
1709 CALL get_admm_env(admm_env, matrix_ks_aux_fit_kp=matrix_ks_aux_fit, rho_aux_fit=rho_aux_fit, &
1710 matrix_ks_aux_fit_dft_kp=matrix_ks_aux_fit_dft)
1711 CALL qs_rho_get(rho_aux_fit, rho_ao_kp=rho_ao_aux)
1712 IF (ASSOCIATED(v_rspace_new_aux_fit)) THEN
1713 DO ispin = 1, nspins
1714 ! Calculate the xc potential
1715 CALL pw_scale(v_rspace_new_aux_fit(ispin), v_rspace_new_aux_fit(ispin)%pw_grid%dvol)
1716
1717 ! set matrix_ks_aux_fit_dft = matrix_ks_aux_fit(k_HF)
1718 DO img = 1, dft_control%nimages
1719 CALL dbcsr_copy(matrix_ks_aux_fit_dft(ispin, img)%matrix, matrix_ks_aux_fit(ispin, img)%matrix, &
1720 name="DFT exch. part of matrix_ks_aux_fit")
1721 END DO
1722
1723 ! Add potential to ks_matrix aux_fit, skip integration if no DFT correction
1724
1725 IF (admm_env%aux_exch_func /= do_admm_aux_exch_func_none) THEN
1726
1727 !GPW by default. IF GAPW, then take relevant task list and basis
1728 CALL get_admm_env(admm_env, task_list_aux_fit=task_list)
1729 basis_type = "AUX_FIT"
1730 IF (admm_env%do_gapw) THEN
1731 task_list => admm_env%admm_gapw_env%task_list
1732 basis_type = "AUX_FIT_SOFT"
1733 END IF
1734 fadm = 1.0_dp
1735 ! Calculate bare scaling of force according to Merlot, 1. IF: ADMMP, 2. IF: ADMMS,
1736 IF (admm_env%do_admmp) THEN
1737 fadm = admm_env%gsi(ispin)**2
1738 ELSE IF (admm_env%do_admms) THEN
1739 fadm = (admm_env%gsi(ispin))**(2.0_dp/3.0_dp)
1740 END IF
1741
1742 rho_ao => rho_ao_aux(ispin, :)
1743 ksmat => matrix_ks_aux_fit(ispin, :)
1744
1745 CALL integrate_v_rspace(v_rspace=v_rspace_new_aux_fit(ispin), &
1746 pmat_kp=rho_ao, &
1747 hmat_kp=ksmat, &
1748 qs_env=qs_env, &
1749 calculate_forces=calculate_forces, &
1750 force_adm=fadm, &
1751 gapw=.false., & !even if actual GAPW calculation, want to use AUX_FIT_SOFT
1752 basis_type=basis_type, &
1753 task_list_external=task_list)
1754 END IF
1755
1756 ! matrix_ks_aux_fit_dft(x_DFT)=matrix_ks_aux_fit_dft(old,k_HF)-matrix_ks_aux_fit(k_HF-x_DFT)
1757 DO img = 1, dft_control%nimages
1758 CALL dbcsr_add(matrix_ks_aux_fit_dft(ispin, img)%matrix, &
1759 matrix_ks_aux_fit(ispin, img)%matrix, 1.0_dp, -1.0_dp)
1760 END DO
1761
1762 CALL auxbas_pw_pool%give_back_pw(v_rspace_new_aux_fit(ispin))
1763 END DO
1764 DEALLOCATE (v_rspace_new_aux_fit)
1765 END IF
1766 ! Clean up v_tau_rspace_aux_fit, which is actually not needed
1767 IF (ASSOCIATED(v_tau_rspace_aux_fit)) THEN
1768 DO ispin = 1, nspins
1769 CALL auxbas_pw_pool%give_back_pw(v_tau_rspace_aux_fit(ispin))
1770 END DO
1771 DEALLOCATE (v_tau_rspace_aux_fit)
1772 END IF
1773 END IF
1774
1775 IF (dft_control%apply_embed_pot) DEALLOCATE (v_rspace_embed)
1776
1777 CALL timestop(handle)
1778
1779 END SUBROUTINE sum_up_and_integrate
1780
1781!**************************************************************************
1782!> \brief Calculate the ZMP potential and energy as in Zhao, Morrison Parr
1783!> PRA 50i, 2138 (1994)
1784!> V_c^\lambda defined as int_rho-rho_0/r-r' or rho-rho_0 times a Lagrange
1785!> multiplier, plus Fermi-Amaldi potential that should give the V_xc in the
1786!> limit \lambda --> \infty
1787!>
1788!> \param qs_env ...
1789!> \param v_rspace_new ...
1790!> \param rho ...
1791!> \param exc ...
1792!> \author D. Varsano [daniele.varsano@nano.cnr.it]
1793! **************************************************************************************************
1794 SUBROUTINE calculate_zmp_potential(qs_env, v_rspace_new, rho, exc)
1795
1796 TYPE(qs_environment_type), POINTER :: qs_env
1797 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_rspace_new
1798 TYPE(qs_rho_type), POINTER :: rho
1799 REAL(kind=dp) :: exc
1800
1801 CHARACTER(*), PARAMETER :: routinen = 'calculate_zmp_potential'
1802
1803 INTEGER :: handle, my_val, nelectron, nspins
1804 INTEGER, DIMENSION(2) :: nelectron_spin
1805 LOGICAL :: do_zmp_read, fermi_amaldi
1806 REAL(kind=dp) :: lambda
1807 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_ext_r
1808 TYPE(dft_control_type), POINTER :: dft_control
1809 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_ext_g, rho_g
1810 TYPE(pw_env_type), POINTER :: pw_env
1811 TYPE(pw_poisson_type), POINTER :: poisson_env
1812 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1813 TYPE(pw_r3d_rs_type) :: v_xc_rspace
1814 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
1815 TYPE(qs_ks_env_type), POINTER :: ks_env
1816 TYPE(section_vals_type), POINTER :: ext_den_section, input
1817
1818!, v_h_gspace, &
1819
1820 CALL timeset(routinen, handle)
1821 NULLIFY (auxbas_pw_pool)
1822 NULLIFY (pw_env)
1823 NULLIFY (poisson_env)
1824 NULLIFY (v_rspace_new)
1825 NULLIFY (dft_control)
1826 NULLIFY (rho_r, rho_g, tot_rho_ext_r, rho_ext_g)
1827 CALL get_qs_env(qs_env=qs_env, &
1828 pw_env=pw_env, &
1829 ks_env=ks_env, &
1830 rho=rho, &
1831 input=input, &
1832 nelectron_spin=nelectron_spin, &
1833 dft_control=dft_control)
1834 CALL pw_env_get(pw_env=pw_env, &
1835 auxbas_pw_pool=auxbas_pw_pool, &
1836 poisson_env=poisson_env)
1837 CALL qs_rho_get(rho, rho_r=rho_r, rho_g=rho_g)
1838 nspins = 1
1839 ALLOCATE (v_rspace_new(nspins))
1840 CALL auxbas_pw_pool%create_pw(pw=v_rspace_new(1))
1841 CALL auxbas_pw_pool%create_pw(pw=v_xc_rspace)
1842
1843 CALL pw_zero(v_rspace_new(1))
1844 do_zmp_read = dft_control%apply_external_vxc
1845 IF (do_zmp_read) THEN
1846 CALL pw_copy(qs_env%external_vxc, v_rspace_new(1))
1847 exc = accurate_dot_product(v_rspace_new(1)%array, rho_r(1)%array)* &
1848 v_rspace_new(1)%pw_grid%dvol
1849 ELSE
1850 block
1851 REAL(kind=dp) :: factor
1852 TYPE(pw_c1d_gs_type) :: rho_eff_gspace, v_xc_gspace
1853 CALL auxbas_pw_pool%create_pw(pw=rho_eff_gspace)
1854 CALL auxbas_pw_pool%create_pw(pw=v_xc_gspace)
1855 CALL pw_zero(rho_eff_gspace)
1856 CALL pw_zero(v_xc_gspace)
1857 CALL pw_zero(v_xc_rspace)
1858 factor = pw_integrate_function(rho_g(1))
1859 CALL qs_rho_get(qs_env%rho_external, &
1860 rho_g=rho_ext_g, &
1861 tot_rho_r=tot_rho_ext_r)
1862 factor = tot_rho_ext_r(1)/factor
1863
1864 CALL pw_axpy(rho_g(1), rho_eff_gspace, alpha=factor)
1865 CALL pw_axpy(rho_ext_g(1), rho_eff_gspace, alpha=-1.0_dp)
1866 ext_den_section => section_vals_get_subs_vals(input, "DFT%EXTERNAL_DENSITY")
1867 CALL section_vals_val_get(ext_den_section, "LAMBDA", r_val=lambda)
1868 CALL section_vals_val_get(ext_den_section, "ZMP_CONSTRAINT", i_val=my_val)
1869 CALL section_vals_val_get(ext_den_section, "FERMI_AMALDI", l_val=fermi_amaldi)
1870
1871 CALL pw_scale(rho_eff_gspace, a=lambda)
1872 nelectron = nelectron_spin(1)
1873 factor = -1.0_dp/nelectron
1874 CALL pw_axpy(rho_g(1), rho_eff_gspace, alpha=factor)
1875
1876 CALL pw_poisson_solve(poisson_env, rho_eff_gspace, vhartree=v_xc_gspace)
1877 CALL pw_transfer(v_xc_gspace, v_rspace_new(1))
1878 CALL pw_copy(v_rspace_new(1), v_xc_rspace)
1879
1880 exc = 0.0_dp
1881 exc = pw_integral_ab(v_rspace_new(1), rho_r(1))
1882
1883!Note that this is not the xc energy but \int(\rho*v_xc)
1884!Vxc---> v_rspace_new
1885!Exc---> energy%exc
1886 CALL auxbas_pw_pool%give_back_pw(rho_eff_gspace)
1887 CALL auxbas_pw_pool%give_back_pw(v_xc_gspace)
1888 END block
1889 END IF
1890
1891 CALL auxbas_pw_pool%give_back_pw(v_xc_rspace)
1892
1893 CALL timestop(handle)
1894
1895 END SUBROUTINE calculate_zmp_potential
1896
1897! **************************************************************************************************
1898!> \brief ...
1899!> \param qs_env ...
1900!> \param rho ...
1901!> \param v_rspace_embed ...
1902!> \param dft_control ...
1903!> \param embed_corr ...
1904!> \param just_energy ...
1905! **************************************************************************************************
1906 SUBROUTINE get_embed_potential_energy(qs_env, rho, v_rspace_embed, dft_control, embed_corr, &
1907 just_energy)
1908 TYPE(qs_environment_type), POINTER :: qs_env
1909 TYPE(qs_rho_type), POINTER :: rho
1910 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_rspace_embed
1911 TYPE(dft_control_type), POINTER :: dft_control
1912 REAL(kind=dp) :: embed_corr
1913 LOGICAL :: just_energy
1914
1915 CHARACTER(*), PARAMETER :: routinen = 'get_embed_potential_energy'
1916
1917 INTEGER :: handle, ispin
1918 REAL(kind=dp) :: embed_corr_local
1919 TYPE(pw_env_type), POINTER :: pw_env
1920 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1921 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
1922
1923 CALL timeset(routinen, handle)
1924
1925 NULLIFY (auxbas_pw_pool)
1926 NULLIFY (pw_env)
1927 NULLIFY (rho_r)
1928 CALL get_qs_env(qs_env=qs_env, &
1929 pw_env=pw_env, &
1930 rho=rho)
1931 CALL pw_env_get(pw_env=pw_env, &
1932 auxbas_pw_pool=auxbas_pw_pool)
1933 CALL qs_rho_get(rho, rho_r=rho_r)
1934 ALLOCATE (v_rspace_embed(dft_control%nspins))
1935
1936 embed_corr = 0.0_dp
1937
1938 DO ispin = 1, dft_control%nspins
1939 CALL auxbas_pw_pool%create_pw(pw=v_rspace_embed(ispin))
1940 CALL pw_zero(v_rspace_embed(ispin))
1941
1942 CALL pw_copy(qs_env%embed_pot, v_rspace_embed(ispin))
1943 embed_corr_local = 0.0_dp
1944
1945 ! Spin embedding potential in open-shell case
1946 IF (dft_control%nspins == 2) THEN
1947 IF (ispin == 1) CALL pw_axpy(qs_env%spin_embed_pot, v_rspace_embed(ispin), 1.0_dp)
1948 IF (ispin == 2) CALL pw_axpy(qs_env%spin_embed_pot, v_rspace_embed(ispin), -1.0_dp)
1949 END IF
1950 ! Integrate the density*potential
1951 embed_corr_local = pw_integral_ab(v_rspace_embed(ispin), rho_r(ispin))
1952
1953 embed_corr = embed_corr + embed_corr_local
1954
1955 END DO
1956
1957 ! If only energy requiested we delete the potential
1958 IF (just_energy) THEN
1959 DO ispin = 1, dft_control%nspins
1960 CALL auxbas_pw_pool%give_back_pw(v_rspace_embed(ispin))
1961 END DO
1962 DEALLOCATE (v_rspace_embed)
1963 END IF
1964
1965 CALL timestop(handle)
1966
1967 END SUBROUTINE get_embed_potential_energy
1968
1969END 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:593
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_create(matrix, matrix_struct, name, use_sp, nrow, ncol, set_zero)
creates a new full matrix with the given structure
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
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:15
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, 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, 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_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:511
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.