Line data Source code
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 Utility subroutine for qs energy calculation
10 : !> \par History
11 : !> none
12 : !> \author MK (29.10.2002)
13 : ! **************************************************************************************************
14 : MODULE qs_energy_utils
15 : USE atomic_kind_types, ONLY: atomic_kind_type
16 : USE atprop_types, ONLY: atprop_array_add,&
17 : atprop_array_init,&
18 : atprop_type
19 : USE cp_control_types, ONLY: dft_control_type
20 : USE cp_control_utils, ONLY: read_ddapc_section
21 : USE cp_dbcsr_api, ONLY: dbcsr_copy,&
22 : dbcsr_create,&
23 : dbcsr_p_type,&
24 : dbcsr_release,&
25 : dbcsr_set
26 : USE et_coupling, ONLY: calc_et_coupling
27 : USE et_coupling_proj, ONLY: calc_et_coupling_proj
28 : USE hartree_local_methods, ONLY: Vh_1c_gg_integrals
29 : USE hartree_local_types, ONLY: ecoul_1center_type
30 : USE input_section_types, ONLY: section_vals_get,&
31 : section_vals_get_subs_vals,&
32 : section_vals_type
33 : USE kinds, ONLY: dp
34 : USE message_passing, ONLY: mp_para_env_type
35 : USE mulliken, ONLY: atom_trace
36 : USE post_scf_bandstructure_methods, ONLY: post_scf_bandstructure
37 : USE pw_env_types, ONLY: pw_env_get,&
38 : pw_env_type
39 : USE pw_methods, ONLY: pw_axpy,&
40 : pw_scale
41 : USE pw_pool_types, ONLY: pw_pool_type
42 : USE pw_types, ONLY: pw_r3d_rs_type
43 : USE qs_core_matrices, ONLY: core_matrices
44 : USE qs_dispersion_types, ONLY: qs_dispersion_type
45 : USE qs_energy_types, ONLY: qs_energy_type
46 : USE qs_environment_types, ONLY: get_qs_env,&
47 : qs_environment_type
48 : USE qs_integrate_potential, ONLY: integrate_v_core_rspace,&
49 : integrate_v_rspace
50 : USE qs_kind_types, ONLY: qs_kind_type
51 : USE qs_ks_atom, ONLY: update_ks_atom
52 : USE qs_ks_methods, ONLY: qs_ks_update_qs_env
53 : USE qs_ks_types, ONLY: qs_ks_env_type
54 : USE qs_linres_module, ONLY: linres_calculation_low
55 : USE qs_local_rho_types, ONLY: local_rho_type
56 : USE qs_rho0_ggrid, ONLY: integrate_vhg0_rspace
57 : USE qs_rho_atom_types, ONLY: rho_atom_type,&
58 : zero_rho_atom_integrals
59 : USE qs_rho_types, ONLY: qs_rho_get,&
60 : qs_rho_type
61 : USE qs_scf, ONLY: scf
62 : USE qs_tddfpt2_methods, ONLY: tddfpt
63 : USE qs_vxc, ONLY: qs_xc_density
64 : USE qs_vxc_atom, ONLY: calculate_vxc_atom
65 : USE rixs_methods, ONLY: rixs
66 : USE tip_scan_methods, ONLY: tip_scanning
67 : USE xas_methods, ONLY: xas
68 : USE xas_tdp_methods, ONLY: xas_tdp
69 : USE xc_derivatives, ONLY: xc_functionals_get_needs
70 : USE xc_rho_cflags_types, ONLY: xc_rho_cflags_type
71 : #include "./base/base_uses.f90"
72 :
73 : IMPLICIT NONE
74 :
75 : PRIVATE
76 :
77 : ! *** Global parameters ***
78 :
79 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_energy_utils'
80 :
81 : PUBLIC :: qs_energies_properties
82 :
83 : CONTAINS
84 :
85 : ! **************************************************************************************************
86 : !> \brief Refactoring of qs_energies_scf. Moves computation of properties
87 : !> into separate subroutine. Calculates energy and if calc_forces then the response vector
88 : !> and some contributions to the force
89 : !> \param qs_env ...
90 : !> \param calc_forces ...
91 : !> \par History
92 : !> 05.2013 created [Florian Schiffmann]
93 : ! **************************************************************************************************
94 :
95 84780 : SUBROUTINE qs_energies_properties(qs_env, calc_forces)
96 : TYPE(qs_environment_type), POINTER :: qs_env
97 : LOGICAL, INTENT(IN) :: calc_forces
98 :
99 : CHARACTER(len=*), PARAMETER :: routineN = 'qs_energies_properties'
100 :
101 : INTEGER :: handle, natom
102 : LOGICAL :: do_et, do_et_proj, &
103 : do_post_scf_bandstructure, do_tip_scan
104 : REAL(KIND=dp) :: ekts
105 : TYPE(atprop_type), POINTER :: atprop
106 : TYPE(dft_control_type), POINTER :: dft_control
107 : TYPE(mp_para_env_type), POINTER :: para_env
108 : TYPE(pw_env_type), POINTER :: pw_env
109 : TYPE(pw_r3d_rs_type), POINTER :: v_hartree_rspace
110 : TYPE(qs_energy_type), POINTER :: energy
111 : TYPE(section_vals_type), POINTER :: input, post_scf_bands_section, &
112 : proj_section, rest_b_section, &
113 : tip_scan_section
114 :
115 21195 : NULLIFY (atprop, energy, pw_env)
116 21195 : CALL timeset(routineN, handle)
117 :
118 : ! atomic energies using Mulliken partition
119 : CALL get_qs_env(qs_env, &
120 : dft_control=dft_control, &
121 : input=input, &
122 : atprop=atprop, &
123 : energy=energy, &
124 : v_hartree_rspace=v_hartree_rspace, &
125 : para_env=para_env, &
126 21195 : pw_env=pw_env)
127 21195 : IF (atprop%energy) THEN
128 140 : CALL qs_energies_mulliken(qs_env)
129 140 : CALL get_qs_env(qs_env, natom=natom)
130 : IF (.NOT. dft_control%qs_control%semi_empirical .AND. &
131 140 : .NOT. dft_control%qs_control%xtb .AND. &
132 : .NOT. dft_control%qs_control%dftb) THEN
133 : ! Nuclear charge correction
134 36 : CALL integrate_v_core_rspace(v_hartree_rspace, qs_env)
135 36 : IF (.NOT. ASSOCIATED(atprop%ateb)) THEN
136 8 : CALL atprop_array_init(atprop%ateb, natom)
137 : END IF
138 : ! Kohn-Sham Functional corrections
139 36 : CALL ks_xc_correction(qs_env)
140 : END IF
141 140 : CALL atprop_array_add(atprop%atener, atprop%ateb)
142 140 : CALL atprop_array_add(atprop%atener, atprop%ateself)
143 140 : CALL atprop_array_add(atprop%atener, atprop%atexc)
144 140 : CALL atprop_array_add(atprop%atener, atprop%atecoul)
145 140 : CALL atprop_array_add(atprop%atener, atprop%atevdw)
146 140 : CALL atprop_array_add(atprop%atener, atprop%ategcp)
147 140 : CALL atprop_array_add(atprop%atener, atprop%atecc)
148 140 : CALL atprop_array_add(atprop%atener, atprop%ate1c)
149 : ! entropic energy
150 140 : ekts = energy%kts/REAL(natom, KIND=dp)/REAL(para_env%num_pe, KIND=dp)
151 7504 : atprop%atener(:) = atprop%atener(:) + ekts
152 : END IF
153 :
154 : ! ET coupling - projection-operator approach
155 21195 : NULLIFY (proj_section)
156 : proj_section => &
157 21195 : section_vals_get_subs_vals(input, "PROPERTIES%ET_COUPLING%PROJECTION")
158 21195 : CALL section_vals_get(proj_section, explicit=do_et_proj)
159 21195 : IF (do_et_proj) THEN
160 10 : CALL calc_et_coupling_proj(qs_env)
161 : END IF
162 :
163 : ! ********** Calculate the electron transfer coupling elements********
164 21195 : do_et = .FALSE.
165 21195 : do_et = dft_control%qs_control%et_coupling_calc
166 21195 : IF (do_et) THEN
167 0 : qs_env%et_coupling%energy = energy%total
168 0 : qs_env%et_coupling%keep_matrix = .TRUE.
169 0 : qs_env%et_coupling%first_run = .TRUE.
170 0 : CALL qs_ks_update_qs_env(qs_env, calculate_forces=.FALSE., just_energy=.TRUE.)
171 0 : qs_env%et_coupling%first_run = .FALSE.
172 0 : IF (dft_control%qs_control%ddapc_restraint) THEN
173 0 : rest_b_section => section_vals_get_subs_vals(input, "PROPERTIES%ET_COUPLING%DDAPC_RESTRAINT_B")
174 : CALL read_ddapc_section(qs_control=dft_control%qs_control, &
175 0 : ddapc_restraint_section=rest_b_section)
176 : END IF
177 0 : CALL scf(qs_env=qs_env)
178 0 : qs_env%et_coupling%keep_matrix = .TRUE.
179 :
180 0 : CALL qs_ks_update_qs_env(qs_env, calculate_forces=.FALSE., just_energy=.TRUE.)
181 0 : CALL calc_et_coupling(qs_env)
182 : END IF
183 :
184 : !Properties
185 :
186 21195 : IF (dft_control%do_xas_calculation) THEN
187 42 : CALL xas(qs_env, dft_control)
188 : END IF
189 :
190 21195 : IF (dft_control%do_xas_tdp_calculation) THEN
191 50 : CALL xas_tdp(qs_env)
192 : END IF
193 :
194 : ! Compute Linear Response properties as post-scf
195 : ! Initialization of TDDFPT calculation
196 21195 : IF (.NOT. qs_env%linres_run) THEN
197 20695 : CALL linres_calculation_low(qs_env)
198 : END IF
199 :
200 : ! Calculates the energy, response vector and some contributions to the force
201 21195 : IF (dft_control%tddfpt2_control%enabled) THEN
202 1102 : CALL tddfpt(qs_env, calc_forces)
203 : END IF
204 :
205 : ! stand-alone RIXS, does not depend on previous xas_tdp and/or tddfpt2 calculations
206 21195 : IF (qs_env%do_rixs) CALL rixs(qs_env)
207 :
208 : ! post-SCF bandstructure calculation from higher level methods
209 21195 : NULLIFY (post_scf_bands_section)
210 21195 : post_scf_bands_section => section_vals_get_subs_vals(qs_env%input, "PROPERTIES%BANDSTRUCTURE")
211 21195 : CALL section_vals_get(post_scf_bands_section, explicit=do_post_scf_bandstructure)
212 21195 : IF (do_post_scf_bandstructure) THEN
213 28 : CALL post_scf_bandstructure(qs_env, post_scf_bands_section)
214 : END IF
215 :
216 : ! tip scan
217 21195 : NULLIFY (tip_scan_section)
218 21195 : tip_scan_section => section_vals_get_subs_vals(input, "PROPERTIES%TIP_SCAN")
219 21195 : CALL section_vals_get(tip_scan_section, explicit=do_tip_scan)
220 21195 : IF (do_tip_scan) THEN
221 0 : CALL tip_scanning(qs_env, tip_scan_section)
222 : END IF
223 :
224 21195 : CALL timestop(handle)
225 :
226 21195 : END SUBROUTINE qs_energies_properties
227 :
228 : ! **************************************************************************************************
229 : !> \brief Use a simple Mulliken-like energy decomposition
230 : !> \param qs_env ...
231 : !> \date 07.2011
232 : !> \author JHU
233 : !> \version 1.0
234 : ! **************************************************************************************************
235 140 : SUBROUTINE qs_energies_mulliken(qs_env)
236 :
237 : TYPE(qs_environment_type), POINTER :: qs_env
238 :
239 : INTEGER :: ispin, natom, nspin
240 140 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: atcore
241 : TYPE(atprop_type), POINTER :: atprop
242 : TYPE(dbcsr_p_type), ALLOCATABLE, DIMENSION(:), &
243 140 : TARGET :: core_mat
244 140 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_h, matrix_ks, rho_ao
245 140 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: math, matp
246 : TYPE(dft_control_type), POINTER :: dft_control
247 : TYPE(qs_rho_type), POINTER :: rho
248 :
249 140 : CALL get_qs_env(qs_env=qs_env, atprop=atprop)
250 140 : IF (atprop%energy) THEN
251 140 : CALL get_qs_env(qs_env=qs_env, matrix_ks=matrix_ks, matrix_h=matrix_h, rho=rho)
252 140 : CALL qs_rho_get(rho, rho_ao=rho_ao)
253 : ! E = 0.5*Tr(H*P+F*P)
254 7504 : atprop%atener = 0._dp
255 140 : nspin = SIZE(rho_ao)
256 284 : DO ispin = 1, nspin
257 : CALL atom_trace(matrix_h(1)%matrix, rho_ao(ispin)%matrix, &
258 144 : 0.5_dp, atprop%atener)
259 : CALL atom_trace(matrix_ks(ispin)%matrix, rho_ao(ispin)%matrix, &
260 284 : 0.5_dp, atprop%atener)
261 : END DO
262 : !
263 140 : CALL get_qs_env(qs_env=qs_env, dft_control=dft_control)
264 : IF (.NOT. dft_control%qs_control%semi_empirical .AND. &
265 140 : .NOT. dft_control%qs_control%xtb .AND. &
266 : .NOT. dft_control%qs_control%dftb) THEN
267 36 : CALL get_qs_env(qs_env=qs_env, natom=natom)
268 108 : ALLOCATE (atcore(natom))
269 160 : atcore = 0.0_dp
270 108 : ALLOCATE (core_mat(1))
271 36 : ALLOCATE (core_mat(1)%matrix)
272 36 : CALL dbcsr_create(core_mat(1)%matrix, template=matrix_h(1)%matrix)
273 36 : CALL dbcsr_copy(core_mat(1)%matrix, matrix_h(1)%matrix)
274 36 : CALL dbcsr_set(core_mat(1)%matrix, 0.0_dp)
275 36 : math(1:1, 1:1) => core_mat(1:1)
276 36 : matp(1:nspin, 1:1) => rho_ao(1:nspin)
277 36 : CALL core_matrices(qs_env, math, matp, .FALSE., 0, atcore=atcore)
278 160 : atprop%atener = atprop%atener + 0.5_dp*atcore
279 76 : DO ispin = 1, nspin
280 : CALL atom_trace(core_mat(1)%matrix, rho_ao(ispin)%matrix, &
281 76 : -0.5_dp, atprop%atener)
282 : END DO
283 36 : DEALLOCATE (atcore)
284 36 : CALL dbcsr_release(core_mat(1)%matrix)
285 36 : DEALLOCATE (core_mat(1)%matrix)
286 36 : DEALLOCATE (core_mat)
287 : END IF
288 : END IF
289 :
290 280 : END SUBROUTINE qs_energies_mulliken
291 :
292 : ! **************************************************************************************************
293 : !> \brief ...
294 : !> \param qs_env ...
295 : ! **************************************************************************************************
296 36 : SUBROUTINE ks_xc_correction(qs_env)
297 : TYPE(qs_environment_type), POINTER :: qs_env
298 :
299 : CHARACTER(len=*), PARAMETER :: routineN = 'ks_xc_correction'
300 :
301 : INTEGER :: handle, iatom, ispin, natom, nspins
302 : LOGICAL :: gapw, gapw_xc
303 : REAL(KIND=dp) :: eh1, exc1
304 36 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
305 : TYPE(atprop_type), POINTER :: atprop
306 36 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s, rho_ao, xcmat
307 36 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_p
308 : TYPE(dft_control_type), POINTER :: dft_control
309 36 : TYPE(ecoul_1center_type), DIMENSION(:), POINTER :: ecoul_1c
310 : TYPE(local_rho_type), POINTER :: local_rho_set
311 : TYPE(mp_para_env_type), POINTER :: para_env
312 : TYPE(pw_env_type), POINTER :: pw_env
313 : TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
314 : TYPE(pw_r3d_rs_type) :: xc_den
315 36 : TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:) :: vtau, vxc
316 : TYPE(pw_r3d_rs_type), POINTER :: v_hartree_rspace
317 : TYPE(qs_dispersion_type), POINTER :: dispersion_env
318 36 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
319 : TYPE(qs_ks_env_type), POINTER :: ks_env
320 : TYPE(qs_rho_type), POINTER :: rho_struct
321 36 : TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set
322 : TYPE(section_vals_type), POINTER :: xc_fun_section, xc_section
323 : TYPE(xc_rho_cflags_type) :: needs
324 :
325 36 : CALL timeset(routineN, handle)
326 :
327 36 : CALL get_qs_env(qs_env, ks_env=ks_env, dft_control=dft_control, pw_env=pw_env, atprop=atprop)
328 :
329 36 : IF (atprop%energy) THEN
330 :
331 36 : nspins = dft_control%nspins
332 36 : xc_section => section_vals_get_subs_vals(qs_env%input, "DFT%XC")
333 36 : xc_fun_section => section_vals_get_subs_vals(xc_section, "XC_FUNCTIONAL")
334 36 : needs = xc_functionals_get_needs(xc_fun_section, (nspins == 2), .TRUE.)
335 36 : gapw = dft_control%qs_control%gapw
336 36 : gapw_xc = dft_control%qs_control%gapw_xc
337 :
338 : ! Nuclear charge correction
339 36 : CALL get_qs_env(qs_env, v_hartree_rspace=v_hartree_rspace)
340 36 : IF (gapw .OR. gapw_xc) THEN
341 : CALL get_qs_env(qs_env=qs_env, local_rho_set=local_rho_set, &
342 : rho_atom_set=rho_atom_set, ecoul_1c=ecoul_1c, &
343 12 : natom=natom, para_env=para_env)
344 12 : CALL zero_rho_atom_integrals(rho_atom_set)
345 12 : CALL calculate_vxc_atom(qs_env, .FALSE., exc1)
346 12 : IF (gapw) THEN
347 8 : CALL Vh_1c_gg_integrals(qs_env, eh1, ecoul_1c, local_rho_set, para_env, tddft=.FALSE.)
348 8 : CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set)
349 : CALL integrate_vhg0_rspace(qs_env, v_hartree_rspace, para_env, calculate_forces=.FALSE., &
350 8 : local_rho_set=local_rho_set, atener=atprop%ateb)
351 : END IF
352 : END IF
353 :
354 36 : CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
355 36 : CALL auxbas_pw_pool%create_pw(xc_den)
356 148 : ALLOCATE (vxc(nspins))
357 76 : DO ispin = 1, nspins
358 76 : CALL auxbas_pw_pool%create_pw(vxc(ispin))
359 : END DO
360 36 : IF (needs%tau .OR. needs%tau_spin) THEN
361 36 : ALLOCATE (vtau(nspins))
362 24 : DO ispin = 1, nspins
363 48 : CALL auxbas_pw_pool%create_pw(vtau(ispin))
364 : END DO
365 : END IF
366 :
367 36 : IF (gapw_xc) THEN
368 4 : CALL get_qs_env(qs_env, rho_xc=rho_struct, dispersion_env=dispersion_env)
369 : ELSE
370 32 : CALL get_qs_env(qs_env, rho=rho_struct, dispersion_env=dispersion_env)
371 : END IF
372 36 : IF (needs%tau .OR. needs%tau_spin) THEN
373 : CALL qs_xc_density(ks_env, rho_struct, xc_section, dispersion_env=dispersion_env, &
374 12 : xc_den=xc_den, vxc=vxc, vtau=vtau)
375 : ELSE
376 : CALL qs_xc_density(ks_env, rho_struct, xc_section, dispersion_env=dispersion_env, &
377 24 : xc_den=xc_den, vxc=vxc)
378 : END IF
379 36 : CALL get_qs_env(qs_env, rho=rho_struct)
380 36 : CALL qs_rho_get(rho_struct, rho_ao=rho_ao)
381 36 : CALL get_qs_env(qs_env, natom=natom, matrix_s=matrix_s)
382 36 : CALL atprop_array_init(atprop%atexc, natom)
383 148 : ALLOCATE (xcmat(nspins))
384 76 : DO ispin = 1, nspins
385 40 : ALLOCATE (xcmat(ispin)%matrix)
386 40 : CALL dbcsr_create(xcmat(ispin)%matrix, template=matrix_s(1)%matrix)
387 40 : CALL dbcsr_copy(xcmat(ispin)%matrix, matrix_s(1)%matrix)
388 40 : CALL dbcsr_set(xcmat(ispin)%matrix, 0.0_dp)
389 40 : CALL pw_scale(vxc(ispin), -0.5_dp)
390 40 : CALL pw_axpy(xc_den, vxc(ispin))
391 40 : CALL pw_scale(vxc(ispin), vxc(ispin)%pw_grid%dvol)
392 : CALL integrate_v_rspace(qs_env=qs_env, v_rspace=vxc(ispin), hmat=xcmat(ispin), &
393 40 : calculate_forces=.FALSE., gapw=(gapw .OR. gapw_xc))
394 76 : IF (needs%tau .OR. needs%tau_spin) THEN
395 12 : CALL pw_scale(vtau(ispin), -0.5_dp*vtau(ispin)%pw_grid%dvol)
396 : CALL integrate_v_rspace(qs_env=qs_env, v_rspace=vtau(ispin), &
397 : hmat=xcmat(ispin), calculate_forces=.FALSE., &
398 12 : gapw=(gapw .OR. gapw_xc), compute_tau=.TRUE.)
399 : END IF
400 : END DO
401 36 : IF (gapw .OR. gapw_xc) THEN
402 : ! remove one-center potential matrix part
403 12 : CALL qs_rho_get(rho_struct, rho_ao_kp=matrix_p)
404 12 : CALL update_ks_atom(qs_env, xcmat, matrix_p, forces=.FALSE., kscale=-0.5_dp)
405 12 : CALL get_qs_env(qs_env=qs_env, rho_atom_set=rho_atom_set)
406 12 : CALL atprop_array_init(atprop%ate1c, natom)
407 48 : atprop%ate1c = 0.0_dp
408 48 : DO iatom = 1, natom
409 : atprop%ate1c(iatom) = atprop%ate1c(iatom) + &
410 48 : rho_atom_set(iatom)%exc_h - rho_atom_set(iatom)%exc_s
411 : END DO
412 12 : IF (gapw) THEN
413 8 : CALL get_qs_env(qs_env=qs_env, ecoul_1c=ecoul_1c)
414 32 : DO iatom = 1, natom
415 : atprop%ate1c(iatom) = atprop%ate1c(iatom) + &
416 : ecoul_1c(iatom)%ecoul_1_h - ecoul_1c(iatom)%ecoul_1_s + &
417 32 : ecoul_1c(iatom)%ecoul_1_z - ecoul_1c(iatom)%ecoul_1_0
418 : END DO
419 : END IF
420 : END IF
421 76 : DO ispin = 1, nspins
422 40 : CALL atom_trace(xcmat(ispin)%matrix, rho_ao(ispin)%matrix, 1.0_dp, atprop%atexc)
423 40 : CALL dbcsr_release(xcmat(ispin)%matrix)
424 76 : DEALLOCATE (xcmat(ispin)%matrix)
425 : END DO
426 36 : DEALLOCATE (xcmat)
427 :
428 36 : CALL auxbas_pw_pool%give_back_pw(xc_den)
429 76 : DO ispin = 1, nspins
430 76 : CALL auxbas_pw_pool%give_back_pw(vxc(ispin))
431 : END DO
432 36 : IF (needs%tau .OR. needs%tau_spin) THEN
433 24 : DO ispin = 1, nspins
434 48 : CALL auxbas_pw_pool%give_back_pw(vtau(ispin))
435 : END DO
436 : END IF
437 :
438 : END IF
439 :
440 36 : CALL timestop(handle)
441 :
442 72 : END SUBROUTINE ks_xc_correction
443 :
444 : END MODULE qs_energy_utils
|
