(git:ed6f26b)
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-2025 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(qs_ks_env_type), POINTER :: ks_env
183 TYPE(qs_rho_type), POINTER :: rho
184 TYPE(section_vals_type), POINTER :: hfx_section, input, &
185 low_spin_roks_section, xc_section
186 TYPE(virial_type), POINTER :: virial
187
188 IF (.NOT. dft_control%low_spin_roks) RETURN
189
190 CALL timeset(routinen, handle)
191
192 NULLIFY (ks_env, rho_ao)
193
194 ! Test for not compatible options
195 IF (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc) THEN
196 CALL cp_abort(__location__, "GAPW/GAPW_XC are not compatible with low spin ROKS method.")
197 END IF
198 IF (dft_control%do_admm) THEN
199 CALL cp_abort(__location__, "ADMM not compatible with low spin ROKS method.")
200 END IF
201 IF (dft_control%do_admm) THEN
202 IF (qs_env%admm_env%aux_exch_func /= do_admm_aux_exch_func_none) THEN
203 CALL cp_abort(__location__, "ADMM with XC correction functional "// &
204 "not compatible with low spin ROKS method.")
205 END IF
206 END IF
207 IF (dft_control%qs_control%semi_empirical .OR. dft_control%qs_control%dftb .OR. &
208 dft_control%qs_control%xtb) THEN
209 CALL cp_abort(__location__, "SE/xTB/DFTB are not compatible with low spin ROKS method.")
210 END IF
211
212 CALL get_qs_env(qs_env, &
213 ks_env=ks_env, &
214 mo_derivs=mo_derivs, &
215 mos=mo_array, &
216 rho=rho, &
217 pw_env=pw_env, &
218 input=input, &
219 cell=cell, &
220 virial=virial)
221
222 CALL qs_rho_get(rho, rho_ao=rho_ao)
223
224 compute_virial = virial%pv_calculate .AND. (.NOT. virial%pv_numer)
225 xc_section => section_vals_get_subs_vals(input, "DFT%XC")
226 hfx_section => section_vals_get_subs_vals(input, "DFT%XC%HF")
227
228 ! some assumptions need to be checked
229 ! we have two spins
230 cpassert(SIZE(mo_array, 1) == 2)
231 nspin = 2
232 ! we want uniform occupations
233 CALL get_mo_set(mo_set=mo_array(1), uniform_occupation=uniform_occupation)
234 cpassert(uniform_occupation)
235 CALL get_mo_set(mo_set=mo_array(2), mo_coeff_b=mo_coeff, uniform_occupation=uniform_occupation)
236 cpassert(uniform_occupation)
237 IF (do_hfx .AND. calculate_forces .AND. compute_virial) THEN
238 CALL cp_abort(__location__, "ROKS virial with HFX not available.")
239 END IF
240
241 NULLIFY (dbcsr_deriv)
242 CALL dbcsr_init_p(dbcsr_deriv)
243 CALL dbcsr_copy(dbcsr_deriv, mo_derivs(1)%matrix)
244 CALL dbcsr_set(dbcsr_deriv, 0.0_dp)
245
246 ! basic info
247 CALL get_mo_set(mo_set=mo_array(1), mo_coeff_b=mo_coeff)
248 CALL dbcsr_get_info(mo_coeff, nfullcols_total=k_alpha)
249 CALL get_mo_set(mo_set=mo_array(2), mo_coeff_b=mo_coeff)
250 CALL dbcsr_get_info(mo_coeff, nfullcols_total=k_beta)
251
252 ! read the input
253 low_spin_roks_section => section_vals_get_subs_vals(input, "DFT%LOW_SPIN_ROKS")
254
255 CALL section_vals_val_get(low_spin_roks_section, "ENERGY_SCALING", r_vals=rvec)
256 nterms = SIZE(rvec)
257 ALLOCATE (energy_scaling(nterms))
258 energy_scaling = rvec !? just wondering, should this add up to 1, in which case we should cpp?
259
260 CALL section_vals_val_get(low_spin_roks_section, "SPIN_CONFIGURATION", n_rep_val=n_rep)
261 cpassert(n_rep == nterms)
262 CALL section_vals_val_get(low_spin_roks_section, "SPIN_CONFIGURATION", i_rep_val=1, i_vals=ivec)
263 nelectron = SIZE(ivec)
264 cpassert(nelectron == k_alpha - k_beta)
265 ALLOCATE (occupations(2, nelectron, nterms))
266 occupations = 0
267 DO iterm = 1, nterms
268 CALL section_vals_val_get(low_spin_roks_section, "SPIN_CONFIGURATION", i_rep_val=iterm, i_vals=ivec)
269 cpassert(nelectron == SIZE(ivec))
270 in_range = all(ivec >= 1) .AND. all(ivec <= 2)
271 cpassert(in_range)
272 DO k = 1, nelectron
273 occupations(ivec(k), k, iterm) = 1
274 END DO
275 END DO
276
277 ! set up general data structures
278 ! density matrices, kohn-sham matrices
279
280 NULLIFY (matrix_p)
281 CALL dbcsr_allocate_matrix_set(matrix_p, nspin)
282 DO ispin = 1, nspin
283 ALLOCATE (matrix_p(ispin)%matrix)
284 CALL dbcsr_copy(matrix_p(ispin)%matrix, rho_ao(1)%matrix, &
285 name="density matrix low spin roks")
286 CALL dbcsr_set(matrix_p(ispin)%matrix, 0.0_dp)
287 END DO
288
289 NULLIFY (matrix_h)
290 CALL dbcsr_allocate_matrix_set(matrix_h, nspin)
291 DO ispin = 1, nspin
292 ALLOCATE (matrix_h(ispin)%matrix)
293 CALL dbcsr_copy(matrix_h(ispin)%matrix, rho_ao(1)%matrix, &
294 name="KS matrix low spin roks")
295 CALL dbcsr_set(matrix_h(ispin)%matrix, 0.0_dp)
296 END DO
297
298 IF (do_hfx) THEN
299 NULLIFY (matrix_hfx)
300 CALL dbcsr_allocate_matrix_set(matrix_hfx, nspin)
301 DO ispin = 1, nspin
302 ALLOCATE (matrix_hfx(ispin)%matrix)
303 CALL dbcsr_copy(matrix_hfx(ispin)%matrix, rho_ao(1)%matrix, &
304 name="HFX matrix low spin roks")
305 END DO
306 END IF
307
308 ! grids in real and g space for rho and vxc
309 ! tau functionals are not supported
310 NULLIFY (tau, vxc_tau, vxc)
311 CALL pw_env_get(pw_env, xc_pw_pool=xc_pw_pool)
312
313 ALLOCATE (rho_r(nspin))
314 ALLOCATE (rho_g(nspin))
315 DO ispin = 1, nspin
316 CALL auxbas_pw_pool%create_pw(rho_r(ispin))
317 CALL auxbas_pw_pool%create_pw(rho_g(ispin))
318 END DO
319 CALL auxbas_pw_pool%create_pw(work_v_rspace)
320
321 ! get mo matrices needed to construct the density matrices
322 ! we will base all on the alpha spin matrix, obviously possible in ROKS
323 CALL get_mo_set(mo_set=mo_array(1), mo_coeff_b=mo_coeff)
324 NULLIFY (fm_scaled, fm_deriv)
325 CALL dbcsr_init_p(fm_scaled)
326 CALL dbcsr_init_p(fm_deriv)
327 CALL dbcsr_copy(fm_scaled, mo_coeff)
328 CALL dbcsr_copy(fm_deriv, mo_coeff)
329
330 ALLOCATE (scaling(k_alpha))
331
332 ! for each term, add it with the given scaling factor to the energy, and compute the required derivatives
333 DO iterm = 1, nterms
334
335 DO ispin = 1, nspin
336 ! compute the proper density matrices with the required occupations
337 CALL dbcsr_set(matrix_p(ispin)%matrix, 0.0_dp)
338 scaling = 1.0_dp
339 scaling(k_alpha - nelectron + 1:k_alpha) = occupations(ispin, :, iterm)
340 CALL dbcsr_copy(fm_scaled, mo_coeff)
341 CALL dbcsr_scale_by_vector(fm_scaled, scaling, side='right')
342 CALL dbcsr_multiply('n', 't', 1.0_dp, mo_coeff, fm_scaled, &
343 0.0_dp, matrix_p(ispin)%matrix, retain_sparsity=.true.)
344 ! compute the densities on the grid
345 CALL calculate_rho_elec(matrix_p=matrix_p(ispin)%matrix, &
346 rho=rho_r(ispin), rho_gspace=rho_g(ispin), &
347 ks_env=ks_env)
348 END DO
349
350 ! compute the exchange energies / potential if needed
351 IF (just_energy) THEN
352 exc = xc_exc_calc(rho_r=rho_r, rho_g=rho_g, tau=tau, xc_section=xc_section, &
353 pw_pool=xc_pw_pool)
354 ELSE
355 cpassert(.NOT. compute_virial)
356 CALL xc_vxc_pw_create1(vxc_rho=vxc, rho_r=rho_r, &
357 rho_g=rho_g, tau=tau, vxc_tau=vxc_tau, exc=exc, xc_section=xc_section, &
358 pw_pool=xc_pw_pool, compute_virial=.false., virial_xc=virial_xc_tmp)
359 END IF
360
361 energy%exc = energy%exc + energy_scaling(iterm)*exc
362
363 IF (do_hfx) THEN
364 ! Add Hartree-Fock contribution
365 DO ispin = 1, nspin
366 CALL dbcsr_set(matrix_hfx(ispin)%matrix, 0.0_dp)
367 END DO
368 ehfx = energy%ex
369 CALL tddft_hfx_matrix(matrix_hfx, matrix_p, qs_env, &
370 recalc_integrals=.false., update_energy=.true.)
371 energy%ex = ehfx + energy_scaling(iterm)*energy%ex
372 END IF
373
374 ! add the corresponding derivatives to the MO derivatives
375 IF (.NOT. just_energy) THEN
376 ! get the potential in matrix form
377 DO ispin = 1, nspin
378 CALL dbcsr_set(matrix_h(ispin)%matrix, 0.0_dp)
379 ! use a work_v_rspace
380 CALL pw_axpy(vxc(ispin), work_v_rspace, energy_scaling(iterm)*vxc(ispin)%pw_grid%dvol, 0.0_dp)
381 CALL integrate_v_rspace(v_rspace=work_v_rspace, pmat=matrix_p(ispin), hmat=matrix_h(ispin), &
382 qs_env=qs_env, calculate_forces=calculate_forces)
383 CALL auxbas_pw_pool%give_back_pw(vxc(ispin))
384 END DO
385 DEALLOCATE (vxc)
386
387 IF (do_hfx) THEN
388 ! add HFX contribution
389 DO ispin = 1, nspin
390 CALL dbcsr_add(matrix_h(ispin)%matrix, matrix_hfx(ispin)%matrix, &
391 1.0_dp, energy_scaling(iterm))
392 END DO
393 IF (calculate_forces) THEN
394 CALL get_qs_env(qs_env, x_data=x_data, para_env=para_env)
395 IF (x_data(1, 1)%n_rep_hf /= 1) THEN
396 CALL cp_abort(__location__, "Multiple HFX section forces not compatible "// &
397 "with low spin ROKS method.")
398 END IF
399 IF (x_data(1, 1)%do_hfx_ri) THEN
400 CALL cp_abort(__location__, "HFX_RI forces not compatible with low spin ROKS method.")
401 ELSE
402 irep = 1
403 NULLIFY (mdummy)
404 matrix_p2(1:nspin, 1:1) => matrix_p(1:nspin)
405 CALL derivatives_four_center(qs_env, matrix_p2, mdummy, hfx_section, para_env, &
406 irep, compute_virial, &
407 adiabatic_rescale_factor=energy_scaling(iterm))
408 END IF
409 END IF
410
411 END IF
412
413 ! add this to the mo_derivs, again based on the alpha mo_coeff
414 DO ispin = 1, nspin
415 CALL dbcsr_multiply('n', 'n', 1.0_dp, matrix_h(ispin)%matrix, mo_coeff, &
416 0.0_dp, dbcsr_deriv, last_column=k_alpha)
417
418 scaling = 1.0_dp
419 scaling(k_alpha - nelectron + 1:k_alpha) = occupations(ispin, :, iterm)
420 CALL dbcsr_scale_by_vector(dbcsr_deriv, scaling, side='right')
421 CALL dbcsr_add(mo_derivs(1)%matrix, dbcsr_deriv, 1.0_dp, 1.0_dp)
422 END DO
423
424 END IF
425
426 END DO
427
428 ! release allocated memory
429 DO ispin = 1, nspin
430 CALL auxbas_pw_pool%give_back_pw(rho_r(ispin))
431 CALL auxbas_pw_pool%give_back_pw(rho_g(ispin))
432 END DO
433 DEALLOCATE (rho_r, rho_g)
434 CALL dbcsr_deallocate_matrix_set(matrix_p)
435 CALL dbcsr_deallocate_matrix_set(matrix_h)
436 IF (do_hfx) THEN
437 CALL dbcsr_deallocate_matrix_set(matrix_hfx)
438 END IF
439
440 CALL auxbas_pw_pool%give_back_pw(work_v_rspace)
441
442 CALL dbcsr_release_p(fm_deriv)
443 CALL dbcsr_release_p(fm_scaled)
444
445 DEALLOCATE (occupations)
446 DEALLOCATE (energy_scaling)
447 DEALLOCATE (scaling)
448
449 CALL dbcsr_release_p(dbcsr_deriv)
450
451 CALL timestop(handle)
452
453 END SUBROUTINE low_spin_roks
454! **************************************************************************************************
455!> \brief do sic calculations on explicit orbitals
456!> \param energy ...
457!> \param qs_env ...
458!> \param dft_control ...
459!> \param poisson_env ...
460!> \param just_energy ...
461!> \param calculate_forces ...
462!> \param auxbas_pw_pool ...
463! **************************************************************************************************
464 SUBROUTINE sic_explicit_orbitals(energy, qs_env, dft_control, poisson_env, just_energy, &
465 calculate_forces, auxbas_pw_pool)
466
467 TYPE(qs_energy_type), POINTER :: energy
468 TYPE(qs_environment_type), POINTER :: qs_env
469 TYPE(dft_control_type), POINTER :: dft_control
470 TYPE(pw_poisson_type), POINTER :: poisson_env
471 LOGICAL, INTENT(IN) :: just_energy, calculate_forces
472 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
473
474 CHARACTER(*), PARAMETER :: routinen = 'sic_explicit_orbitals'
475
476 INTEGER :: handle, i, iorb, k_alpha, k_beta, norb
477 INTEGER, ALLOCATABLE, DIMENSION(:, :) :: sic_orbital_list
478 LOGICAL :: compute_virial, uniform_occupation
479 REAL(kind=dp) :: ener, exc
480 REAL(kind=dp), DIMENSION(3, 3) :: virial_xc_tmp
481 TYPE(cell_type), POINTER :: cell
482 TYPE(cp_fm_struct_type), POINTER :: fm_struct_tmp
483 TYPE(cp_fm_type) :: matrix_hv, matrix_v
484 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: mo_derivs_local
485 TYPE(cp_fm_type), POINTER :: mo_coeff
486 TYPE(dbcsr_p_type) :: orb_density_matrix_p, orb_h_p
487 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: mo_derivs, rho_ao, tmp_dbcsr
488 TYPE(dbcsr_type), POINTER :: orb_density_matrix, orb_h
489 TYPE(mo_set_type), DIMENSION(:), POINTER :: mo_array
490 TYPE(pw_c1d_gs_type) :: work_v_gspace
491 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
492 TYPE(pw_c1d_gs_type), TARGET :: orb_rho_g, tmp_g
493 TYPE(pw_env_type), POINTER :: pw_env
494 TYPE(pw_pool_type), POINTER :: xc_pw_pool
495 TYPE(pw_r3d_rs_type) :: work_v_rspace
496 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau, vxc, vxc_tau
497 TYPE(pw_r3d_rs_type), TARGET :: orb_rho_r, tmp_r
498 TYPE(qs_ks_env_type), POINTER :: ks_env
499 TYPE(qs_rho_type), POINTER :: rho
500 TYPE(section_vals_type), POINTER :: input, xc_section
501 TYPE(virial_type), POINTER :: virial
502
503 IF (dft_control%sic_method_id .NE. sic_eo) RETURN
504
505 CALL timeset(routinen, handle)
506
507 NULLIFY (tau, vxc_tau, mo_derivs, ks_env, rho_ao)
508
509 ! generate the lists of orbitals that need sic treatment
510 CALL get_qs_env(qs_env, &
511 ks_env=ks_env, &
512 mo_derivs=mo_derivs, &
513 mos=mo_array, &
514 rho=rho, &
515 pw_env=pw_env, &
516 input=input, &
517 cell=cell, &
518 virial=virial)
519
520 CALL qs_rho_get(rho, rho_ao=rho_ao)
521
522 compute_virial = virial%pv_calculate .AND. (.NOT. virial%pv_numer)
523 xc_section => section_vals_get_subs_vals(input, "DFT%XC")
524
525 DO i = 1, SIZE(mo_array) !fm->dbcsr
526 IF (mo_array(i)%use_mo_coeff_b) THEN !fm->dbcsr
527 CALL copy_dbcsr_to_fm(mo_array(i)%mo_coeff_b, &
528 mo_array(i)%mo_coeff) !fm->dbcsr
529 END IF !fm->dbcsr
530 END DO !fm->dbcsr
531
532 CALL pw_env_get(pw_env, xc_pw_pool=xc_pw_pool)
533
534 ! we have two spins
535 cpassert(SIZE(mo_array, 1) == 2)
536 ! we want uniform occupations
537 CALL get_mo_set(mo_set=mo_array(1), uniform_occupation=uniform_occupation)
538 cpassert(uniform_occupation)
539 CALL get_mo_set(mo_set=mo_array(2), mo_coeff=mo_coeff, uniform_occupation=uniform_occupation)
540 cpassert(uniform_occupation)
541
542 NULLIFY (tmp_dbcsr)
543 CALL dbcsr_allocate_matrix_set(tmp_dbcsr, SIZE(mo_derivs, 1))
544 DO i = 1, SIZE(mo_derivs, 1) !fm->dbcsr
545 !
546 NULLIFY (tmp_dbcsr(i)%matrix)
547 CALL dbcsr_init_p(tmp_dbcsr(i)%matrix)
548 CALL dbcsr_copy(tmp_dbcsr(i)%matrix, mo_derivs(i)%matrix)
549 CALL dbcsr_set(tmp_dbcsr(i)%matrix, 0.0_dp)
550 END DO !fm->dbcsr
551
552 k_alpha = 0; k_beta = 0
553 SELECT CASE (dft_control%sic_list_id)
554 CASE (sic_list_all)
555
556 CALL get_mo_set(mo_set=mo_array(1), mo_coeff=mo_coeff)
557 CALL cp_fm_get_info(mo_coeff, ncol_global=k_alpha)
558
559 IF (SIZE(mo_array, 1) > 1) THEN
560 CALL get_mo_set(mo_set=mo_array(2), mo_coeff=mo_coeff)
561 CALL cp_fm_get_info(mo_coeff, ncol_global=k_beta)
562 END IF
563
564 norb = k_alpha + k_beta
565 ALLOCATE (sic_orbital_list(3, norb))
566
567 iorb = 0
568 DO i = 1, k_alpha
569 iorb = iorb + 1
570 sic_orbital_list(1, iorb) = 1
571 sic_orbital_list(2, iorb) = i
572 sic_orbital_list(3, iorb) = 1
573 END DO
574 DO i = 1, k_beta
575 iorb = iorb + 1
576 sic_orbital_list(1, iorb) = 2
577 sic_orbital_list(2, iorb) = i
578 IF (SIZE(mo_derivs, 1) == 1) THEN
579 sic_orbital_list(3, iorb) = 1
580 ELSE
581 sic_orbital_list(3, iorb) = 2
582 END IF
583 END DO
584
585 CASE (sic_list_unpaired)
586 ! we have two spins
587 cpassert(SIZE(mo_array, 1) == 2)
588 ! we have them restricted
589 cpassert(SIZE(mo_derivs, 1) == 1)
590 cpassert(dft_control%restricted)
591
592 CALL get_mo_set(mo_set=mo_array(1), mo_coeff=mo_coeff)
593 CALL cp_fm_get_info(mo_coeff, ncol_global=k_alpha)
594
595 CALL get_mo_set(mo_set=mo_array(2), mo_coeff=mo_coeff)
596 CALL cp_fm_get_info(mo_coeff, ncol_global=k_beta)
597
598 norb = k_alpha - k_beta
599 ALLOCATE (sic_orbital_list(3, norb))
600
601 iorb = 0
602 DO i = k_beta + 1, k_alpha
603 iorb = iorb + 1
604 sic_orbital_list(1, iorb) = 1
605 sic_orbital_list(2, iorb) = i
606 ! we are guaranteed to be restricted
607 sic_orbital_list(3, iorb) = 1
608 END DO
609
610 CASE DEFAULT
611 cpabort("")
612 END SELECT
613
614 ! data needed for each of the orbs
615 CALL auxbas_pw_pool%create_pw(orb_rho_r)
616 CALL auxbas_pw_pool%create_pw(tmp_r)
617 CALL auxbas_pw_pool%create_pw(orb_rho_g)
618 CALL auxbas_pw_pool%create_pw(tmp_g)
619 CALL auxbas_pw_pool%create_pw(work_v_gspace)
620 CALL auxbas_pw_pool%create_pw(work_v_rspace)
621
622 ALLOCATE (orb_density_matrix)
623 CALL dbcsr_copy(orb_density_matrix, rho_ao(1)%matrix, &
624 name="orb_density_matrix")
625 CALL dbcsr_set(orb_density_matrix, 0.0_dp)
626 orb_density_matrix_p%matrix => orb_density_matrix
627
628 ALLOCATE (orb_h)
629 CALL dbcsr_copy(orb_h, rho_ao(1)%matrix, &
630 name="orb_density_matrix")
631 CALL dbcsr_set(orb_h, 0.0_dp)
632 orb_h_p%matrix => orb_h
633
634 CALL get_mo_set(mo_set=mo_array(1), mo_coeff=mo_coeff)
635
636 CALL cp_fm_struct_create(fm_struct_tmp, ncol_global=1, &
637 template_fmstruct=mo_coeff%matrix_struct)
638 CALL cp_fm_create(matrix_v, fm_struct_tmp, name="matrix_v")
639 CALL cp_fm_create(matrix_hv, fm_struct_tmp, name="matrix_hv")
640 CALL cp_fm_struct_release(fm_struct_tmp)
641
642 ALLOCATE (mo_derivs_local(SIZE(mo_array, 1)))
643 DO i = 1, SIZE(mo_array, 1)
644 CALL get_mo_set(mo_set=mo_array(i), mo_coeff=mo_coeff)
645 CALL cp_fm_create(mo_derivs_local(i), mo_coeff%matrix_struct)
646 END DO
647
648 ALLOCATE (rho_r(2))
649 rho_r(1) = orb_rho_r
650 rho_r(2) = tmp_r
651 CALL pw_zero(tmp_r)
652
653 ALLOCATE (rho_g(2))
654 rho_g(1) = orb_rho_g
655 rho_g(2) = tmp_g
656 CALL pw_zero(tmp_g)
657
658 NULLIFY (vxc)
659 ! now apply to SIC correction to each selected orbital
660 DO iorb = 1, norb
661 ! extract the proper orbital from the mo_coeff
662 CALL get_mo_set(mo_set=mo_array(sic_orbital_list(1, iorb)), mo_coeff=mo_coeff)
663 CALL cp_fm_to_fm(mo_coeff, matrix_v, 1, sic_orbital_list(2, iorb), 1)
664
665 ! construct the density matrix and the corresponding density
666 CALL dbcsr_set(orb_density_matrix, 0.0_dp)
667 CALL cp_dbcsr_plus_fm_fm_t(orb_density_matrix, matrix_v=matrix_v, ncol=1, &
668 alpha=1.0_dp)
669
670 CALL calculate_rho_elec(matrix_p=orb_density_matrix, &
671 rho=orb_rho_r, rho_gspace=orb_rho_g, &
672 ks_env=ks_env)
673
674 ! compute the energy functional for this orbital and its derivative
675
676 CALL pw_poisson_solve(poisson_env, orb_rho_g, ener, work_v_gspace)
677 ! no PBC correction is done here, see "calc_v_sic_rspace" for SIC methods
678 ! with PBC aware corrections
679 energy%hartree = energy%hartree - dft_control%sic_scaling_a*ener
680 IF (.NOT. just_energy) THEN
681 CALL pw_transfer(work_v_gspace, work_v_rspace)
682 CALL pw_scale(work_v_rspace, -dft_control%sic_scaling_a*work_v_rspace%pw_grid%dvol)
683 CALL dbcsr_set(orb_h, 0.0_dp)
684 END IF
685
686 IF (just_energy) THEN
687 exc = xc_exc_calc(rho_r=rho_r, rho_g=rho_g, tau=tau, xc_section=xc_section, &
688 pw_pool=xc_pw_pool)
689 ELSE
690 cpassert(.NOT. compute_virial)
691 CALL xc_vxc_pw_create1(vxc_rho=vxc, rho_r=rho_r, &
692 rho_g=rho_g, tau=tau, vxc_tau=vxc_tau, exc=exc, xc_section=xc_section, &
693 pw_pool=xc_pw_pool, compute_virial=compute_virial, virial_xc=virial_xc_tmp)
694 ! add to the existing work_v_rspace
695 CALL pw_axpy(vxc(1), work_v_rspace, -dft_control%sic_scaling_b*vxc(1)%pw_grid%dvol)
696 END IF
697 energy%exc = energy%exc - dft_control%sic_scaling_b*exc
698
699 IF (.NOT. just_energy) THEN
700 ! note, orb_h (which is being pointed to with orb_h_p) is zeroed above
701 CALL integrate_v_rspace(v_rspace=work_v_rspace, pmat=orb_density_matrix_p, hmat=orb_h_p, &
702 qs_env=qs_env, calculate_forces=calculate_forces)
703
704 ! add this to the mo_derivs
705 CALL cp_dbcsr_sm_fm_multiply(orb_h, matrix_v, matrix_hv, 1)
706 ! silly trick, copy to an array of the right size and add to mo_derivs
707 CALL cp_fm_set_all(mo_derivs_local(sic_orbital_list(3, iorb)), 0.0_dp)
708 CALL cp_fm_to_fm(matrix_hv, mo_derivs_local(sic_orbital_list(3, iorb)), 1, 1, sic_orbital_list(2, iorb))
709 CALL copy_fm_to_dbcsr(mo_derivs_local(sic_orbital_list(3, iorb)), &
710 tmp_dbcsr(sic_orbital_list(3, iorb))%matrix)
711 CALL dbcsr_add(mo_derivs(sic_orbital_list(3, iorb))%matrix, &
712 tmp_dbcsr(sic_orbital_list(3, iorb))%matrix, 1.0_dp, 1.0_dp)
713 !
714 ! need to deallocate vxc
715 CALL xc_pw_pool%give_back_pw(vxc(1))
716 CALL xc_pw_pool%give_back_pw(vxc(2))
717 DEALLOCATE (vxc)
718
719 END IF
720
721 END DO
722
723 CALL auxbas_pw_pool%give_back_pw(orb_rho_r)
724 CALL auxbas_pw_pool%give_back_pw(tmp_r)
725 CALL auxbas_pw_pool%give_back_pw(orb_rho_g)
726 CALL auxbas_pw_pool%give_back_pw(tmp_g)
727 CALL auxbas_pw_pool%give_back_pw(work_v_gspace)
728 CALL auxbas_pw_pool%give_back_pw(work_v_rspace)
729
730 CALL dbcsr_deallocate_matrix(orb_density_matrix)
731 CALL dbcsr_deallocate_matrix(orb_h)
732 CALL cp_fm_release(matrix_v)
733 CALL cp_fm_release(matrix_hv)
734 CALL cp_fm_release(mo_derivs_local)
735 DEALLOCATE (rho_r)
736 DEALLOCATE (rho_g)
737
738 CALL dbcsr_deallocate_matrix_set(tmp_dbcsr) !fm->dbcsr
739
740 CALL timestop(handle)
741
742 END SUBROUTINE sic_explicit_orbitals
743
744! **************************************************************************************************
745!> \brief do sic calculations on the spin density
746!> \param v_sic_rspace ...
747!> \param energy ...
748!> \param qs_env ...
749!> \param dft_control ...
750!> \param rho ...
751!> \param poisson_env ...
752!> \param just_energy ...
753!> \param calculate_forces ...
754!> \param auxbas_pw_pool ...
755! **************************************************************************************************
756 SUBROUTINE calc_v_sic_rspace(v_sic_rspace, energy, &
757 qs_env, dft_control, rho, poisson_env, just_energy, &
758 calculate_forces, auxbas_pw_pool)
759
760 TYPE(pw_r3d_rs_type), POINTER :: v_sic_rspace
761 TYPE(qs_energy_type), POINTER :: energy
762 TYPE(qs_environment_type), POINTER :: qs_env
763 TYPE(dft_control_type), POINTER :: dft_control
764 TYPE(qs_rho_type), POINTER :: rho
765 TYPE(pw_poisson_type), POINTER :: poisson_env
766 LOGICAL, INTENT(IN) :: just_energy, calculate_forces
767 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
768
769 INTEGER :: i, nelec, nelec_a, nelec_b, nforce
770 REAL(kind=dp) :: ener, full_scaling, scaling
771 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: store_forces
772 TYPE(mo_set_type), DIMENSION(:), POINTER :: mo_array
773 TYPE(pw_c1d_gs_type) :: work_rho, work_v
774 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
775 TYPE(qs_force_type), DIMENSION(:), POINTER :: force
776
777 NULLIFY (mo_array, rho_g)
778
779 IF (dft_control%sic_method_id == sic_none) RETURN
780 IF (dft_control%sic_method_id == sic_eo) RETURN
781
782 IF (dft_control%qs_control%gapw) &
783 cpabort("sic and GAPW not yet compatible")
784
785 ! OK, right now we like two spins to do sic, could be relaxed for AD
786 cpassert(dft_control%nspins == 2)
787
788 CALL auxbas_pw_pool%create_pw(work_rho)
789 CALL auxbas_pw_pool%create_pw(work_v)
790
791 CALL qs_rho_get(rho, rho_g=rho_g)
792
793 ! Hartree sic corrections
794 SELECT CASE (dft_control%sic_method_id)
796 CALL pw_copy(rho_g(1), work_rho)
797 CALL pw_axpy(rho_g(2), work_rho, alpha=-1._dp)
798 CALL pw_poisson_solve(poisson_env, work_rho, ener, work_v)
799 CASE (sic_ad)
800 ! find out how many elecs we have
801 CALL get_qs_env(qs_env, mos=mo_array)
802 CALL get_mo_set(mo_set=mo_array(1), nelectron=nelec_a)
803 CALL get_mo_set(mo_set=mo_array(2), nelectron=nelec_b)
804 nelec = nelec_a + nelec_b
805 CALL pw_copy(rho_g(1), work_rho)
806 CALL pw_axpy(rho_g(2), work_rho)
807 scaling = 1.0_dp/real(nelec, kind=dp)
808 CALL pw_scale(work_rho, scaling)
809 CALL pw_poisson_solve(poisson_env, work_rho, ener, work_v)
810 CASE DEFAULT
811 cpabort("Unknown sic method id")
812 END SELECT
813
814 ! Correct for DDAP charges (if any)
815 ! storing whatever force might be there from previous decoupling
816 IF (calculate_forces) THEN
817 CALL get_qs_env(qs_env=qs_env, force=force)
818 nforce = 0
819 DO i = 1, SIZE(force)
820 nforce = nforce + SIZE(force(i)%ch_pulay, 2)
821 END DO
822 ALLOCATE (store_forces(3, nforce))
823 nforce = 0
824 DO i = 1, SIZE(force)
825 store_forces(1:3, nforce + 1:nforce + SIZE(force(i)%ch_pulay, 2)) = force(i)%ch_pulay(:, :)
826 force(i)%ch_pulay(:, :) = 0.0_dp
827 nforce = nforce + SIZE(force(i)%ch_pulay, 2)
828 END DO
829 END IF
830
831 CALL cp_ddapc_apply_cd(qs_env, &
832 work_rho, &
833 ener, &
834 v_hartree_gspace=work_v, &
835 calculate_forces=calculate_forces, &
836 itype_of_density="SPIN")
837
838 SELECT CASE (dft_control%sic_method_id)
840 full_scaling = -dft_control%sic_scaling_a
841 CASE (sic_ad)
842 full_scaling = -dft_control%sic_scaling_a*nelec
843 CASE DEFAULT
844 cpabort("Unknown sic method id")
845 END SELECT
846 energy%hartree = energy%hartree + full_scaling*ener
847
848 ! add scaled forces, restoring the old
849 IF (calculate_forces) THEN
850 nforce = 0
851 DO i = 1, SIZE(force)
852 force(i)%ch_pulay(:, :) = force(i)%ch_pulay(:, :)*full_scaling + &
853 store_forces(1:3, nforce + 1:nforce + SIZE(force(i)%ch_pulay, 2))
854 nforce = nforce + SIZE(force(i)%ch_pulay, 2)
855 END DO
856 END IF
857
858 IF (.NOT. just_energy) THEN
859 ALLOCATE (v_sic_rspace)
860 CALL auxbas_pw_pool%create_pw(v_sic_rspace)
861 CALL pw_transfer(work_v, v_sic_rspace)
862 ! also take into account the scaling (in addition to the volume element)
863 CALL pw_scale(v_sic_rspace, &
864 dft_control%sic_scaling_a*v_sic_rspace%pw_grid%dvol)
865 END IF
866
867 CALL auxbas_pw_pool%give_back_pw(work_rho)
868 CALL auxbas_pw_pool%give_back_pw(work_v)
869
870 END SUBROUTINE calc_v_sic_rspace
871
872! **************************************************************************************************
873!> \brief ...
874!> \param qs_env ...
875!> \param rho ...
876! **************************************************************************************************
877 SUBROUTINE print_densities(qs_env, rho)
878 TYPE(qs_environment_type), POINTER :: qs_env
879 TYPE(qs_rho_type), POINTER :: rho
880
881 INTEGER :: img, ispin, n_electrons, output_unit
882 REAL(dp) :: tot1_h, tot1_s, tot_rho_r, trace, &
883 trace_tmp
884 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_r_arr
885 TYPE(cell_type), POINTER :: cell
886 TYPE(cp_logger_type), POINTER :: logger
887 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_s, rho_ao
888 TYPE(dft_control_type), POINTER :: dft_control
889 TYPE(qs_charges_type), POINTER :: qs_charges
890 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
891 TYPE(section_vals_type), POINTER :: input, scf_section
892
893 NULLIFY (qs_charges, qs_kind_set, cell, input, logger, scf_section, matrix_s, &
894 dft_control, tot_rho_r_arr, rho_ao)
895
896 logger => cp_get_default_logger()
897
898 CALL get_qs_env(qs_env, &
899 qs_kind_set=qs_kind_set, &
900 cell=cell, qs_charges=qs_charges, &
901 input=input, &
902 matrix_s_kp=matrix_s, &
903 dft_control=dft_control)
904
905 CALL get_qs_kind_set(qs_kind_set, nelectron=n_electrons)
906
907 scf_section => section_vals_get_subs_vals(input, "DFT%SCF")
908 output_unit = cp_print_key_unit_nr(logger, scf_section, "PRINT%TOTAL_DENSITIES", &
909 extension=".scfLog")
910
911 CALL qs_rho_get(rho, tot_rho_r=tot_rho_r_arr, rho_ao_kp=rho_ao)
912 n_electrons = n_electrons - dft_control%charge
913 tot_rho_r = accurate_sum(tot_rho_r_arr)
914
915 trace = 0
916 IF (btest(cp_print_key_should_output(logger%iter_info, scf_section, "PRINT%TOTAL_DENSITIES"), cp_p_file)) THEN
917 DO ispin = 1, dft_control%nspins
918 DO img = 1, dft_control%nimages
919 CALL dbcsr_dot(rho_ao(ispin, img)%matrix, matrix_s(1, img)%matrix, trace_tmp)
920 trace = trace + trace_tmp
921 END DO
922 END DO
923 END IF
924
925 IF (output_unit > 0) THEN
926 WRITE (unit=output_unit, fmt="(/,T3,A,T41,F20.10)") "Trace(PS):", trace
927 WRITE (unit=output_unit, fmt="((T3,A,T41,2F20.10))") &
928 "Electronic density on regular grids: ", &
929 tot_rho_r, &
930 tot_rho_r + &
931 REAL(n_electrons, dp), &
932 "Core density on regular grids:", &
933 qs_charges%total_rho_core_rspace, &
934 qs_charges%total_rho_core_rspace - REAL(n_electrons + dft_control%charge, dp)
935 END IF
936 IF (dft_control%qs_control%gapw) THEN
937 tot1_h = qs_charges%total_rho1_hard(1)
938 tot1_s = qs_charges%total_rho1_soft(1)
939 DO ispin = 2, dft_control%nspins
940 tot1_h = tot1_h + qs_charges%total_rho1_hard(ispin)
941 tot1_s = tot1_s + qs_charges%total_rho1_soft(ispin)
942 END DO
943 IF (output_unit > 0) THEN
944 WRITE (unit=output_unit, fmt="((T3,A,T41,2F20.10))") &
945 "Hard and soft densities (Lebedev):", &
946 tot1_h, tot1_s
947 WRITE (unit=output_unit, fmt="(T3,A,T41,F20.10)") &
948 "Total Rho_soft + Rho1_hard - Rho1_soft (r-space): ", &
949 tot_rho_r + tot1_h - tot1_s, &
950 "Total charge density (r-space): ", &
951 tot_rho_r + tot1_h - tot1_s &
952 + qs_charges%total_rho_core_rspace, &
953 "Total Rho_soft + Rho0_soft (g-space):", &
954 qs_charges%total_rho_gspace
955 END IF
956 qs_charges%background = tot_rho_r + tot1_h - tot1_s + &
957 qs_charges%total_rho_core_rspace
958 ELSE IF (dft_control%qs_control%gapw_xc) THEN
959 tot1_h = qs_charges%total_rho1_hard(1)
960 tot1_s = qs_charges%total_rho1_soft(1)
961 DO ispin = 2, dft_control%nspins
962 tot1_h = tot1_h + qs_charges%total_rho1_hard(ispin)
963 tot1_s = tot1_s + qs_charges%total_rho1_soft(ispin)
964 END DO
965 IF (output_unit > 0) THEN
966 WRITE (unit=output_unit, fmt="(/,(T3,A,T41,2F20.10))") &
967 "Hard and soft densities (Lebedev):", &
968 tot1_h, tot1_s
969 WRITE (unit=output_unit, fmt="(T3,A,T41,F20.10)") &
970 "Total Rho_soft + Rho1_hard - Rho1_soft (r-space): ", &
971 accurate_sum(tot_rho_r_arr) + tot1_h - tot1_s
972 END IF
973 qs_charges%background = tot_rho_r + &
974 qs_charges%total_rho_core_rspace
975 ELSE
976 IF (output_unit > 0) THEN
977 WRITE (unit=output_unit, fmt="(T3,A,T41,F20.10)") &
978 "Total charge density on r-space grids: ", &
979 tot_rho_r + &
980 qs_charges%total_rho_core_rspace, &
981 "Total charge density g-space grids: ", &
982 qs_charges%total_rho_gspace
983 END IF
984 qs_charges%background = tot_rho_r + &
985 qs_charges%total_rho_core_rspace
986 END IF
987 IF (output_unit > 0) WRITE (unit=output_unit, fmt="()")
988 qs_charges%background = qs_charges%background/cell%deth
989
990 CALL cp_print_key_finished_output(output_unit, logger, scf_section, &
991 "PRINT%TOTAL_DENSITIES")
992
993 END SUBROUTINE print_densities
994
995! **************************************************************************************************
996!> \brief Print detailed energies
997!>
998!> \param qs_env ...
999!> \param dft_control ...
1000!> \param input ...
1001!> \param energy ...
1002!> \param mulliken_order_p ...
1003!> \par History
1004!> refactoring 04.03.2011 [MI]
1005!> \author
1006! **************************************************************************************************
1007 SUBROUTINE print_detailed_energy(qs_env, dft_control, input, energy, mulliken_order_p)
1008
1009 TYPE(qs_environment_type), POINTER :: qs_env
1010 TYPE(dft_control_type), POINTER :: dft_control
1011 TYPE(section_vals_type), POINTER :: input
1012 TYPE(qs_energy_type), POINTER :: energy
1013 REAL(kind=dp), INTENT(IN) :: mulliken_order_p
1014
1015 INTEGER :: bc, n, output_unit, psolver
1016 REAL(kind=dp) :: ddapc_order_p, implicit_ps_ehartree, &
1017 s2_order_p
1018 TYPE(cp_logger_type), POINTER :: logger
1019 TYPE(pw_env_type), POINTER :: pw_env
1020
1021 logger => cp_get_default_logger()
1022
1023 NULLIFY (pw_env)
1024 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env)
1025 psolver = pw_env%poisson_env%parameters%solver
1026
1027 output_unit = cp_print_key_unit_nr(logger, input, "DFT%SCF%PRINT%DETAILED_ENERGY", &
1028 extension=".scfLog")
1029 IF (output_unit > 0) THEN
1030 IF (dft_control%do_admm) THEN
1031 WRITE (unit=output_unit, fmt="((T3,A,T60,F20.10))") &
1032 "Wfn fit exchange-correlation energy: ", energy%exc_aux_fit
1033 IF (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc) THEN
1034 WRITE (unit=output_unit, fmt="((T3,A,T60,F20.10))") &
1035 "Wfn fit soft/hard atomic rho1 Exc contribution: ", energy%exc1_aux_fit
1036 END IF
1037 END IF
1038 IF (dft_control%do_admm) THEN
1039 IF (psolver .EQ. pw_poisson_implicit) THEN
1040 implicit_ps_ehartree = pw_env%poisson_env%implicit_env%ehartree
1041 bc = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
1042 SELECT CASE (bc)
1044 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1045 "Core Hamiltonian energy: ", energy%core, &
1046 "Hartree energy: ", implicit_ps_ehartree, &
1047 "Electric enthalpy: ", energy%hartree, &
1048 "Exchange-correlation energy: ", energy%exc + energy%exc_aux_fit
1049 CASE (periodic_bc, neumann_bc)
1050 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1051 "Core Hamiltonian energy: ", energy%core, &
1052 "Hartree energy: ", energy%hartree, &
1053 "Exchange-correlation energy: ", energy%exc + energy%exc_aux_fit
1054 END SELECT
1055 ELSE
1056 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1057 "Core Hamiltonian energy: ", energy%core, &
1058 "Hartree energy: ", energy%hartree, &
1059 "Exchange-correlation energy: ", energy%exc + energy%exc_aux_fit
1060 END IF
1061 ELSE
1062!ZMP to print some variables at each step
1063 IF (dft_control%apply_external_density) THEN
1064 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1065 "DOING ZMP CALCULATION FROM EXTERNAL DENSITY "
1066 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1067 "Core Hamiltonian energy: ", energy%core, &
1068 "Hartree energy: ", energy%hartree
1069 ELSE IF (dft_control%apply_external_vxc) THEN
1070 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1071 "DOING ZMP READING EXTERNAL VXC "
1072 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1073 "Core Hamiltonian energy: ", energy%core, &
1074 "Hartree energy: ", energy%hartree
1075 ELSE
1076 IF (psolver .EQ. pw_poisson_implicit) THEN
1077 implicit_ps_ehartree = pw_env%poisson_env%implicit_env%ehartree
1078 bc = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
1079 SELECT CASE (bc)
1081 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1082 "Core Hamiltonian energy: ", energy%core, &
1083 "Hartree energy: ", implicit_ps_ehartree, &
1084 "Electric enthalpy: ", energy%hartree, &
1085 "Exchange-correlation energy: ", energy%exc
1086 CASE (periodic_bc, neumann_bc)
1087 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1088 "Core Hamiltonian energy: ", energy%core, &
1089 "Hartree energy: ", energy%hartree, &
1090 "Exchange-correlation energy: ", energy%exc
1091 END SELECT
1092 ELSE
1093 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1094 "Core Hamiltonian energy: ", energy%core, &
1095 "Hartree energy: ", energy%hartree, &
1096 "Exchange-correlation energy: ", energy%exc
1097 END IF
1098 END IF
1099 END IF
1100
1101 IF (dft_control%apply_external_density) THEN
1102 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1103 "Integral of the (density * v_xc): ", energy%exc
1104 END IF
1105
1106 IF (energy%e_hartree /= 0.0_dp) &
1107 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1108 "Coulomb (electron-electron) energy: ", energy%e_hartree
1109 IF (energy%dispersion /= 0.0_dp) &
1110 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1111 "Dispersion energy: ", energy%dispersion
1112 IF (energy%efield /= 0.0_dp) &
1113 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1114 "Electric field interaction energy: ", energy%efield
1115 IF (energy%gcp /= 0.0_dp) &
1116 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1117 "gCP energy: ", energy%gcp
1118 IF (dft_control%qs_control%gapw) THEN
1119 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1120 "GAPW| Exc from hard and soft atomic rho1: ", energy%exc1 + energy%exc1_aux_fit, &
1121 "GAPW| local Eh = 1 center integrals: ", energy%hartree_1c
1122 END IF
1123 IF (dft_control%qs_control%gapw_xc) THEN
1124 WRITE (unit=output_unit, fmt="(/,(T3,A,T61,F20.10))") &
1125 "GAPW| Exc from hard and soft atomic rho1: ", energy%exc1 + energy%exc1_aux_fit
1126 END IF
1127 IF (dft_control%dft_plus_u) THEN
1128 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1129 "DFT+U energy:", energy%dft_plus_u
1130 END IF
1131 IF (qs_env%qmmm) THEN
1132 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1133 "QM/MM Electrostatic energy: ", energy%qmmm_el
1134 IF (qs_env%qmmm_env_qm%image_charge) THEN
1135 WRITE (unit=output_unit, fmt="(T3,A,T61,F20.10)") &
1136 "QM/MM image charge energy: ", energy%image_charge
1137 END IF
1138 END IF
1139 IF (dft_control%qs_control%mulliken_restraint) THEN
1140 WRITE (unit=output_unit, fmt="(T3,A,T41,2F20.10)") &
1141 "Mulliken restraint (order_p,energy) : ", mulliken_order_p, energy%mulliken
1142 END IF
1143 IF (dft_control%qs_control%ddapc_restraint) THEN
1144 DO n = 1, SIZE(dft_control%qs_control%ddapc_restraint_control)
1145 ddapc_order_p = &
1146 dft_control%qs_control%ddapc_restraint_control(n)%ddapc_order_p
1147 WRITE (unit=output_unit, fmt="(T3,A,T41,2F20.10)") &
1148 "DDAPC restraint (order_p,energy) : ", ddapc_order_p, energy%ddapc_restraint(n)
1149 END DO
1150 END IF
1151 IF (dft_control%qs_control%s2_restraint) THEN
1152 s2_order_p = dft_control%qs_control%s2_restraint_control%s2_order_p
1153 WRITE (unit=output_unit, fmt="(T3,A,T41,2F20.10)") &
1154 "S2 restraint (order_p,energy) : ", s2_order_p, energy%s2_restraint
1155 END IF
1156
1157 END IF ! output_unit
1158 CALL cp_print_key_finished_output(output_unit, logger, input, &
1159 "DFT%SCF%PRINT%DETAILED_ENERGY")
1160
1161 END SUBROUTINE print_detailed_energy
1162
1163! **************************************************************************************************
1164!> \brief compute matrix_vxc, defined via the potential created by qs_vxc_create
1165!> ignores things like tau functional, gapw, sic, ...
1166!> so only OK for GGA & GPW right now
1167!> \param qs_env ...
1168!> \param v_rspace ...
1169!> \param matrix_vxc ...
1170!> \par History
1171!> created 23.10.2012 [Joost VandeVondele]
1172!> \author
1173! **************************************************************************************************
1174 SUBROUTINE compute_matrix_vxc(qs_env, v_rspace, matrix_vxc)
1175 TYPE(qs_environment_type), POINTER :: qs_env
1176 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(IN) :: v_rspace
1177 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_vxc
1178
1179 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_matrix_vxc'
1180
1181 INTEGER :: handle, ispin
1182 LOGICAL :: gapw
1183 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks
1184 TYPE(dft_control_type), POINTER :: dft_control
1185
1186 CALL timeset(routinen, handle)
1187
1188 ! create the matrix using matrix_ks as a template
1189 IF (ASSOCIATED(matrix_vxc)) THEN
1190 CALL dbcsr_deallocate_matrix_set(matrix_vxc)
1191 END IF
1192 CALL get_qs_env(qs_env, matrix_ks=matrix_ks)
1193 ALLOCATE (matrix_vxc(SIZE(matrix_ks)))
1194 DO ispin = 1, SIZE(matrix_ks)
1195 NULLIFY (matrix_vxc(ispin)%matrix)
1196 CALL dbcsr_init_p(matrix_vxc(ispin)%matrix)
1197 CALL dbcsr_copy(matrix_vxc(ispin)%matrix, matrix_ks(ispin)%matrix, &
1198 name="Matrix VXC of spin "//cp_to_string(ispin))
1199 CALL dbcsr_set(matrix_vxc(ispin)%matrix, 0.0_dp)
1200 END DO
1201
1202 ! and integrate
1203 CALL get_qs_env(qs_env, dft_control=dft_control)
1204 gapw = dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc
1205 DO ispin = 1, SIZE(matrix_ks)
1206 CALL integrate_v_rspace(v_rspace=v_rspace(ispin), &
1207 hmat=matrix_vxc(ispin), &
1208 qs_env=qs_env, &
1209 calculate_forces=.false., &
1210 gapw=gapw)
1211 ! scale by the volume element... should really become part of integrate_v_rspace
1212 CALL dbcsr_scale(matrix_vxc(ispin)%matrix, v_rspace(ispin)%pw_grid%dvol)
1213 END DO
1214
1215 CALL timestop(handle)
1216
1217 END SUBROUTINE compute_matrix_vxc
1218
1219! **************************************************************************************************
1220!> \brief Sum up all potentials defined on the grid and integrate
1221!>
1222!> \param qs_env ...
1223!> \param ks_matrix ...
1224!> \param rho ...
1225!> \param my_rho ...
1226!> \param vppl_rspace ...
1227!> \param v_rspace_new ...
1228!> \param v_rspace_new_aux_fit ...
1229!> \param v_tau_rspace ...
1230!> \param v_tau_rspace_aux_fit ...
1231!> \param v_sic_rspace ...
1232!> \param v_spin_ddapc_rest_r ...
1233!> \param v_sccs_rspace ...
1234!> \param v_rspace_embed ...
1235!> \param cdft_control ...
1236!> \param calculate_forces ...
1237!> \par History
1238!> - refactoring 04.03.2011 [MI]
1239!> - SCCS implementation (16.10.2013,MK)
1240!> \author
1241! **************************************************************************************************
1242 SUBROUTINE sum_up_and_integrate(qs_env, ks_matrix, rho, my_rho, &
1243 vppl_rspace, v_rspace_new, &
1244 v_rspace_new_aux_fit, v_tau_rspace, &
1245 v_tau_rspace_aux_fit, &
1246 v_sic_rspace, v_spin_ddapc_rest_r, &
1247 v_sccs_rspace, v_rspace_embed, cdft_control, &
1248 calculate_forces)
1249
1250 TYPE(qs_environment_type), POINTER :: qs_env
1251 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ks_matrix
1252 TYPE(qs_rho_type), POINTER :: rho
1253 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: my_rho
1254 TYPE(pw_r3d_rs_type), POINTER :: vppl_rspace
1255 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_rspace_new, v_rspace_new_aux_fit, &
1256 v_tau_rspace, v_tau_rspace_aux_fit
1257 TYPE(pw_r3d_rs_type), POINTER :: v_sic_rspace, v_spin_ddapc_rest_r, &
1258 v_sccs_rspace
1259 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_rspace_embed
1260 TYPE(cdft_control_type), POINTER :: cdft_control
1261 LOGICAL, INTENT(in) :: calculate_forces
1262
1263 CHARACTER(LEN=*), PARAMETER :: routinen = 'sum_up_and_integrate'
1264
1265 CHARACTER(LEN=default_string_length) :: basis_type
1266 INTEGER :: handle, igroup, ikind, img, ispin, &
1267 nkind, nspins
1268 INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index
1269 LOGICAL :: do_ppl, gapw, gapw_xc, lrigpw, rigpw
1270 REAL(kind=dp) :: csign, dvol, fadm
1271 TYPE(admm_type), POINTER :: admm_env
1272 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1273 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ksmat, rho_ao, rho_ao_nokp, smat
1274 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_ks_aux_fit, &
1275 matrix_ks_aux_fit_dft, rho_ao_aux, &
1276 rho_ao_kp
1277 TYPE(dft_control_type), POINTER :: dft_control
1278 TYPE(kpoint_type), POINTER :: kpoints
1279 TYPE(lri_density_type), POINTER :: lri_density
1280 TYPE(lri_environment_type), POINTER :: lri_env
1281 TYPE(lri_kind_type), DIMENSION(:), POINTER :: lri_v_int
1282 TYPE(mp_para_env_type), POINTER :: para_env
1283 TYPE(pw_env_type), POINTER :: pw_env
1284 TYPE(pw_poisson_type), POINTER :: poisson_env
1285 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1286 TYPE(pw_r3d_rs_type), POINTER :: v_rspace, vee
1287 TYPE(qs_ks_env_type), POINTER :: ks_env
1288 TYPE(qs_rho_type), POINTER :: rho_aux_fit
1289 TYPE(task_list_type), POINTER :: task_list
1290
1291 CALL timeset(routinen, handle)
1292
1293 NULLIFY (auxbas_pw_pool, dft_control, pw_env, matrix_ks_aux_fit, &
1294 v_rspace, rho_aux_fit, vee, rho_ao, rho_ao_kp, rho_ao_aux, &
1295 ksmat, matrix_ks_aux_fit_dft, lri_env, lri_density, atomic_kind_set, &
1296 rho_ao_nokp, ks_env, admm_env, task_list)
1297
1298 CALL get_qs_env(qs_env, &
1299 dft_control=dft_control, &
1300 pw_env=pw_env, &
1301 v_hartree_rspace=v_rspace, &
1302 vee=vee)
1303
1304 CALL qs_rho_get(rho, rho_ao_kp=rho_ao_kp)
1305 CALL pw_env_get(pw_env, poisson_env=poisson_env, auxbas_pw_pool=auxbas_pw_pool)
1306 gapw = dft_control%qs_control%gapw
1307 gapw_xc = dft_control%qs_control%gapw_xc
1308 do_ppl = dft_control%qs_control%do_ppl_method == do_ppl_grid
1309
1310 rigpw = dft_control%qs_control%rigpw
1311 lrigpw = dft_control%qs_control%lrigpw
1312 IF (lrigpw .OR. rigpw) THEN
1313 CALL get_qs_env(qs_env, &
1314 lri_env=lri_env, &
1315 lri_density=lri_density, &
1316 atomic_kind_set=atomic_kind_set)
1317 END IF
1318
1319 nspins = dft_control%nspins
1320
1321 ! sum up potentials and integrate
1322 IF (ASSOCIATED(v_rspace_new)) THEN
1323 DO ispin = 1, nspins
1324 IF (gapw_xc) THEN
1325 ! SIC not implemented (or at least not tested)
1326 cpassert(dft_control%sic_method_id == sic_none)
1327 !Only the xc potential, because it has to be integrated with the soft basis
1328 CALL pw_scale(v_rspace_new(ispin), v_rspace_new(ispin)%pw_grid%dvol)
1329
1330 ! add the xc part due to v_rspace soft
1331 rho_ao => rho_ao_kp(ispin, :)
1332 ksmat => ks_matrix(ispin, :)
1333 CALL integrate_v_rspace(v_rspace=v_rspace_new(ispin), &
1334 pmat_kp=rho_ao, hmat_kp=ksmat, &
1335 qs_env=qs_env, &
1336 calculate_forces=calculate_forces, &
1337 gapw=gapw_xc)
1338
1339 ! Now the Hartree potential to be integrated with the full basis
1340 CALL pw_copy(v_rspace, v_rspace_new(ispin))
1341 ELSE
1342 ! Add v_hartree + v_xc = v_rspace_new
1343 CALL pw_axpy(v_rspace, v_rspace_new(ispin), 1.0_dp, v_rspace_new(ispin)%pw_grid%dvol)
1344 END IF ! gapw_xc
1345 IF (dft_control%qs_control%ddapc_explicit_potential) THEN
1346 IF (dft_control%qs_control%ddapc_restraint_is_spin) THEN
1347 IF (ispin == 1) THEN
1348 CALL pw_axpy(v_spin_ddapc_rest_r, v_rspace_new(ispin), 1.0_dp)
1349 ELSE
1350 CALL pw_axpy(v_spin_ddapc_rest_r, v_rspace_new(ispin), -1.0_dp)
1351 END IF
1352 ELSE
1353 CALL pw_axpy(v_spin_ddapc_rest_r, v_rspace_new(ispin), 1.0_dp)
1354 END IF
1355 END IF
1356 ! CDFT constraint contribution
1357 IF (dft_control%qs_control%cdft) THEN
1358 DO igroup = 1, SIZE(cdft_control%group)
1359 SELECT CASE (cdft_control%group(igroup)%constraint_type)
1361 csign = 1.0_dp
1363 IF (ispin == 1) THEN
1364 csign = 1.0_dp
1365 ELSE
1366 csign = -1.0_dp
1367 END IF
1369 csign = 1.0_dp
1370 IF (ispin == 2) cycle
1372 csign = 1.0_dp
1373 IF (ispin == 1) cycle
1374 CASE DEFAULT
1375 cpabort("Unknown constraint type.")
1376 END SELECT
1377 CALL pw_axpy(cdft_control%group(igroup)%weight, v_rspace_new(ispin), &
1378 csign*cdft_control%strength(igroup))
1379 END DO
1380 END IF
1381 ! functional derivative of the Hartree energy wrt the density in the presence of dielectric
1382 ! (vhartree + v_eps); v_eps is nonzero only if the dielectric constant is defind as a function
1383 ! of the charge density
1384 IF (poisson_env%parameters%solver .EQ. pw_poisson_implicit) THEN
1385 dvol = poisson_env%implicit_env%v_eps%pw_grid%dvol
1386 CALL pw_axpy(poisson_env%implicit_env%v_eps, v_rspace_new(ispin), dvol)
1387 END IF
1388 ! Add SCCS contribution
1389 IF (dft_control%do_sccs) THEN
1390 CALL pw_axpy(v_sccs_rspace, v_rspace_new(ispin))
1391 END IF
1392 ! External electrostatic potential
1393 IF (dft_control%apply_external_potential) THEN
1394 CALL qmmm_modify_hartree_pot(v_hartree=v_rspace_new(ispin), &
1395 v_qmmm=vee, scale=-1.0_dp)
1396 END IF
1397 IF (do_ppl) THEN
1398 cpassert(.NOT. gapw)
1399 CALL pw_axpy(vppl_rspace, v_rspace_new(ispin), vppl_rspace%pw_grid%dvol)
1400 END IF
1401 ! the electrostatic sic contribution
1402 SELECT CASE (dft_control%sic_method_id)
1403 CASE (sic_none)
1404 !
1406 IF (ispin == 1) THEN
1407 CALL pw_axpy(v_sic_rspace, v_rspace_new(ispin), -1.0_dp)
1408 ELSE
1409 CALL pw_axpy(v_sic_rspace, v_rspace_new(ispin), 1.0_dp)
1410 END IF
1411 CASE (sic_ad)
1412 CALL pw_axpy(v_sic_rspace, v_rspace_new(ispin), -1.0_dp)
1413 CASE (sic_eo)
1414 ! NOTHING TO BE DONE
1415 END SELECT
1416 ! DFT embedding
1417 IF (dft_control%apply_embed_pot) THEN
1418 CALL pw_axpy(v_rspace_embed(ispin), v_rspace_new(ispin), v_rspace_embed(ispin)%pw_grid%dvol)
1419 CALL auxbas_pw_pool%give_back_pw(v_rspace_embed(ispin))
1420 END IF
1421 IF (lrigpw) THEN
1422 lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds
1423 CALL get_qs_env(qs_env, nkind=nkind, para_env=para_env)
1424 DO ikind = 1, nkind
1425 lri_v_int(ikind)%v_int = 0.0_dp
1426 END DO
1427 CALL integrate_v_rspace_one_center(v_rspace_new(ispin), qs_env, &
1428 lri_v_int, calculate_forces, "LRI_AUX")
1429 DO ikind = 1, nkind
1430 CALL para_env%sum(lri_v_int(ikind)%v_int)
1431 END DO
1432 IF (lri_env%exact_1c_terms) THEN
1433 rho_ao => my_rho(ispin, :)
1434 ksmat => ks_matrix(ispin, :)
1435 CALL integrate_v_rspace_diagonal(v_rspace_new(ispin), ksmat(1)%matrix, &
1436 rho_ao(1)%matrix, qs_env, &
1437 calculate_forces, "ORB")
1438 END IF
1439 IF (lri_env%ppl_ri) THEN
1440 CALL v_int_ppl_update(qs_env, lri_v_int, calculate_forces)
1441 END IF
1442 ELSEIF (rigpw) THEN
1443 lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds
1444 CALL get_qs_env(qs_env, nkind=nkind, para_env=para_env)
1445 DO ikind = 1, nkind
1446 lri_v_int(ikind)%v_int = 0.0_dp
1447 END DO
1448 CALL integrate_v_rspace_one_center(v_rspace_new(ispin), qs_env, &
1449 lri_v_int, calculate_forces, "RI_HXC")
1450 DO ikind = 1, nkind
1451 CALL para_env%sum(lri_v_int(ikind)%v_int)
1452 END DO
1453 ELSE
1454 rho_ao => my_rho(ispin, :)
1455 ksmat => ks_matrix(ispin, :)
1456 CALL integrate_v_rspace(v_rspace=v_rspace_new(ispin), &
1457 pmat_kp=rho_ao, hmat_kp=ksmat, &
1458 qs_env=qs_env, &
1459 calculate_forces=calculate_forces, &
1460 gapw=gapw)
1461 END IF
1462 CALL auxbas_pw_pool%give_back_pw(v_rspace_new(ispin))
1463 END DO ! ispin
1464
1465 SELECT CASE (dft_control%sic_method_id)
1466 CASE (sic_none)
1468 CALL auxbas_pw_pool%give_back_pw(v_sic_rspace)
1469 DEALLOCATE (v_sic_rspace)
1470 END SELECT
1471 DEALLOCATE (v_rspace_new)
1472
1473 ELSE
1474 ! not implemented (or at least not tested)
1475 cpassert(dft_control%sic_method_id == sic_none)
1476 cpassert(.NOT. dft_control%qs_control%ddapc_restraint_is_spin)
1477 DO ispin = 1, nspins
1478 ! extra contribution attributed to the dependency of the dielectric constant to the charge density
1479 IF (poisson_env%parameters%solver .EQ. pw_poisson_implicit) THEN
1480 dvol = poisson_env%implicit_env%v_eps%pw_grid%dvol
1481 CALL pw_axpy(poisson_env%implicit_env%v_eps, v_rspace, dvol)
1482 END IF
1483 ! Add SCCS contribution
1484 IF (dft_control%do_sccs) THEN
1485 CALL pw_axpy(v_sccs_rspace, v_rspace)
1486 END IF
1487 ! DFT embedding
1488 IF (dft_control%apply_embed_pot) THEN
1489 CALL pw_axpy(v_rspace_embed(ispin), v_rspace, v_rspace_embed(ispin)%pw_grid%dvol)
1490 CALL auxbas_pw_pool%give_back_pw(v_rspace_embed(ispin))
1491 END IF
1492 IF (lrigpw) THEN
1493 lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds
1494 CALL get_qs_env(qs_env, nkind=nkind, para_env=para_env)
1495 DO ikind = 1, nkind
1496 lri_v_int(ikind)%v_int = 0.0_dp
1497 END DO
1498 CALL integrate_v_rspace_one_center(v_rspace, qs_env, &
1499 lri_v_int, calculate_forces, "LRI_AUX")
1500 DO ikind = 1, nkind
1501 CALL para_env%sum(lri_v_int(ikind)%v_int)
1502 END DO
1503 IF (lri_env%exact_1c_terms) THEN
1504 rho_ao => my_rho(ispin, :)
1505 ksmat => ks_matrix(ispin, :)
1506 CALL integrate_v_rspace_diagonal(v_rspace, ksmat(1)%matrix, &
1507 rho_ao(1)%matrix, qs_env, &
1508 calculate_forces, "ORB")
1509 END IF
1510 IF (lri_env%ppl_ri) THEN
1511 CALL v_int_ppl_update(qs_env, lri_v_int, calculate_forces)
1512 END IF
1513 ELSEIF (rigpw) THEN
1514 lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds
1515 CALL get_qs_env(qs_env, nkind=nkind, para_env=para_env)
1516 DO ikind = 1, nkind
1517 lri_v_int(ikind)%v_int = 0.0_dp
1518 END DO
1519 CALL integrate_v_rspace_one_center(v_rspace, qs_env, &
1520 lri_v_int, calculate_forces, "RI_HXC")
1521 DO ikind = 1, nkind
1522 CALL para_env%sum(lri_v_int(ikind)%v_int)
1523 END DO
1524 ELSE
1525 rho_ao => my_rho(ispin, :)
1526 ksmat => ks_matrix(ispin, :)
1527 CALL integrate_v_rspace(v_rspace=v_rspace, &
1528 pmat_kp=rho_ao, &
1529 hmat_kp=ksmat, &
1530 qs_env=qs_env, &
1531 calculate_forces=calculate_forces, &
1532 gapw=gapw)
1533 END IF
1534 END DO
1535 END IF ! ASSOCIATED(v_rspace_new)
1536
1537 ! **** LRIGPW: KS matrix from integrated potential
1538 IF (lrigpw) THEN
1539 CALL get_qs_env(qs_env, ks_env=ks_env)
1540 CALL get_ks_env(ks_env=ks_env, kpoints=kpoints)
1541 CALL get_kpoint_info(kpoint=kpoints, cell_to_index=cell_to_index)
1542 DO ispin = 1, nspins
1543 ksmat => ks_matrix(ispin, :)
1544 CALL calculate_lri_ks_matrix(lri_env, lri_v_int, ksmat, atomic_kind_set, &
1545 cell_to_index=cell_to_index)
1546 END DO
1547 IF (calculate_forces) THEN
1548 CALL calculate_lri_forces(lri_env, lri_density, qs_env, rho_ao_kp, atomic_kind_set)
1549 END IF
1550 ELSEIF (rigpw) THEN
1551 CALL get_qs_env(qs_env, matrix_s=smat)
1552 DO ispin = 1, nspins
1553 CALL calculate_ri_ks_matrix(lri_env, lri_v_int, ks_matrix(ispin, 1)%matrix, &
1554 smat(1)%matrix, atomic_kind_set, ispin)
1555 END DO
1556 IF (calculate_forces) THEN
1557 rho_ao_nokp => rho_ao_kp(:, 1)
1558 CALL calculate_ri_forces(lri_env, lri_density, qs_env, rho_ao_nokp, atomic_kind_set)
1559 END IF
1560 END IF
1561
1562 IF (ASSOCIATED(v_tau_rspace)) THEN
1563 IF (lrigpw .OR. rigpw) THEN
1564 cpabort("LRIGPW/RIGPW not implemented for meta-GGAs")
1565 END IF
1566 DO ispin = 1, nspins
1567 CALL pw_scale(v_tau_rspace(ispin), v_tau_rspace(ispin)%pw_grid%dvol)
1568
1569 rho_ao => rho_ao_kp(ispin, :)
1570 ksmat => ks_matrix(ispin, :)
1571 CALL integrate_v_rspace(v_rspace=v_tau_rspace(ispin), &
1572 pmat_kp=rho_ao, hmat_kp=ksmat, &
1573 qs_env=qs_env, &
1574 calculate_forces=calculate_forces, compute_tau=.true., &
1575 gapw=gapw)
1576 CALL auxbas_pw_pool%give_back_pw(v_tau_rspace(ispin))
1577 END DO
1578 DEALLOCATE (v_tau_rspace)
1579 END IF
1580
1581 ! Add contributions from ADMM if requested
1582 IF (dft_control%do_admm) THEN
1583 CALL get_qs_env(qs_env, admm_env=admm_env)
1584 CALL get_admm_env(admm_env, matrix_ks_aux_fit_kp=matrix_ks_aux_fit, rho_aux_fit=rho_aux_fit, &
1585 matrix_ks_aux_fit_dft_kp=matrix_ks_aux_fit_dft)
1586 CALL qs_rho_get(rho_aux_fit, rho_ao_kp=rho_ao_aux)
1587 IF (ASSOCIATED(v_rspace_new_aux_fit)) THEN
1588 DO ispin = 1, nspins
1589 ! Calculate the xc potential
1590 CALL pw_scale(v_rspace_new_aux_fit(ispin), v_rspace_new_aux_fit(ispin)%pw_grid%dvol)
1591
1592 ! set matrix_ks_aux_fit_dft = matrix_ks_aux_fit(k_HF)
1593 DO img = 1, dft_control%nimages
1594 CALL dbcsr_copy(matrix_ks_aux_fit_dft(ispin, img)%matrix, matrix_ks_aux_fit(ispin, img)%matrix, &
1595 name="DFT exch. part of matrix_ks_aux_fit")
1596 END DO
1597
1598 ! Add potential to ks_matrix aux_fit, skip integration if no DFT correction
1599
1600 IF (admm_env%aux_exch_func .NE. do_admm_aux_exch_func_none) THEN
1601
1602 !GPW by default. IF GAPW, then take relevant task list and basis
1603 CALL get_admm_env(admm_env, task_list_aux_fit=task_list)
1604 basis_type = "AUX_FIT"
1605 IF (admm_env%do_gapw) THEN
1606 task_list => admm_env%admm_gapw_env%task_list
1607 basis_type = "AUX_FIT_SOFT"
1608 END IF
1609 fadm = 1.0_dp
1610 ! Calculate bare scaling of force according to Merlot, 1. IF: ADMMP, 2. IF: ADMMS,
1611 IF (admm_env%do_admmp) THEN
1612 fadm = admm_env%gsi(ispin)**2
1613 ELSE IF (admm_env%do_admms) THEN
1614 fadm = (admm_env%gsi(ispin))**(2.0_dp/3.0_dp)
1615 END IF
1616
1617 rho_ao => rho_ao_aux(ispin, :)
1618 ksmat => matrix_ks_aux_fit(ispin, :)
1619
1620 CALL integrate_v_rspace(v_rspace=v_rspace_new_aux_fit(ispin), &
1621 pmat_kp=rho_ao, &
1622 hmat_kp=ksmat, &
1623 qs_env=qs_env, &
1624 calculate_forces=calculate_forces, &
1625 force_adm=fadm, &
1626 gapw=.false., & !even if actual GAPW calculation, want to use AUX_FIT_SOFT
1627 basis_type=basis_type, &
1628 task_list_external=task_list)
1629 END IF
1630
1631 ! matrix_ks_aux_fit_dft(x_DFT)=matrix_ks_aux_fit_dft(old,k_HF)-matrix_ks_aux_fit(k_HF-x_DFT)
1632 DO img = 1, dft_control%nimages
1633 CALL dbcsr_add(matrix_ks_aux_fit_dft(ispin, img)%matrix, &
1634 matrix_ks_aux_fit(ispin, img)%matrix, 1.0_dp, -1.0_dp)
1635 END DO
1636
1637 CALL auxbas_pw_pool%give_back_pw(v_rspace_new_aux_fit(ispin))
1638 END DO
1639 DEALLOCATE (v_rspace_new_aux_fit)
1640 END IF
1641 ! Clean up v_tau_rspace_aux_fit, which is actually not needed
1642 IF (ASSOCIATED(v_tau_rspace_aux_fit)) THEN
1643 DO ispin = 1, nspins
1644 CALL auxbas_pw_pool%give_back_pw(v_tau_rspace_aux_fit(ispin))
1645 END DO
1646 DEALLOCATE (v_tau_rspace_aux_fit)
1647 END IF
1648 END IF
1649
1650 IF (dft_control%apply_embed_pot) DEALLOCATE (v_rspace_embed)
1651
1652 CALL timestop(handle)
1653
1654 END SUBROUTINE sum_up_and_integrate
1655
1656!**************************************************************************
1657!> \brief Calculate the ZMP potential and energy as in Zhao, Morrison Parr
1658!> PRA 50i, 2138 (1994)
1659!> V_c^\lambda defined as int_rho-rho_0/r-r' or rho-rho_0 times a Lagrange
1660!> multiplier, plus Fermi-Amaldi potential that should give the V_xc in the
1661!> limit \lambda --> \infty
1662!>
1663!> \param qs_env ...
1664!> \param v_rspace_new ...
1665!> \param rho ...
1666!> \param exc ...
1667!> \author D. Varsano [daniele.varsano@nano.cnr.it]
1668! **************************************************************************************************
1669 SUBROUTINE calculate_zmp_potential(qs_env, v_rspace_new, rho, exc)
1670
1671 TYPE(qs_environment_type), POINTER :: qs_env
1672 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_rspace_new
1673 TYPE(qs_rho_type), POINTER :: rho
1674 REAL(kind=dp) :: exc
1675
1676 CHARACTER(*), PARAMETER :: routinen = 'calculate_zmp_potential'
1677
1678 INTEGER :: handle, my_val, nelectron, nspins
1679 INTEGER, DIMENSION(2) :: nelectron_spin
1680 LOGICAL :: do_zmp_read, fermi_amaldi
1681 REAL(kind=dp) :: lambda
1682 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_ext_r
1683 TYPE(dft_control_type), POINTER :: dft_control
1684 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_ext_g, rho_g
1685 TYPE(pw_env_type), POINTER :: pw_env
1686 TYPE(pw_poisson_type), POINTER :: poisson_env
1687 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1688 TYPE(pw_r3d_rs_type) :: v_xc_rspace
1689 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
1690 TYPE(qs_ks_env_type), POINTER :: ks_env
1691 TYPE(section_vals_type), POINTER :: ext_den_section, input
1692
1693!, v_h_gspace, &
1694
1695 CALL timeset(routinen, handle)
1696 NULLIFY (auxbas_pw_pool)
1697 NULLIFY (pw_env)
1698 NULLIFY (poisson_env)
1699 NULLIFY (v_rspace_new)
1700 NULLIFY (dft_control)
1701 NULLIFY (rho_r, rho_g, tot_rho_ext_r, rho_ext_g)
1702 CALL get_qs_env(qs_env=qs_env, &
1703 pw_env=pw_env, &
1704 ks_env=ks_env, &
1705 rho=rho, &
1706 input=input, &
1707 nelectron_spin=nelectron_spin, &
1708 dft_control=dft_control)
1709 CALL pw_env_get(pw_env=pw_env, &
1710 auxbas_pw_pool=auxbas_pw_pool, &
1711 poisson_env=poisson_env)
1712 CALL qs_rho_get(rho, rho_r=rho_r, rho_g=rho_g)
1713 nspins = 1
1714 ALLOCATE (v_rspace_new(nspins))
1715 CALL auxbas_pw_pool%create_pw(pw=v_rspace_new(1))
1716 CALL auxbas_pw_pool%create_pw(pw=v_xc_rspace)
1717
1718 CALL pw_zero(v_rspace_new(1))
1719 do_zmp_read = dft_control%apply_external_vxc
1720 IF (do_zmp_read) THEN
1721 CALL pw_copy(qs_env%external_vxc, v_rspace_new(1))
1722 exc = accurate_dot_product(v_rspace_new(1)%array, rho_r(1)%array)* &
1723 v_rspace_new(1)%pw_grid%dvol
1724 ELSE
1725 block
1726 REAL(kind=dp) :: factor
1727 TYPE(pw_c1d_gs_type) :: rho_eff_gspace, v_xc_gspace
1728 CALL auxbas_pw_pool%create_pw(pw=rho_eff_gspace)
1729 CALL auxbas_pw_pool%create_pw(pw=v_xc_gspace)
1730 CALL pw_zero(rho_eff_gspace)
1731 CALL pw_zero(v_xc_gspace)
1732 CALL pw_zero(v_xc_rspace)
1733 factor = pw_integrate_function(rho_g(1))
1734 CALL qs_rho_get(qs_env%rho_external, &
1735 rho_g=rho_ext_g, &
1736 tot_rho_r=tot_rho_ext_r)
1737 factor = tot_rho_ext_r(1)/factor
1738
1739 CALL pw_axpy(rho_g(1), rho_eff_gspace, alpha=factor)
1740 CALL pw_axpy(rho_ext_g(1), rho_eff_gspace, alpha=-1.0_dp)
1741 ext_den_section => section_vals_get_subs_vals(input, "DFT%EXTERNAL_DENSITY")
1742 CALL section_vals_val_get(ext_den_section, "LAMBDA", r_val=lambda)
1743 CALL section_vals_val_get(ext_den_section, "ZMP_CONSTRAINT", i_val=my_val)
1744 CALL section_vals_val_get(ext_den_section, "FERMI_AMALDI", l_val=fermi_amaldi)
1745
1746 CALL pw_scale(rho_eff_gspace, a=lambda)
1747 nelectron = nelectron_spin(1)
1748 factor = -1.0_dp/nelectron
1749 CALL pw_axpy(rho_g(1), rho_eff_gspace, alpha=factor)
1750
1751 CALL pw_poisson_solve(poisson_env, rho_eff_gspace, vhartree=v_xc_gspace)
1752 CALL pw_transfer(v_xc_gspace, v_rspace_new(1))
1753 CALL pw_copy(v_rspace_new(1), v_xc_rspace)
1754
1755 exc = 0.0_dp
1756 exc = pw_integral_ab(v_rspace_new(1), rho_r(1))
1757
1758!Note that this is not the xc energy but \int(\rho*v_xc)
1759!Vxc---> v_rspace_new
1760!Exc---> energy%exc
1761 CALL auxbas_pw_pool%give_back_pw(rho_eff_gspace)
1762 CALL auxbas_pw_pool%give_back_pw(v_xc_gspace)
1763 END block
1764 END IF
1765
1766 CALL auxbas_pw_pool%give_back_pw(v_xc_rspace)
1767
1768 CALL timestop(handle)
1769
1770 END SUBROUTINE calculate_zmp_potential
1771
1772! **************************************************************************************************
1773!> \brief ...
1774!> \param qs_env ...
1775!> \param rho ...
1776!> \param v_rspace_embed ...
1777!> \param dft_control ...
1778!> \param embed_corr ...
1779!> \param just_energy ...
1780! **************************************************************************************************
1781 SUBROUTINE get_embed_potential_energy(qs_env, rho, v_rspace_embed, dft_control, embed_corr, &
1782 just_energy)
1783 TYPE(qs_environment_type), POINTER :: qs_env
1784 TYPE(qs_rho_type), POINTER :: rho
1785 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_rspace_embed
1786 TYPE(dft_control_type), POINTER :: dft_control
1787 REAL(kind=dp) :: embed_corr
1788 LOGICAL :: just_energy
1789
1790 CHARACTER(*), PARAMETER :: routinen = 'get_embed_potential_energy'
1791
1792 INTEGER :: handle, ispin
1793 REAL(kind=dp) :: embed_corr_local
1794 TYPE(pw_env_type), POINTER :: pw_env
1795 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1796 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
1797
1798 CALL timeset(routinen, handle)
1799
1800 NULLIFY (auxbas_pw_pool)
1801 NULLIFY (pw_env)
1802 NULLIFY (rho_r)
1803 CALL get_qs_env(qs_env=qs_env, &
1804 pw_env=pw_env, &
1805 rho=rho)
1806 CALL pw_env_get(pw_env=pw_env, &
1807 auxbas_pw_pool=auxbas_pw_pool)
1808 CALL qs_rho_get(rho, rho_r=rho_r)
1809 ALLOCATE (v_rspace_embed(dft_control%nspins))
1810
1811 embed_corr = 0.0_dp
1812
1813 DO ispin = 1, dft_control%nspins
1814 CALL auxbas_pw_pool%create_pw(pw=v_rspace_embed(ispin))
1815 CALL pw_zero(v_rspace_embed(ispin))
1816
1817 CALL pw_copy(qs_env%embed_pot, v_rspace_embed(ispin))
1818 embed_corr_local = 0.0_dp
1819
1820 ! Spin embedding potential in open-shell case
1821 IF (dft_control%nspins .EQ. 2) THEN
1822 IF (ispin .EQ. 1) CALL pw_axpy(qs_env%spin_embed_pot, v_rspace_embed(ispin), 1.0_dp)
1823 IF (ispin .EQ. 2) CALL pw_axpy(qs_env%spin_embed_pot, v_rspace_embed(ispin), -1.0_dp)
1824 END IF
1825 ! Integrate the density*potential
1826 embed_corr_local = pw_integral_ab(v_rspace_embed(ispin), rho_r(ispin))
1827
1828 embed_corr = embed_corr + embed_corr_local
1829
1830 END DO
1831
1832 ! If only energy requiested we delete the potential
1833 IF (just_energy) THEN
1834 DO ispin = 1, dft_control%nspins
1835 CALL auxbas_pw_pool%give_back_pw(v_rspace_embed(ispin))
1836 END DO
1837 DEALLOCATE (v_rspace_embed)
1838 END IF
1839
1840 CALL timestop(handle)
1841
1842 END SUBROUTINE get_embed_potential_energy
1843
1844END 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_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, use_sp)
creates a new full matrix with the given structure
various routines to log and control the output. The idea is that decisions about where to log should ...
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)
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)
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, 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, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, ecoul_1c, rho0_s_rs, rho0_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, 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)
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)
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, potential_changed, forces_up_to_date, complex_ks, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, kinetic, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_ks_im_kp, rho, rho_xc, vppl, rho_core, rho_nlcc, rho_nlcc_g, vee, neighbor_list_id, sab_orb, sab_all, sac_ae, sac_ppl, sac_lri, sap_ppnl, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_vdw, sab_scp, sab_almo, sab_kp, sab_kp_nosym, task_list, task_list_soft, kpoints, do_kpoints, atomic_kind_set, qs_kind_set, cell, cell_ref, use_ref_cell, particle_set, energy, force, local_particles, local_molecules, molecule_kind_set, molecule_set, subsys, cp_subsys, virial, results, atprop, nkind, natom, dft_control, dbcsr_dist, distribution_2d, pw_env, para_env, blacs_env, nelectron_total, nelectron_spin)
...
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 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, pw_pool)
calculates just the exchange and correlation energy (no vxc)
Definition xc.F:1456
subroutine, public xc_vxc_pw_create1(vxc_rho, vxc_tau, rho_r, rho_g, tau, exc, xc_section, pw_pool, compute_virial, virial_xc, exc_r)
Exchange and Correlation functional calculations. depending on the selected functional_routine calls ...
Definition xc.F:150
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:55
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:509
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.