Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief routines that build the integrals of the Fxc kernel calculated
10 : !> for the atomic density in the basis set of spherical primitives
11 : ! **************************************************************************************************
12 : MODULE qs_fxc_atom
13 : USE atomic_kind_types, ONLY: atomic_kind_type,&
14 : get_atomic_kind
15 : USE basis_set_types, ONLY: gto_basis_set_type
16 : USE cp_control_types, ONLY: dft_control_type
17 : USE input_section_types, ONLY: section_vals_get_subs_vals,&
18 : section_vals_type,&
19 : section_vals_val_get
20 : USE kinds, ONLY: dp
21 : USE message_passing, ONLY: mp_para_env_type
22 : USE qs_environment_types, ONLY: get_qs_env,&
23 : qs_environment_type
24 : USE qs_grid_atom, ONLY: grid_atom_type
25 : USE qs_harmonics_atom, ONLY: harmonics_atom_type
26 : USE qs_kind_types, ONLY: get_qs_kind,&
27 : has_nlcc,&
28 : qs_kind_type
29 : USE qs_rho_atom_types, ONLY: get_rho_atom,&
30 : rho_atom_coeff,&
31 : rho_atom_type
32 : USE qs_vxc_atom_utils, ONLY: &
33 : calc_rho_angular, calc_rho_nlcc, calc_tau_atom, calc_weight_function, &
34 : create_tau_basis_cache, dgaVtaudgb, gaVxcgb_GC, gaVxcgb_noGC, release_tau_basis_cache, &
35 : tau_basis_cache_type
36 : USE util, ONLY: get_limit
37 : USE xc_atom, ONLY: fill_rho_set,&
38 : xc_2nd_deriv_of_r,&
39 : xc_rho_set_atom_update
40 : USE xc_derivative_set_types, ONLY: xc_derivative_set_type,&
41 : xc_dset_create,&
42 : xc_dset_release
43 : USE xc_derivatives, ONLY: xc_functionals_get_needs
44 : USE xc_rho_cflags_types, ONLY: xc_rho_cflags_type
45 : USE xc_rho_set_types, ONLY: xc_rho_set_create,&
46 : xc_rho_set_release,&
47 : xc_rho_set_type
48 : #include "./base/base_uses.f90"
49 :
50 : IMPLICIT NONE
51 :
52 : PRIVATE
53 :
54 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_fxc_atom'
55 :
56 : PUBLIC :: fxc_atom_calc
57 :
58 : ! **************************************************************************************************
59 :
60 : CONTAINS
61 :
62 : ! **************************************************************************************************
63 : !> \brief ...
64 : !> \param qs_env ...
65 : !> \param rho_atom_set ...
66 : !> \param rho1_atom_set ...
67 : !> \param xc_section ...
68 : !> \param para_env_ext ...
69 : !> \param do_scale ...
70 : !> \param do_triplet ...
71 : !> \param do_sf ...
72 : !> \param kind_set_external ...
73 : ! **************************************************************************************************
74 6242 : SUBROUTINE fxc_atom_calc(qs_env, rho_atom_set, rho1_atom_set, xc_section, para_env_ext, &
75 : do_scale, do_triplet, do_sf, kind_set_external)
76 :
77 : TYPE(qs_environment_type), POINTER :: qs_env
78 : TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set, rho1_atom_set
79 : TYPE(section_vals_type), POINTER :: xc_section
80 : TYPE(mp_para_env_type), INTENT(IN), OPTIONAL :: para_env_ext
81 : LOGICAL, INTENT(IN), OPTIONAL :: do_scale, do_triplet, do_sf
82 : TYPE(qs_kind_type), DIMENSION(:), OPTIONAL, &
83 : POINTER :: kind_set_external
84 :
85 : CHARACTER(LEN=*), PARAMETER :: routineN = 'fxc_atom_calc'
86 :
87 : INTEGER :: atom, handle, iatom, ikind, ir, na, &
88 : natom, nr, nspins, on
89 : INTEGER, DIMENSION(2) :: local_loop_limit
90 : INTEGER, DIMENSION(2, 3) :: bounds
91 6242 : INTEGER, DIMENSION(:), POINTER :: atom_list
92 : LOGICAL :: accint, donlcc, gradient_functional, &
93 : lsd, my_do_sf, nlcc, paw_atom, &
94 : scale_rho, tau_f
95 : REAL(KIND=dp) :: agr, alpha, density_cut, gradient_cut, &
96 : rtot, tau_cut
97 6242 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: fw
98 : REAL(KIND=dp), CONTIGUOUS, DIMENSION(:, :, :), &
99 6242 : POINTER :: vtau_h, vtau_s, vxc_h, vxc_s
100 : REAL(KIND=dp), DIMENSION(1, 1, 1) :: rtau
101 : REAL(KIND=dp), DIMENSION(1, 1, 1, 1) :: rrho
102 6242 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rho_nlcc, weight_h, weight_s
103 18726 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: rho1_h, rho1_s, rho_h, rho_s, tau1_h, &
104 6242 : tau1_s, tau_h, tau_s
105 12484 : REAL(KIND=dp), DIMENSION(:, :, :, :), POINTER :: drho1_h, drho1_s, drho_h, drho_s, vxg_h, &
106 6242 : vxg_s
107 6242 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
108 : TYPE(dft_control_type), POINTER :: dft_control
109 : TYPE(grid_atom_type), POINTER :: grid_atom
110 : TYPE(gto_basis_set_type), POINTER :: basis_1c
111 : TYPE(harmonics_atom_type), POINTER :: harmonics
112 : TYPE(mp_para_env_type), POINTER :: para_env
113 6242 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: my_kind_set, qs_kind_set
114 6242 : TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: dr1_h, dr1_s, dr_h, dr_s, int_hh, &
115 6242 : int_ss, r1_h, r1_s, r_h, r_s
116 6242 : TYPE(rho_atom_coeff), DIMENSION(:, :), POINTER :: r1_h_d, r1_s_d, r_h_d, r_s_d
117 : TYPE(rho_atom_type), POINTER :: rho1_atom, rho_atom
118 : TYPE(section_vals_type), POINTER :: input, xc_fun_section
119 6242 : TYPE(tau_basis_cache_type) :: tau_basis_cache
120 : TYPE(xc_derivative_set_type) :: deriv_set
121 : TYPE(xc_rho_cflags_type) :: needs
122 : TYPE(xc_rho_set_type) :: rho1_set_h, rho1_set_s, rho_set_h, &
123 : rho_set_s
124 :
125 : ! -------------------------------------------------------------------------
126 :
127 6242 : CALL timeset(routineN, handle)
128 :
129 6242 : NULLIFY (qs_kind_set)
130 6242 : NULLIFY (rho_h, rho_s, drho_h, drho_s, weight_h, weight_s)
131 6242 : NULLIFY (rho1_h, rho1_s, drho1_h, drho1_s)
132 6242 : NULLIFY (vxc_h, vxc_s, vxg_h, vxg_s)
133 6242 : NULLIFY (tau_h, tau_s, tau1_h, tau1_s, vtau_h, vtau_s)
134 6242 : NULLIFY (rho_nlcc)
135 :
136 : CALL get_qs_env(qs_env=qs_env, &
137 : input=input, &
138 : dft_control=dft_control, &
139 : para_env=para_env, &
140 : qs_kind_set=qs_kind_set, &
141 6242 : atomic_kind_set=atomic_kind_set)
142 :
143 6242 : IF (PRESENT(kind_set_external)) THEN
144 726 : my_kind_set => kind_set_external
145 : ELSE
146 5516 : my_kind_set => qs_kind_set
147 : END IF
148 6242 : nlcc = has_nlcc(my_kind_set)
149 :
150 6242 : accint = dft_control%qs_control%gapw_control%accurate_xcint
151 :
152 6242 : CALL section_vals_val_get(input, "DFT%LSD", l_val=lsd)
153 : CALL section_vals_val_get(xc_section, "DENSITY_CUTOFF", &
154 6242 : r_val=density_cut)
155 : CALL section_vals_val_get(xc_section, "GRADIENT_CUTOFF", &
156 6242 : r_val=gradient_cut)
157 : CALL section_vals_val_get(xc_section, "TAU_CUTOFF", &
158 6242 : r_val=tau_cut)
159 :
160 6242 : my_do_sf = .FALSE.
161 6242 : IF (PRESENT(do_sf)) my_do_sf = do_sf
162 :
163 : xc_fun_section => section_vals_get_subs_vals(xc_section, &
164 6242 : "XC_FUNCTIONAL")
165 6242 : IF (lsd) THEN
166 190 : nspins = 2
167 : ELSE
168 6052 : nspins = 1
169 : END IF
170 :
171 6242 : scale_rho = .FALSE.
172 6242 : IF (PRESENT(do_scale)) THEN
173 2870 : IF (do_scale) THEN
174 : ! obscure scaling needed for (some) triplet densities
175 310 : scale_rho = .TRUE.
176 310 : CPASSERT(PRESENT(do_triplet))
177 310 : CPASSERT(do_triplet)
178 310 : CPASSERT(nspins == 1)
179 : END IF
180 : END IF
181 6242 : IF (PRESENT(do_triplet)) THEN
182 2984 : IF (nspins == 1 .AND. do_triplet) lsd = .TRUE.
183 : END IF
184 :
185 : needs = xc_functionals_get_needs(xc_fun_section, lsd=lsd, &
186 6242 : calc_potential=.TRUE.)
187 6242 : gradient_functional = needs%drho .OR. needs%drho_spin
188 6242 : tau_f = (needs%tau .OR. needs%tau_spin)
189 6242 : IF (.NOT. tau_f) rtau = 0.0_dp
190 :
191 : ! Here starts the loop over all the atoms
192 19854 : DO ikind = 1, SIZE(atomic_kind_set)
193 :
194 13612 : NULLIFY (atom_list, harmonics, grid_atom)
195 13612 : CALL get_atomic_kind(atomic_kind_set(ikind), atom_list=atom_list, natom=natom)
196 : CALL get_qs_kind(my_kind_set(ikind), paw_atom=paw_atom, &
197 13612 : harmonics=harmonics, grid_atom=grid_atom)
198 13612 : CALL get_qs_kind(my_kind_set(ikind), basis_set=basis_1c, basis_type="GAPW_1C")
199 13612 : IF (.NOT. paw_atom) CYCLE
200 :
201 12794 : nr = grid_atom%nr
202 12794 : na = grid_atom%ng_sphere
203 :
204 : ! set integration weights
205 12794 : weight_h => grid_atom%weight
206 12794 : weight_s => grid_atom%weight
207 12794 : IF (accint) THEN
208 4908 : on = dft_control%qs_control%gapw_control%oweights
209 4908 : alpha = dft_control%qs_control%gapw_control%aw(ikind)
210 4908 : IF (ASSOCIATED(grid_atom%gapw_weight_s)) THEN
211 4904 : IF (grid_atom%gapw_weight_alpha /= alpha) DEALLOCATE (grid_atom%gapw_weight_s)
212 : END IF
213 4908 : IF (.NOT. ASSOCIATED(grid_atom%gapw_weight_s)) THEN
214 16 : ALLOCATE (grid_atom%gapw_weight_s(na, nr))
215 12 : ALLOCATE (fw(nr))
216 4 : CALL calc_weight_function(fw, grid_atom%rad2, on, alpha)
217 204 : DO ir = 1, nr
218 200 : agr = 1.0_dp - fw(ir)
219 10204 : grid_atom%gapw_weight_s(:, ir) = agr*grid_atom%weight(:, ir)
220 : END DO
221 4 : DEALLOCATE (fw)
222 4 : grid_atom%gapw_weight_alpha = alpha
223 : END IF
224 4908 : weight_s => grid_atom%gapw_weight_s
225 : END IF
226 :
227 : ! Array dimension: here only one dimensional arrays are used,
228 : ! i.e. only the first column of deriv_data is read.
229 : ! The other two dimensions are set to size equal 1.
230 127940 : bounds(1:2, 1:3) = 1
231 12794 : bounds(2, 1) = na
232 12794 : bounds(2, 2) = nr
233 :
234 12794 : CALL xc_dset_create(deriv_set, local_bounds=bounds)
235 : CALL xc_rho_set_create(rho_set_h, bounds, rho_cutoff=density_cut, &
236 12794 : drho_cutoff=gradient_cut, tau_cutoff=tau_cut)
237 : CALL xc_rho_set_create(rho_set_s, bounds, rho_cutoff=density_cut, &
238 12794 : drho_cutoff=gradient_cut, tau_cutoff=tau_cut)
239 : CALL xc_rho_set_create(rho1_set_h, bounds, rho_cutoff=density_cut, &
240 12794 : drho_cutoff=gradient_cut, tau_cutoff=tau_cut)
241 : CALL xc_rho_set_create(rho1_set_s, bounds, rho_cutoff=density_cut, &
242 12794 : drho_cutoff=gradient_cut, tau_cutoff=tau_cut)
243 :
244 : ! allocate the required 3d arrays where to store rho and drho
245 12794 : IF (nspins == 1 .AND. .NOT. lsd) THEN
246 11932 : CALL xc_rho_set_atom_update(rho_set_h, needs, 1, bounds)
247 11932 : CALL xc_rho_set_atom_update(rho1_set_h, needs, 1, bounds)
248 11932 : CALL xc_rho_set_atom_update(rho_set_s, needs, 1, bounds)
249 11932 : CALL xc_rho_set_atom_update(rho1_set_s, needs, 1, bounds)
250 : ELSE
251 862 : CALL xc_rho_set_atom_update(rho_set_h, needs, 2, bounds)
252 862 : CALL xc_rho_set_atom_update(rho1_set_h, needs, 2, bounds)
253 862 : CALL xc_rho_set_atom_update(rho_set_s, needs, 2, bounds)
254 862 : CALL xc_rho_set_atom_update(rho1_set_s, needs, 2, bounds)
255 : END IF
256 :
257 : ALLOCATE (rho_h(1:na, 1:nr, 1:nspins), rho1_h(1:na, 1:nr, 1:nspins), &
258 179116 : rho_s(1:na, 1:nr, 1:nspins), rho1_s(1:na, 1:nr, 1:nspins))
259 :
260 89558 : ALLOCATE (vxc_h(1:na, 1:nr, 1:nspins), vxc_s(1:na, 1:nr, 1:nspins))
261 12794 : vxc_h = 0.0_dp
262 12794 : vxc_s = 0.0_dp
263 :
264 12794 : IF (tau_f) THEN
265 0 : CALL create_tau_basis_cache(tau_basis_cache, grid_atom, basis_1c, harmonics)
266 : ALLOCATE (tau_h(1:na, 1:nr, 1:nspins), tau1_h(1:na, 1:nr, 1:nspins), &
267 0 : tau_s(1:na, 1:nr, 1:nspins), tau1_s(1:na, 1:nr, 1:nspins))
268 0 : ALLOCATE (vtau_h(1:na, 1:nr, 1:nspins), vtau_s(1:na, 1:nr, 1:nspins))
269 : END IF
270 :
271 12794 : IF (gradient_functional) THEN
272 : ALLOCATE (drho_h(1:4, 1:na, 1:nr, 1:nspins), drho1_h(1:4, 1:na, 1:nr, 1:nspins), &
273 128352 : drho_s(1:4, 1:na, 1:nr, 1:nspins), drho1_s(1:4, 1:na, 1:nr, 1:nspins))
274 73344 : ALLOCATE (vxg_h(1:3, 1:na, 1:nr, 1:nspins), vxg_s(1:3, 1:na, 1:nr, 1:nspins))
275 : ELSE
276 : ALLOCATE (drho_h(1, 1, 1, 1), drho1_h(1, 1, 1, 1), &
277 3626 : drho_s(1, 1, 1, 1), drho1_s(1, 1, 1, 1))
278 3626 : ALLOCATE (vxg_h(1, 1, 1, 1), vxg_s(1, 1, 1, 1))
279 3626 : rrho = 0.0_dp
280 : END IF
281 95190166 : vxg_h = 0.0_dp
282 95190166 : vxg_s = 0.0_dp
283 :
284 : ! NLCC: prepare rho and drho of the core charge for this KIND
285 12794 : donlcc = .FALSE.
286 12794 : IF (nlcc) THEN
287 208 : NULLIFY (rho_nlcc)
288 208 : rho_nlcc => my_kind_set(ikind)%nlcc_pot
289 208 : IF (ASSOCIATED(rho_nlcc)) donlcc = .TRUE.
290 : END IF
291 :
292 : ! parallelization
293 12794 : IF (PRESENT(para_env_ext)) THEN
294 6026 : local_loop_limit = get_limit(natom, para_env_ext%num_pe, para_env_ext%mepos)
295 : ELSE
296 6768 : local_loop_limit = get_limit(natom, para_env%num_pe, para_env%mepos)
297 : END IF
298 :
299 21885 : DO iatom = local_loop_limit(1), local_loop_limit(2) !1,natom
300 9091 : atom = atom_list(iatom)
301 :
302 9091 : rho_atom_set(atom)%exc_h = 0.0_dp
303 9091 : rho_atom_set(atom)%exc_s = 0.0_dp
304 9091 : rho1_atom_set(atom)%exc_h = 0.0_dp
305 9091 : rho1_atom_set(atom)%exc_s = 0.0_dp
306 :
307 9091 : rho_atom => rho_atom_set(atom)
308 9091 : rho1_atom => rho1_atom_set(atom)
309 9091 : NULLIFY (r_h, r_s, dr_h, dr_s, r_h_d, r_s_d)
310 9091 : NULLIFY (r1_h, r1_s, dr1_h, dr1_s, r1_h_d, r1_s_d)
311 23837982 : rho_h = 0.0_dp
312 23837982 : rho_s = 0.0_dp
313 23837982 : rho1_h = 0.0_dp
314 23837982 : rho1_s = 0.0_dp
315 9091 : IF (gradient_functional) THEN
316 : CALL get_rho_atom(rho_atom=rho_atom, &
317 : rho_rad_h=r_h, rho_rad_s=r_s, &
318 : drho_rad_h=dr_h, drho_rad_s=dr_s, &
319 6543 : rho_rad_h_d=r_h_d, rho_rad_s_d=r_s_d)
320 : CALL get_rho_atom(rho_atom=rho1_atom, &
321 : rho_rad_h=r1_h, rho_rad_s=r1_s, &
322 : drho_rad_h=dr1_h, drho_rad_s=dr1_s, &
323 6543 : rho_rad_h_d=r1_h_d, rho_rad_s_d=r1_s_d)
324 170273409 : drho_h = 0.0_dp; drho_s = 0.0_dp
325 170273409 : drho1_h = 0.0_dp; drho1_s = 0.0_dp
326 : ELSE
327 : CALL get_rho_atom(rho_atom=rho_atom, &
328 2548 : rho_rad_h=r_h, rho_rad_s=r_s)
329 : CALL get_rho_atom(rho_atom=rho1_atom, &
330 2548 : rho_rad_h=r1_h, rho_rad_s=r1_s)
331 : END IF
332 :
333 9091 : rtot = 0.0_dp
334 :
335 463641 : DO ir = 1, nr
336 : CALL calc_rho_angular(grid_atom, harmonics, nspins, gradient_functional, &
337 : ir, r_h, r_s, rho_h, rho_s, dr_h, dr_s, r_h_d, r_s_d, &
338 454550 : drho_h, drho_s)
339 454550 : IF (donlcc) THEN
340 : CALL calc_rho_nlcc(grid_atom, nspins, gradient_functional, &
341 2600 : ir, rho_nlcc(:, 1), rho_h, rho_s, rho_nlcc(:, 2), drho_h, drho_s)
342 : END IF
343 : CALL calc_rho_angular(grid_atom, harmonics, nspins, gradient_functional, &
344 : ir, r1_h, r1_s, rho1_h, rho1_s, dr1_h, dr1_s, r1_h_d, r1_s_d, &
345 463641 : drho1_h, drho1_s)
346 : END DO
347 9091 : IF (tau_f) THEN
348 0 : CALL calc_tau_atom(tau_h, tau_s, rho_atom, tau_basis_cache, nspins)
349 0 : CALL calc_tau_atom(tau1_h, tau1_s, rho1_atom, tau_basis_cache, nspins)
350 : END IF
351 9091 : IF (scale_rho) THEN
352 926376 : rho_h = 2.0_dp*rho_h
353 926376 : rho_s = 2.0_dp*rho_s
354 363 : IF (gradient_functional) THEN
355 3426696 : drho_h = 2.0_dp*drho_h
356 3426696 : drho_s = 2.0_dp*drho_s
357 : END IF
358 363 : IF (tau_f) THEN
359 0 : tau_h = 2.0_dp*tau_h
360 0 : tau_s = 2.0_dp*tau_s
361 : END IF
362 : END IF
363 :
364 463641 : DO ir = 1, nr
365 463641 : IF (tau_f) THEN
366 0 : CALL fill_rho_set(rho_set_h, lsd, nspins, needs, rho_h, drho_h, tau_h, na, ir)
367 0 : CALL fill_rho_set(rho1_set_h, lsd, nspins, needs, rho1_h, drho1_h, tau1_h, na, ir)
368 0 : CALL fill_rho_set(rho_set_s, lsd, nspins, needs, rho_s, drho_s, tau_s, na, ir)
369 0 : CALL fill_rho_set(rho1_set_s, lsd, nspins, needs, rho1_s, drho1_s, tau1_s, na, ir)
370 454550 : ELSE IF (gradient_functional) THEN
371 327150 : CALL fill_rho_set(rho_set_h, lsd, nspins, needs, rho_h, drho_h, rtau, na, ir)
372 327150 : CALL fill_rho_set(rho1_set_h, lsd, nspins, needs, rho1_h, drho1_h, rtau, na, ir)
373 327150 : CALL fill_rho_set(rho_set_s, lsd, nspins, needs, rho_s, drho_s, rtau, na, ir)
374 327150 : CALL fill_rho_set(rho1_set_s, lsd, nspins, needs, rho1_s, drho1_s, rtau, na, ir)
375 : ELSE
376 127400 : CALL fill_rho_set(rho_set_h, lsd, nspins, needs, rho_h, rrho, rtau, na, ir)
377 127400 : CALL fill_rho_set(rho1_set_h, lsd, nspins, needs, rho1_h, rrho, rtau, na, ir)
378 127400 : CALL fill_rho_set(rho_set_s, lsd, nspins, needs, rho_s, rrho, rtau, na, ir)
379 127400 : CALL fill_rho_set(rho1_set_s, lsd, nspins, needs, rho1_s, rrho, rtau, na, ir)
380 : END IF
381 : END DO
382 :
383 : CALL xc_2nd_deriv_of_r(xc_section=xc_section, &
384 : rho_set=rho_set_h, rho1_set=rho1_set_h, &
385 : deriv_set=deriv_set, &
386 : w=weight_h, vxc=vxc_h, vxg=vxg_h, vtau=vtau_h, do_triplet=do_triplet, &
387 9091 : do_sf=my_do_sf)
388 : CALL xc_2nd_deriv_of_r(xc_section=xc_section, &
389 : rho_set=rho_set_s, rho1_set=rho1_set_s, &
390 : deriv_set=deriv_set, &
391 : w=weight_s, vxc=vxc_s, vxg=vxg_s, vtau=vtau_s, do_triplet=do_triplet, &
392 9091 : do_sf=my_do_sf)
393 :
394 9091 : CALL get_rho_atom(rho_atom=rho1_atom, ga_Vlocal_gb_h=int_hh, ga_Vlocal_gb_s=int_ss)
395 9091 : IF (gradient_functional) THEN
396 : CALL gaVxcgb_GC(vxc_h, vxc_s, vxg_h, vxg_s, int_hh, int_ss, &
397 6543 : grid_atom, basis_1c, harmonics, nspins)
398 : ELSE
399 : CALL gaVxcgb_noGC(vxc_h, vxc_s, int_hh, int_ss, &
400 2548 : grid_atom, basis_1c, harmonics, nspins)
401 : END IF
402 9091 : IF (tau_f) THEN
403 : CALL dgaVtaudgb(vtau_h, vtau_s, int_hh, int_ss, &
404 0 : tau_basis_cache, nspins)
405 : END IF
406 :
407 21885 : NULLIFY (r_h, r_s, dr_h, dr_s)
408 :
409 : END DO
410 :
411 : ! some cleanup
412 12794 : DEALLOCATE (rho_h, rho_s, rho1_h, rho1_s, vxc_h, vxc_s)
413 12794 : DEALLOCATE (drho_h, drho_s, vxg_h, vxg_s)
414 12794 : DEALLOCATE (drho1_h, drho1_s)
415 12794 : IF (tau_f) THEN
416 0 : DEALLOCATE (tau_h, tau_s, tau1_h, tau1_s)
417 0 : DEALLOCATE (vtau_h, vtau_s)
418 0 : CALL release_tau_basis_cache(tau_basis_cache)
419 : END IF
420 :
421 12794 : CALL xc_dset_release(deriv_set)
422 12794 : CALL xc_rho_set_release(rho_set_h)
423 12794 : CALL xc_rho_set_release(rho1_set_h)
424 12794 : CALL xc_rho_set_release(rho_set_s)
425 46260 : CALL xc_rho_set_release(rho1_set_s)
426 : END DO
427 :
428 6242 : CALL timestop(handle)
429 :
430 536812 : END SUBROUTINE fxc_atom_calc
431 :
432 : END MODULE qs_fxc_atom
|
