(git:48c3be8)
Loading...
Searching...
No Matches
xc.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Exchange and Correlation functional calculations
10!> \par History
11!> (13-Feb-2001) JGH, based on earlier version of apsi
12!> 02.2003 Many many changes [fawzi]
13!> 03.2004 new xc interface [fawzi]
14!> 04.2004 kinetic functionals [fawzi]
15!> \author fawzi
16! **************************************************************************************************
17MODULE xc
33 USE kinds, ONLY: default_path_length, &
34 dp
37 USE pw_methods, ONLY: pw_axpy, &
38 pw_copy, &
40 pw_derive, &
42 pw_scale, &
45 USE pw_pool_types, ONLY: &
47 USE pw_types, ONLY: &
49 USE xc_derivative_desc, ONLY: &
71#include "../base/base_uses.f90"
72
73 IMPLICIT NONE
74 PRIVATE
79 PUBLIC :: calc_xc_density
80
81 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
82 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc'
83 CHARACTER(len=*), PARAMETER, PRIVATE :: gauxc_high_deriv_message = &
84 "Response and kernel properties with GauXC/Skala require higher XC derivatives, "// &
85 "which are not implemented. Use a native CP2K XC functional or disable the coupled XC kernel."
86
87CONTAINS
88
89! **************************************************************************************************
90!> \brief ...
91!> \param xc_fun_section ...
92!> \param lsd ...
93!> \return ...
94! **************************************************************************************************
95 FUNCTION xc_uses_kinetic_energy_density(xc_fun_section, lsd) RESULT(res)
96 TYPE(section_vals_type), POINTER, INTENT(IN) :: xc_fun_section
97 LOGICAL, INTENT(IN) :: lsd
98 LOGICAL :: res
99
100 TYPE(xc_rho_cflags_type) :: needs
101
102 needs = xc_functionals_get_needs(xc_fun_section, &
103 lsd=lsd, &
104 calc_potential=.false.)
105 res = (needs%tau_spin .OR. needs%tau)
106
108
109! **************************************************************************************************
110!> \brief ...
111!> \param xc_fun_section ...
112!> \param lsd ...
113!> \return ...
114! **************************************************************************************************
115 FUNCTION xc_uses_norm_drho(xc_fun_section, lsd) RESULT(res)
116 TYPE(section_vals_type), POINTER, INTENT(IN) :: xc_fun_section
117 LOGICAL, INTENT(IN) :: lsd
118 LOGICAL :: res
119
120 TYPE(xc_rho_cflags_type) :: needs
121
122 needs = xc_functionals_get_needs(xc_fun_section, &
123 lsd=lsd, &
124 calc_potential=.false.)
125 res = (needs%norm_drho .OR. needs%norm_drho_spin)
126
127 END FUNCTION xc_uses_norm_drho
128
129! **************************************************************************************************
130!> \brief creates a xc_rho_set and a derivative set containing the derivatives
131!> of the functionals with the given deriv_order.
132!> \param rho_set will contain the rho set
133!> \param deriv_set will contain the derivatives
134!> \param deriv_order the order of the requested derivatives. If positive
135!> 0:deriv_order are calculated, if negative only -deriv_order is
136!> guaranteed to be valid. Orders not requested might be present,
137!> but might contain garbage.
138!> \param rho_r the value of the density in the real space
139!> \param rho_g value of the density in the g space (can be null, used only
140!> without smoothing of rho or deriv)
141!> \param tau value of the kinetic density tau on the grid (can be null,
142!> used only with meta functionals)
143!> \param xc_section the section describing the functional to use
144!> \param pw_pool the pool for the grids
145!> \param weights integration weights
146!> \param calc_potential if the basic components of the arguments
147!> should be kept in rho set (a basic component is for example drho
148!> when with lda a functional needs norm_drho)
149!> \author fawzi
150!> \note
151!> if any of the functionals is gradient corrected the full gradient is
152!> added to the rho set
153! **************************************************************************************************
154 SUBROUTINE xc_rho_set_and_dset_create(rho_set, deriv_set, deriv_order, &
155 rho_r, rho_g, tau, xc_section, pw_pool, &
156 weights, calc_potential)
157
158 TYPE(xc_rho_set_type) :: rho_set
159 TYPE(xc_derivative_set_type) :: deriv_set
160 INTEGER, INTENT(in) :: deriv_order
161 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau
162 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
163 TYPE(section_vals_type), POINTER :: xc_section
164 TYPE(pw_pool_type), POINTER :: pw_pool
165 TYPE(pw_r3d_rs_type), POINTER :: weights
166 LOGICAL, INTENT(in) :: calc_potential
167
168 CHARACTER(len=*), PARAMETER :: routinen = 'xc_rho_set_and_dset_create'
169
170 INTEGER :: handle, nspins
171 LOGICAL :: lsd
172 TYPE(xc_derivative_type), POINTER :: deriv_att
173 TYPE(cp_sll_xc_deriv_type), POINTER :: pos
174 TYPE(section_vals_type), POINTER :: xc_fun_sections
175
176 CALL timeset(routinen, handle)
177
178 mark_used(weights)
179
180 cpassert(ASSOCIATED(pw_pool))
181
182 nspins = SIZE(rho_r)
183 lsd = (nspins /= 1)
184
185 xc_fun_sections => section_vals_get_subs_vals(xc_section, "XC_FUNCTIONAL")
186
187 ! Create deriv_set object
188 CALL xc_dset_create(deriv_set, pw_pool)
189
190 ! Create objects for density related stuff
191 CALL xc_rho_set_create(rho_set, &
192 rho_r(1)%pw_grid%bounds_local, &
193 rho_cutoff=section_get_rval(xc_section, "density_cutoff"), &
194 drho_cutoff=section_get_rval(xc_section, "gradient_cutoff"), &
195 tau_cutoff=section_get_rval(xc_section, "tau_cutoff"))
196
197 ! Calculate density stuff, for example the gradient of rho, according to the functional needs
198 CALL xc_rho_set_update(rho_set, rho_r, rho_g, tau, &
199 xc_functionals_get_needs(xc_fun_sections, lsd, calc_potential), &
200 section_get_ival(xc_section, "XC_GRID%XC_DERIV"), &
201 section_get_ival(xc_section, "XC_GRID%XC_SMOOTH_RHO"), &
202 pw_pool)
203
204 ! Calculate values of the functional on the grid
205 CALL xc_functionals_eval(xc_fun_sections, &
206 lsd=lsd, &
207 rho_set=rho_set, &
208 deriv_set=deriv_set, &
209 deriv_order=deriv_order)
210
211 ! apply weights
212 IF (ASSOCIATED(weights)) THEN
213 pos => deriv_set%derivs
214 DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
215 deriv_att%deriv_data(:, :, :) = weights%array(:, :, :)*deriv_att%deriv_data(:, :, :)
216 END DO
217 END IF
218
219 CALL divide_by_norm_drho(deriv_set, rho_set, lsd)
220
221 CALL timestop(handle)
222
223 END SUBROUTINE xc_rho_set_and_dset_create
224
225! **************************************************************************************************
226!> \brief smooths the cutoff on rho with a function smoothderiv_rho that is 0
227!> for rho<rho_cutoff and 1 for rho>rho_cutoff*rho_smooth_cutoff_range:
228!> E= integral e_0*smoothderiv_rho => dE/d...= de/d... * smooth,
229!> dE/drho = de/drho * smooth + e_0 * dsmooth/drho
230!> \param pot the potential to smooth
231!> \param rho , rhoa,rhob: the value of the density (used to apply the cutoff)
232!> \param rhoa ...
233!> \param rhob ...
234!> \param rho_cutoff the value at whch the cutoff function must go to 0
235!> \param rho_smooth_cutoff_range range of the smoothing
236!> \param e_0 value of e_0, if given it is assumed that pot is the derivative
237!> wrt. to rho, and needs the dsmooth*e_0 contribution
238!> \param e_0_scale_factor ...
239!> \author Fawzi Mohamed
240! **************************************************************************************************
241 SUBROUTINE smooth_cutoff(pot, rho, rhoa, rhob, rho_cutoff, &
242 rho_smooth_cutoff_range, e_0, e_0_scale_factor)
243 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN), &
244 POINTER :: pot, rho, rhoa, rhob
245 REAL(kind=dp), INTENT(in) :: rho_cutoff, rho_smooth_cutoff_range
246 REAL(kind=dp), DIMENSION(:, :, :), OPTIONAL, &
247 POINTER :: e_0
248 REAL(kind=dp), INTENT(in), OPTIONAL :: e_0_scale_factor
249
250 INTEGER :: i, j, k
251 INTEGER, DIMENSION(2, 3) :: bo
252 REAL(kind=dp) :: my_e_0_scale_factor, my_rho, my_rho_n, my_rho_n2, rho_smooth_cutoff, &
253 rho_smooth_cutoff_2, rho_smooth_cutoff_range_2
254
255 cpassert(ASSOCIATED(pot))
256 bo(1, :) = lbound(pot)
257 bo(2, :) = ubound(pot)
258 my_e_0_scale_factor = 1.0_dp
259 IF (PRESENT(e_0_scale_factor)) my_e_0_scale_factor = e_0_scale_factor
260 rho_smooth_cutoff = rho_cutoff*rho_smooth_cutoff_range
261 rho_smooth_cutoff_2 = (rho_cutoff + rho_smooth_cutoff)/2
262 rho_smooth_cutoff_range_2 = rho_smooth_cutoff_2 - rho_cutoff
263
264 IF (rho_smooth_cutoff_range > 0.0_dp) THEN
265 IF (PRESENT(e_0)) THEN
266 cpassert(ASSOCIATED(e_0))
267 IF (ASSOCIATED(rho)) THEN
268!$OMP PARALLEL DO DEFAULT(NONE) &
269!$OMP SHARED(bo,e_0,pot,rho,rho_cutoff,rho_smooth_cutoff,rho_smooth_cutoff_2, &
270!$OMP rho_smooth_cutoff_range_2,my_e_0_scale_factor) &
271!$OMP PRIVATE(k,j,i,my_rho,my_rho_n,my_rho_n2) &
272!$OMP COLLAPSE(3)
273 DO k = bo(1, 3), bo(2, 3)
274 DO j = bo(1, 2), bo(2, 2)
275 DO i = bo(1, 1), bo(2, 1)
276 my_rho = rho(i, j, k)
277 IF (my_rho < rho_smooth_cutoff) THEN
278 IF (my_rho < rho_cutoff) THEN
279 pot(i, j, k) = 0.0_dp
280 ELSE IF (my_rho < rho_smooth_cutoff_2) THEN
281 my_rho_n = (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
282 my_rho_n2 = my_rho_n*my_rho_n
283 pot(i, j, k) = pot(i, j, k)* &
284 my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2) + &
285 my_e_0_scale_factor*e_0(i, j, k)* &
286 my_rho_n2*(3.0_dp - 2.0_dp*my_rho_n) &
287 /rho_smooth_cutoff_range_2
288 ELSE
289 my_rho_n = 2.0_dp - (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
290 my_rho_n2 = my_rho_n*my_rho_n
291 pot(i, j, k) = pot(i, j, k)* &
292 (1.0_dp - my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2)) &
293 + my_e_0_scale_factor*e_0(i, j, k)* &
294 my_rho_n2*(3.0_dp - 2.0_dp*my_rho_n) &
295 /rho_smooth_cutoff_range_2
296 END IF
297 END IF
298 END DO
299 END DO
300 END DO
301!$OMP END PARALLEL DO
302 ELSE
303!$OMP PARALLEL DO DEFAULT(NONE) &
304!$OMP SHARED(bo,pot,e_0,rhoa,rhob,rho_cutoff,rho_smooth_cutoff,rho_smooth_cutoff_2, &
305!$OMP rho_smooth_cutoff_range_2,my_e_0_scale_factor) &
306!$OMP PRIVATE(k,j,i,my_rho,my_rho_n,my_rho_n2) &
307!$OMP COLLAPSE(3)
308 DO k = bo(1, 3), bo(2, 3)
309 DO j = bo(1, 2), bo(2, 2)
310 DO i = bo(1, 1), bo(2, 1)
311 my_rho = rhoa(i, j, k) + rhob(i, j, k)
312 IF (my_rho < rho_smooth_cutoff) THEN
313 IF (my_rho < rho_cutoff) THEN
314 pot(i, j, k) = 0.0_dp
315 ELSE IF (my_rho < rho_smooth_cutoff_2) THEN
316 my_rho_n = (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
317 my_rho_n2 = my_rho_n*my_rho_n
318 pot(i, j, k) = pot(i, j, k)* &
319 my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2) + &
320 my_e_0_scale_factor*e_0(i, j, k)* &
321 my_rho_n2*(3.0_dp - 2.0_dp*my_rho_n) &
322 /rho_smooth_cutoff_range_2
323 ELSE
324 my_rho_n = 2.0_dp - (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
325 my_rho_n2 = my_rho_n*my_rho_n
326 pot(i, j, k) = pot(i, j, k)* &
327 (1.0_dp - my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2)) &
328 + my_e_0_scale_factor*e_0(i, j, k)* &
329 my_rho_n2*(3.0_dp - 2.0_dp*my_rho_n) &
330 /rho_smooth_cutoff_range_2
331 END IF
332 END IF
333 END DO
334 END DO
335 END DO
336!$OMP END PARALLEL DO
337 END IF
338 ELSE
339 IF (ASSOCIATED(rho)) THEN
340!$OMP PARALLEL DO DEFAULT(NONE) &
341!$OMP SHARED(bo,pot,rho_cutoff,rho_smooth_cutoff,rho_smooth_cutoff_2, &
342!$OMP rho_smooth_cutoff_range_2,rho) &
343!$OMP PRIVATE(k,j,i,my_rho,my_rho_n,my_rho_n2) &
344!$OMP COLLAPSE(3)
345 DO k = bo(1, 3), bo(2, 3)
346 DO j = bo(1, 2), bo(2, 2)
347 DO i = bo(1, 1), bo(2, 1)
348 my_rho = rho(i, j, k)
349 IF (my_rho < rho_smooth_cutoff) THEN
350 IF (my_rho < rho_cutoff) THEN
351 pot(i, j, k) = 0.0_dp
352 ELSE IF (my_rho < rho_smooth_cutoff_2) THEN
353 my_rho_n = (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
354 my_rho_n2 = my_rho_n*my_rho_n
355 pot(i, j, k) = pot(i, j, k)* &
356 my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2)
357 ELSE
358 my_rho_n = 2.0_dp - (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
359 my_rho_n2 = my_rho_n*my_rho_n
360 pot(i, j, k) = pot(i, j, k)* &
361 (1.0_dp - my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2))
362 END IF
363 END IF
364 END DO
365 END DO
366 END DO
367!$OMP END PARALLEL DO
368 ELSE
369!$OMP PARALLEL DO DEFAULT(NONE) &
370!$OMP SHARED(bo,pot,rho_cutoff,rho_smooth_cutoff,rho_smooth_cutoff_2, &
371!$OMP rho_smooth_cutoff_range_2,rhoa,rhob) &
372!$OMP PRIVATE(k,j,i,my_rho,my_rho_n,my_rho_n2) &
373!$OMP COLLAPSE(3)
374 DO k = bo(1, 3), bo(2, 3)
375 DO j = bo(1, 2), bo(2, 2)
376 DO i = bo(1, 1), bo(2, 1)
377 my_rho = rhoa(i, j, k) + rhob(i, j, k)
378 IF (my_rho < rho_smooth_cutoff) THEN
379 IF (my_rho < rho_cutoff) THEN
380 pot(i, j, k) = 0.0_dp
381 ELSE IF (my_rho < rho_smooth_cutoff_2) THEN
382 my_rho_n = (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
383 my_rho_n2 = my_rho_n*my_rho_n
384 pot(i, j, k) = pot(i, j, k)* &
385 my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2)
386 ELSE
387 my_rho_n = 2.0_dp - (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
388 my_rho_n2 = my_rho_n*my_rho_n
389 pot(i, j, k) = pot(i, j, k)* &
390 (1.0_dp - my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2))
391 END IF
392 END IF
393 END DO
394 END DO
395 END DO
396!$OMP END PARALLEL DO
397 END IF
398 END IF
399 END IF
400 END SUBROUTINE smooth_cutoff
401
402 SUBROUTINE calc_xc_density(pot, rho, rho_cutoff)
403 TYPE(pw_r3d_rs_type), INTENT(INOUT) :: pot
404 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(INOUT) :: rho
405 REAL(kind=dp), INTENT(in) :: rho_cutoff
406
407 INTEGER :: i, j, k, nspins
408 INTEGER, DIMENSION(2, 3) :: bo
409 REAL(kind=dp) :: eps1, eps2, my_rho, my_pot
410
411 bo(1, :) = lbound(pot%array)
412 bo(2, :) = ubound(pot%array)
413 nspins = SIZE(rho)
414
415 eps1 = rho_cutoff*1.e-4_dp
416 eps2 = rho_cutoff
417
418 DO k = bo(1, 3), bo(2, 3)
419 DO j = bo(1, 2), bo(2, 2)
420 DO i = bo(1, 1), bo(2, 1)
421 my_pot = pot%array(i, j, k)
422 IF (nspins == 2) THEN
423 my_rho = rho(1)%array(i, j, k) + rho(2)%array(i, j, k)
424 ELSE
425 my_rho = rho(1)%array(i, j, k)
426 END IF
427 IF (my_rho > eps1) THEN
428 pot%array(i, j, k) = my_pot/my_rho
429 ELSE IF (my_rho < eps2) THEN
430 pot%array(i, j, k) = 0.0_dp
431 ELSE
432 pot%array(i, j, k) = min(my_pot/my_rho, my_rho**(1._dp/3._dp))
433 END IF
434 END DO
435 END DO
436 END DO
437
438 END SUBROUTINE calc_xc_density
439
440! **************************************************************************************************
441!> \brief Exchange and Correlation functional calculations
442!> \param vxc_rho will contain the v_xc part that depend on rho
443!> (if one of the chosen xc functionals has it it is allocated and you
444!> are responsible for it)
445!> \param vxc_tau will contain the kinetic tau part of v_xc
446!> (if one of the chosen xc functionals has it it is allocated and you
447!> are responsible for it)
448!> \param exc the xc energy
449!> \param rho_r the value of the density in the real space
450!> \param rho_g value of the density in the g space (needs to be associated
451!> only for gradient corrections)
452!> \param tau value of the kinetic density tau on the grid (can be null,
453!> used only with meta functionals)
454!> \param xc_section which functional to calculate, and how to do it
455!> \param weights integration weights
456!> \param pw_pool the pool for the grids
457!> \param compute_virial ...
458!> \param virial_xc ...
459!> \param exc_r the value of the xc functional in the real space
460!> \par History
461!> JGH (13-Jun-2002): adaptation to new functionals
462!> Fawzi (11.2002): drho_g(1:3)->drho_g
463!> Fawzi (1.2003). lsd version
464!> Fawzi (11.2003): version using the new xc interface
465!> Fawzi (03.2004): fft free for smoothed density and derivs, gga lsd
466!> Fawzi (04.2004): metafunctionals
467!> mguidon (12.2008) : laplace functionals
468!> \author fawzi; based LDA version of JGH, based on earlier version of apsi
469!> \note
470!> Beware: some really dirty pointer handling!
471!> energy should be kept consistent with xc_exc_calc
472! **************************************************************************************************
473 SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section, weights, &
474 pw_pool, compute_virial, virial_xc, exc_r)
475 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: vxc_rho, vxc_tau
476 REAL(kind=dp), INTENT(out) :: exc
477 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau
478 TYPE(pw_r3d_rs_type), POINTER :: weights
479 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
480 TYPE(section_vals_type), POINTER :: xc_section
481 TYPE(pw_pool_type), POINTER :: pw_pool
482 LOGICAL :: compute_virial
483 REAL(kind=dp), DIMENSION(3, 3), INTENT(OUT) :: virial_xc
484 TYPE(pw_r3d_rs_type), INTENT(INOUT), OPTIONAL :: exc_r
485
486 CHARACTER(len=*), PARAMETER :: routinen = 'xc_vxc_pw_create'
487 INTEGER, DIMENSION(2), PARAMETER :: norm_drho_spin_name = [deriv_norm_drhoa, deriv_norm_drhob]
488
489 INTEGER :: handle, idir, ispin, jdir, &
490 npoints, nspins, &
491 xc_deriv_method_id, xc_rho_smooth_id, deriv_id
492 INTEGER, DIMENSION(2, 3) :: bo
493 LOGICAL :: dealloc_pw_to_deriv, has_laplace, &
494 has_tau, lsd, use_virial, has_gradient, &
495 has_derivs, has_rho, dealloc_pw_to_deriv_rho
496 REAL(kind=dp) :: density_smooth_cut_range, drho_cutoff, &
497 rho_cutoff
498 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data, norm_drho, norm_drho_spin, &
499 rho, rhoa, rhob
500 TYPE(cp_sll_xc_deriv_type), POINTER :: pos
501 TYPE(pw_grid_type), POINTER :: pw_grid
502 TYPE(pw_r3d_rs_type), DIMENSION(3) :: pw_to_deriv, pw_to_deriv_rho
503 TYPE(pw_c1d_gs_type) :: tmp_g, vxc_g
504 TYPE(pw_r3d_rs_type) :: v_drho_r, virial_pw
505 TYPE(xc_derivative_set_type) :: deriv_set
506 TYPE(xc_derivative_type), POINTER :: deriv_att
507 TYPE(xc_rho_set_type) :: rho_set
508
509 CALL timeset(routinen, handle)
510 NULLIFY (norm_drho_spin, norm_drho, pos)
511
512 pw_grid => rho_r(1)%pw_grid
513
514 cpassert(ASSOCIATED(xc_section))
515 cpassert(ASSOCIATED(pw_pool))
516 cpassert(.NOT. ASSOCIATED(vxc_rho))
517 cpassert(.NOT. ASSOCIATED(vxc_tau))
518 nspins = SIZE(rho_r)
519 lsd = (nspins /= 1)
520 IF (lsd) THEN
521 cpassert(nspins == 2)
522 END IF
523
524 use_virial = compute_virial
525 virial_xc = 0.0_dp
526
527 bo = rho_r(1)%pw_grid%bounds_local
528 npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1)
529
530 ! calculate the potential derivatives
531 CALL xc_rho_set_and_dset_create(rho_set=rho_set, deriv_set=deriv_set, &
532 deriv_order=1, rho_r=rho_r, rho_g=rho_g, tau=tau, &
533 xc_section=xc_section, &
534 pw_pool=pw_pool, weights=weights, &
535 calc_potential=.true.)
536
537 CALL section_vals_val_get(xc_section, "XC_GRID%XC_DERIV", &
538 i_val=xc_deriv_method_id)
539 CALL section_vals_val_get(xc_section, "XC_GRID%XC_SMOOTH_RHO", &
540 i_val=xc_rho_smooth_id)
541 CALL section_vals_val_get(xc_section, "DENSITY_SMOOTH_CUTOFF_RANGE", &
542 r_val=density_smooth_cut_range)
543
544 CALL xc_rho_set_get(rho_set, rho_cutoff=rho_cutoff, &
545 drho_cutoff=drho_cutoff)
546
547 CALL check_for_derivatives(deriv_set, lsd, has_rho, has_gradient, has_tau, has_laplace)
548 ! check for unknown derivatives
549 has_derivs = has_rho .OR. has_gradient .OR. has_tau .OR. has_laplace
550
551 ALLOCATE (vxc_rho(nspins))
552
553 CALL xc_rho_set_get(rho_set, rho=rho, rhoa=rhoa, rhob=rhob, &
554 can_return_null=.true.)
555
556 ! recover the vxc arrays
557 IF (lsd) THEN
558 CALL xc_dset_recover_pw(deriv_set, [deriv_rhoa], vxc_rho(1), pw_grid, pw_pool)
559 CALL xc_dset_recover_pw(deriv_set, [deriv_rhob], vxc_rho(2), pw_grid, pw_pool)
560 ELSE
561 CALL xc_dset_recover_pw(deriv_set, [deriv_rho], vxc_rho(1), pw_grid, pw_pool)
562 END IF
563
564 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho])
565 IF (ASSOCIATED(deriv_att)) THEN
566 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
567
568 CALL xc_rho_set_get(rho_set, norm_drho=norm_drho, &
569 rho_cutoff=rho_cutoff, &
570 drho_cutoff=drho_cutoff, &
571 can_return_null=.true.)
572 CALL xc_rho_set_recover_pw(rho_set, pw_grid, pw_pool, dealloc_pw_to_deriv_rho, drho=pw_to_deriv_rho)
573
574 cpassert(ASSOCIATED(deriv_data))
575 IF (use_virial) THEN
576 CALL pw_pool%create_pw(virial_pw)
577 CALL pw_zero(virial_pw)
578 DO idir = 1, 3
579!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(virial_pw,pw_to_deriv_rho,deriv_data,idir)
580 virial_pw%array(:, :, :) = pw_to_deriv_rho(idir)%array(:, :, :)*deriv_data(:, :, :)
581!$OMP END PARALLEL WORKSHARE
582 DO jdir = 1, idir
583 virial_xc(idir, jdir) = -pw_grid%dvol* &
584 accurate_dot_product(virial_pw%array(:, :, :), &
585 pw_to_deriv_rho(jdir)%array(:, :, :))
586 virial_xc(jdir, idir) = virial_xc(idir, jdir)
587 END DO
588 END DO
589 CALL pw_pool%give_back_pw(virial_pw)
590 END IF ! use_virial
591 DO idir = 1, 3
592 cpassert(ASSOCIATED(pw_to_deriv_rho(idir)%array))
593!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_data,pw_to_deriv_rho,idir)
594 pw_to_deriv_rho(idir)%array(:, :, :) = pw_to_deriv_rho(idir)%array(:, :, :)*deriv_data(:, :, :)
595!$OMP END PARALLEL WORKSHARE
596 END DO
597
598 ! Deallocate pw to save memory
599 CALL pw_pool%give_back_cr3d(deriv_att%deriv_data)
600
601 END IF
602
603 IF ((has_gradient .AND. xc_requires_tmp_g(xc_deriv_method_id)) .OR. pw_grid%spherical) THEN
604 CALL pw_pool%create_pw(vxc_g)
605 IF (.NOT. pw_grid%spherical) THEN
606 CALL pw_pool%create_pw(tmp_g)
607 END IF
608 END IF
609
610 DO ispin = 1, nspins
611
612 IF (lsd) THEN
613 IF (ispin == 1) THEN
614 CALL xc_rho_set_get(rho_set, norm_drhoa=norm_drho_spin, &
615 can_return_null=.true.)
616 IF (ASSOCIATED(norm_drho_spin)) CALL xc_rho_set_recover_pw( &
617 rho_set, pw_grid, pw_pool, dealloc_pw_to_deriv, drhoa=pw_to_deriv)
618 ELSE
619 CALL xc_rho_set_get(rho_set, norm_drhob=norm_drho_spin, &
620 can_return_null=.true.)
621 IF (ASSOCIATED(norm_drho_spin)) CALL xc_rho_set_recover_pw( &
622 rho_set, pw_grid, pw_pool, dealloc_pw_to_deriv, drhob=pw_to_deriv)
623 END IF
624
625 deriv_att => xc_dset_get_derivative(deriv_set, [norm_drho_spin_name(ispin)])
626 IF (ASSOCIATED(deriv_att)) THEN
627 cpassert(lsd)
628 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
629
630 IF (use_virial) THEN
631 CALL pw_pool%create_pw(virial_pw)
632 CALL pw_zero(virial_pw)
633 DO idir = 1, 3
634!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_data,pw_to_deriv,virial_pw,idir)
635 virial_pw%array(:, :, :) = pw_to_deriv(idir)%array(:, :, :)*deriv_data(:, :, :)
636!$OMP END PARALLEL WORKSHARE
637 DO jdir = 1, idir
638 virial_xc(idir, jdir) = virial_xc(idir, jdir) - pw_grid%dvol* &
639 accurate_dot_product(virial_pw%array(:, :, :), &
640 pw_to_deriv(jdir)%array(:, :, :))
641 virial_xc(jdir, idir) = virial_xc(idir, jdir)
642 END DO
643 END DO
644 CALL pw_pool%give_back_pw(virial_pw)
645 END IF ! use_virial
646
647 DO idir = 1, 3
648!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_data,idir,pw_to_deriv)
649 pw_to_deriv(idir)%array(:, :, :) = deriv_data(:, :, :)*pw_to_deriv(idir)%array(:, :, :)
650!$OMP END PARALLEL WORKSHARE
651 END DO
652 END IF ! deriv_att
653
654 END IF ! LSD
655
656 IF (ASSOCIATED(pw_to_deriv_rho(1)%array)) THEN
657 IF (.NOT. ASSOCIATED(pw_to_deriv(1)%array)) THEN
658 pw_to_deriv = pw_to_deriv_rho
659 dealloc_pw_to_deriv = ((.NOT. lsd) .OR. (ispin == 2))
660 dealloc_pw_to_deriv = dealloc_pw_to_deriv .AND. dealloc_pw_to_deriv_rho
661 ELSE
662 ! This branch is called in case of open-shell systems
663 ! Add the contributions from norm_drho and norm_drho_spin
664 DO idir = 1, 3
665 CALL pw_axpy(pw_to_deriv_rho(idir), pw_to_deriv(idir))
666 IF (ispin == 2) THEN
667 IF (dealloc_pw_to_deriv_rho) THEN
668 CALL pw_pool%give_back_pw(pw_to_deriv_rho(idir))
669 END IF
670 END IF
671 END DO
672 END IF
673 END IF
674
675 IF (ASSOCIATED(pw_to_deriv(1)%array)) THEN
676 DO idir = 1, 3
677 CALL pw_scale(pw_to_deriv(idir), -1.0_dp)
678 END DO
679
680 CALL xc_pw_divergence(xc_deriv_method_id, pw_to_deriv, tmp_g, vxc_g, vxc_rho(ispin))
681
682 IF (dealloc_pw_to_deriv) THEN
683 DO idir = 1, 3
684 CALL pw_pool%give_back_pw(pw_to_deriv(idir))
685 END DO
686 END IF
687 END IF
688
689 ! Add laplace part to vxc_rho
690 IF (has_laplace) THEN
691 IF (lsd) THEN
692 IF (ispin == 1) THEN
693 deriv_id = deriv_laplace_rhoa
694 ELSE
695 deriv_id = deriv_laplace_rhob
696 END IF
697 ELSE
698 deriv_id = deriv_laplace_rho
699 END IF
700
701 CALL xc_dset_recover_pw(deriv_set, [deriv_id], pw_to_deriv(1), pw_grid)
702
703 IF (use_virial) CALL virial_laplace(rho_r(ispin), pw_pool, virial_xc, &
704 pw_to_deriv(1)%array)
705
706 CALL xc_pw_laplace(pw_to_deriv(1), pw_pool, xc_deriv_method_id)
707
708 CALL pw_axpy(pw_to_deriv(1), vxc_rho(ispin))
709
710 CALL pw_pool%give_back_pw(pw_to_deriv(1))
711 END IF
712
713 IF (pw_grid%spherical) THEN
714 ! filter vxc
715 CALL pw_transfer(vxc_rho(ispin), vxc_g)
716 CALL pw_transfer(vxc_g, vxc_rho(ispin))
717 END IF
718 CALL smooth_cutoff(pot=vxc_rho(ispin)%array, rho=rho, rhoa=rhoa, rhob=rhob, &
719 rho_cutoff=rho_cutoff*density_smooth_cut_range, &
720 rho_smooth_cutoff_range=density_smooth_cut_range)
721
722 v_drho_r = vxc_rho(ispin)
723 CALL pw_pool%create_pw(vxc_rho(ispin))
724 CALL xc_pw_smooth(v_drho_r, vxc_rho(ispin), xc_rho_smooth_id)
725 CALL pw_pool%give_back_pw(v_drho_r)
726 END DO
727
728 CALL pw_pool%give_back_pw(vxc_g)
729 CALL pw_pool%give_back_pw(tmp_g)
730
731 ! 0-deriv -> value of exc
732 ! this has to be kept consistent with xc_exc_calc
733 IF (has_derivs) THEN
734 CALL xc_dset_recover_pw(deriv_set, [INTEGER::], v_drho_r, pw_grid)
735
736 CALL smooth_cutoff(pot=v_drho_r%array, rho=rho, rhoa=rhoa, rhob=rhob, &
737 rho_cutoff=rho_cutoff, &
738 rho_smooth_cutoff_range=density_smooth_cut_range)
739
740 exc = pw_integrate_function(v_drho_r)
741 !
742 ! return the xc functional value at the grid points
743 !
744 IF (PRESENT(exc_r)) THEN
745 exc_r = v_drho_r
746 ELSE
747 CALL v_drho_r%release()
748 END IF
749 ELSE
750 exc = 0.0_dp
751 END IF
752
753 CALL xc_rho_set_release(rho_set, pw_pool=pw_pool)
754
755 ! tau part
756 IF (has_tau) THEN
757 ALLOCATE (vxc_tau(nspins))
758 IF (lsd) THEN
759 CALL xc_dset_recover_pw(deriv_set, [deriv_tau_a], vxc_tau(1), pw_grid)
760 CALL xc_dset_recover_pw(deriv_set, [deriv_tau_b], vxc_tau(2), pw_grid)
761 ELSE
762 CALL xc_dset_recover_pw(deriv_set, [deriv_tau], vxc_tau(1), pw_grid)
763 END IF
764 DO ispin = 1, nspins
765 cpassert(ASSOCIATED(vxc_tau(ispin)%array))
766 END DO
767 END IF
768 CALL xc_dset_release(deriv_set)
769
770 CALL timestop(handle)
771
772 END SUBROUTINE xc_vxc_pw_create
773
774! **************************************************************************************************
775!> \brief calculates just the exchange and correlation energy
776!> (no vxc)
777!> \param rho_r realspace density on the grid
778!> \param rho_g g-space density on the grid
779!> \param tau kinetic energy density on the grid
780!> \param xc_section XC parameters
781!> \param weights Integration weights
782!> \param pw_pool pool of plain-wave grids
783!> \return the XC energy
784!> \par History
785!> 11.2003 created [fawzi]
786!> \author fawzi
787!> \note
788!> has to be kept consistent with xc_vxc_pw_create
789! **************************************************************************************************
790 FUNCTION xc_exc_calc(rho_r, rho_g, tau, xc_section, weights, pw_pool) &
791 result(exc)
792 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau
793 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
794 TYPE(section_vals_type), POINTER :: xc_section
795 TYPE(pw_r3d_rs_type), POINTER :: weights
796 TYPE(pw_pool_type), POINTER :: pw_pool
797 REAL(kind=dp) :: exc
798
799 CHARACTER(len=*), PARAMETER :: routinen = 'xc_exc_calc'
800
801 INTEGER :: handle
802 REAL(dp) :: density_smooth_cut_range, rho_cutoff
803 REAL(dp), DIMENSION(:, :, :), POINTER :: e_0
804 TYPE(xc_derivative_set_type) :: deriv_set
805 TYPE(xc_derivative_type), POINTER :: deriv
806 TYPE(xc_rho_set_type) :: rho_set
807
808 CALL timeset(routinen, handle)
809
810 NULLIFY (deriv, e_0)
811 exc = 0.0_dp
812
813 ! this has to be consistent with what is done in xc_vxc_pw_create
814 CALL xc_rho_set_and_dset_create(rho_set=rho_set, &
815 deriv_set=deriv_set, deriv_order=0, &
816 rho_r=rho_r, rho_g=rho_g, tau=tau, xc_section=xc_section, &
817 pw_pool=pw_pool, weights=weights, &
818 calc_potential=.false.)
819 deriv => xc_dset_get_derivative(deriv_set, [INTEGER::])
820
821 IF (ASSOCIATED(deriv)) THEN
822 CALL xc_derivative_get(deriv, deriv_data=e_0)
823
824 CALL section_vals_val_get(xc_section, "DENSITY_CUTOFF", &
825 r_val=rho_cutoff)
826 CALL section_vals_val_get(xc_section, "DENSITY_SMOOTH_CUTOFF_RANGE", &
827 r_val=density_smooth_cut_range)
828 CALL smooth_cutoff(pot=e_0, rho=rho_set%rho, &
829 rhoa=rho_set%rhoa, rhob=rho_set%rhob, &
830 rho_cutoff=rho_cutoff, &
831 rho_smooth_cutoff_range=density_smooth_cut_range)
832
833 exc = accurate_sum(e_0)*rho_r(1)%pw_grid%dvol
834 IF (rho_r(1)%pw_grid%para%mode == pw_mode_distributed) THEN
835 CALL rho_r(1)%pw_grid%para%group%sum(exc)
836 END IF
837
838 CALL xc_rho_set_release(rho_set, pw_pool=pw_pool)
839 CALL xc_dset_release(deriv_set)
840 END IF
841
842 CALL timestop(handle)
843
844 END FUNCTION xc_exc_calc
845
846! **************************************************************************************************
847!> \brief calculates just the exchange and correlation energy density
848!> \param rho_r realspace density on the grid
849!> \param rho_g g-space density on the grid
850!> \param tau kinetic energy density on the grid
851!> \param xc_section XC parameters
852!> \param weights Integration weights
853!> \param pw_pool pool of plain-wave grids
854!> \param exc xc energy density
855!> \author JGH
856! **************************************************************************************************
857 SUBROUTINE xc_exc_pw_create(rho_r, rho_g, tau, xc_section, weights, pw_pool, exc)
858 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau
859 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
860 TYPE(section_vals_type), POINTER :: xc_section
861 TYPE(pw_r3d_rs_type), POINTER :: weights
862 TYPE(pw_pool_type), POINTER :: pw_pool
863 TYPE(pw_r3d_rs_type) :: exc
864
865 CHARACTER(len=*), PARAMETER :: routinen = 'xc_exc_pw_create'
866
867 INTEGER :: handle
868 REAL(dp) :: density_smooth_cut_range, rho_cutoff
869 REAL(dp), DIMENSION(:, :, :), POINTER :: e_0
870 TYPE(xc_derivative_set_type) :: deriv_set
871 TYPE(xc_derivative_type), POINTER :: deriv
872 TYPE(xc_rho_set_type) :: rho_set
873
874 CALL timeset(routinen, handle)
875
876 NULLIFY (deriv, e_0)
877
878 CALL xc_rho_set_and_dset_create(rho_set=rho_set, &
879 deriv_set=deriv_set, deriv_order=0, &
880 rho_r=rho_r, rho_g=rho_g, tau=tau, xc_section=xc_section, &
881 pw_pool=pw_pool, weights=weights, &
882 calc_potential=.false.)
883 deriv => xc_dset_get_derivative(deriv_set, [INTEGER::])
884
885 IF (ASSOCIATED(deriv)) THEN
886 CALL xc_derivative_get(deriv, deriv_data=e_0)
887
888 CALL section_vals_val_get(xc_section, "DENSITY_CUTOFF", &
889 r_val=rho_cutoff)
890 CALL section_vals_val_get(xc_section, "DENSITY_SMOOTH_CUTOFF_RANGE", &
891 r_val=density_smooth_cut_range)
892 CALL smooth_cutoff(pot=e_0, rho=rho_set%rho, &
893 rhoa=rho_set%rhoa, rhob=rho_set%rhob, &
894 rho_cutoff=rho_cutoff, &
895 rho_smooth_cutoff_range=density_smooth_cut_range)
896
897 exc%array = e_0
898
899 CALL xc_rho_set_release(rho_set, pw_pool=pw_pool)
900 CALL xc_dset_release(deriv_set)
901 END IF
902
903 CALL timestop(handle)
904
905 END SUBROUTINE xc_exc_pw_create
906
907! **************************************************************************************************
908!> \brief Caller routine to calculate the second order potential in the direction of rho1_r
909!> \param v_xc XC potential, will be allocated, to be integrated with the KS density
910!> \param v_xc_tau ...
911!> \param deriv_set XC derivatives from xc_prep_2nd_deriv
912!> \param rho_set XC rho set from KS rho from xc_prep_2nd_deriv
913!> \param rho1_r first-order density in r space
914!> \param rho1_g first-order density in g space
915!> \param tau1_r ...
916!> \param pw_pool pw pool to create new grids
917!> \param xc_section XC section to calculate the derivatives from
918!> \param gapw whether to carry out GAPW (not possible with numerical derivatives)
919!> \param vxg GAPW potential
920!> \param do_excitations ...
921!> \param do_triplet ...
922!> \param compute_virial ...
923!> \param virial_xc virial terms will be collected here
924! **************************************************************************************************
925 SUBROUTINE xc_calc_2nd_deriv(v_xc, v_xc_tau, deriv_set, rho_set, rho1_r, rho1_g, tau1_r, &
926 pw_pool, weights, xc_section, gapw, vxg, &
927 do_excitations, do_sf, do_triplet, &
928 compute_virial, virial_xc)
929
930 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_xc, v_xc_tau
931 TYPE(xc_derivative_set_type) :: deriv_set
932 TYPE(xc_rho_set_type) :: rho_set
933 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho1_r, tau1_r
934 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho1_g
935 TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool
936 TYPE(pw_r3d_rs_type), POINTER :: weights
937 TYPE(section_vals_type), INTENT(IN), POINTER :: xc_section
938 LOGICAL, INTENT(IN) :: gapw
939 REAL(kind=dp), DIMENSION(:, :, :, :), OPTIONAL, &
940 POINTER :: vxg
941 LOGICAL, INTENT(IN), OPTIONAL :: do_excitations, do_sf, &
942 do_triplet, compute_virial
943 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT), &
944 OPTIONAL :: virial_xc
945
946 CHARACTER(len=*), PARAMETER :: routinen = 'xc_calc_2nd_deriv'
947
948 INTEGER :: handle, ispin, nspins
949 INTEGER, DIMENSION(2, 3) :: bo
950 LOGICAL :: lsd, my_compute_virial, &
951 my_do_excitations, my_do_sf, &
952 my_do_triplet
953 REAL(kind=dp) :: fac
954 TYPE(section_vals_type), POINTER :: xc_fun_section
955 TYPE(xc_rho_cflags_type) :: needs
956 TYPE(xc_rho_set_type) :: rho1_set
957
958 CALL timeset(routinen, handle)
959
960 my_compute_virial = .false.
961 IF (PRESENT(compute_virial)) my_compute_virial = compute_virial
962
963 my_do_sf = .false.
964 IF (PRESENT(do_sf)) my_do_sf = do_sf
965
966 my_do_excitations = .false.
967 IF (PRESENT(do_excitations)) my_do_excitations = do_excitations
968
969 my_do_triplet = .false.
970 IF (PRESENT(do_triplet)) my_do_triplet = do_triplet
971
972 nspins = SIZE(rho1_r)
973 lsd = (nspins == 2)
974 IF (nspins == 1 .AND. my_do_excitations .AND. my_do_triplet) THEN
975 nspins = 2
976 lsd = .true.
977 ELSE IF (my_do_sf) THEN
978 nspins = 1
979 lsd = .true.
980 END IF
981
982 NULLIFY (v_xc, v_xc_tau)
983 ALLOCATE (v_xc(nspins))
984 DO ispin = 1, nspins
985 CALL pw_pool%create_pw(v_xc(ispin))
986 CALL pw_zero(v_xc(ispin))
987 END DO
988
989 xc_fun_section => section_vals_get_subs_vals(xc_section, "XC_FUNCTIONAL")
990 needs = xc_functionals_get_needs(xc_fun_section, lsd, .true.)
991
992 IF (needs%tau .OR. needs%tau_spin) THEN
993 IF (.NOT. ASSOCIATED(tau1_r)) THEN
994 cpabort("Tau-dependent functionals requires allocated kinetic energy density grid")
995 END IF
996 ALLOCATE (v_xc_tau(nspins))
997 DO ispin = 1, nspins
998 CALL pw_pool%create_pw(v_xc_tau(ispin))
999 CALL pw_zero(v_xc_tau(ispin))
1000 END DO
1001 END IF
1002
1003 IF (section_get_lval(xc_section, "2ND_DERIV_ANALYTICAL")) THEN
1004 !------!
1005 ! rho1 !
1006 !------!
1007 bo = rho1_r(1)%pw_grid%bounds_local
1008 ! create the place where to store the argument for the functionals
1009 CALL xc_rho_set_create(rho1_set, bo, &
1010 rho_cutoff=section_get_rval(xc_section, "DENSITY_CUTOFF"), &
1011 drho_cutoff=section_get_rval(xc_section, "GRADIENT_CUTOFF"), &
1012 tau_cutoff=section_get_rval(xc_section, "TAU_CUTOFF"))
1013
1014 ! calculate the arguments needed by the functionals
1015 CALL xc_rho_set_update(rho1_set, rho1_r, rho1_g, tau1_r, needs, &
1016 section_get_ival(xc_section, "XC_GRID%XC_DERIV"), &
1017 section_get_ival(xc_section, "XC_GRID%XC_SMOOTH_RHO"), &
1018 pw_pool, spinflip=my_do_sf)
1019
1020 fac = 0._dp
1021 IF (nspins == 1 .AND. my_do_excitations) THEN
1022 IF (my_do_triplet) fac = -1.0_dp
1023 END IF
1024
1025 CALL xc_calc_2nd_deriv_analytical(v_xc, v_xc_tau, deriv_set, rho_set, &
1026 rho1_set, pw_pool, xc_section, &
1027 gapw, vxg=vxg, spinflip=my_do_sf, tddfpt_fac=fac, &
1028 compute_virial=compute_virial, virial_xc=virial_xc)
1029
1030 CALL xc_rho_set_release(rho1_set)
1031
1032 ELSE
1033 IF (gapw) cpabort("Numerical 2nd derivatives not implemented with GAPW")
1034
1035 CALL xc_calc_2nd_deriv_numerical(v_xc, v_xc_tau, rho_set, rho1_r, rho1_g, tau1_r, &
1036 pw_pool, weights, xc_section, &
1037 my_do_excitations .AND. my_do_triplet, &
1038 compute_virial, virial_xc, deriv_set)
1039 END IF
1040
1041 CALL timestop(handle)
1042
1043 END SUBROUTINE xc_calc_2nd_deriv
1044
1045! **************************************************************************************************
1046!> \brief calculates 2nd derivative numerically
1047!> \param v_xc potential to be calculated (has to be allocated already)
1048!> \param v_tau tau-part of the potential to be calculated (has to be allocated already)
1049!> \param rho_set KS density from xc_prep_2nd_deriv
1050!> \param rho1_r first-order density in r-space
1051!> \param rho1_g first-order density in g-space
1052!> \param tau1_r first-order kinetic-energy density in r-space
1053!> \param pw_pool pw pool for new grids
1054!> \param xc_section XC section to calculate the derivatives from
1055!> \param do_triplet ...
1056!> \param calc_virial whether to calculate virial terms
1057!> \param virial_xc collects stress tensor components (no metaGGAs!)
1058!> \param deriv_set deriv set from xc_prep_2nd_deriv (only for virials)
1059! **************************************************************************************************
1060 SUBROUTINE xc_calc_2nd_deriv_numerical(v_xc, v_tau, rho_set, rho1_r, rho1_g, tau1_r, &
1061 pw_pool, weights, xc_section, &
1062 do_triplet, calc_virial, virial_xc, deriv_set)
1063
1064 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(IN), POINTER :: v_xc, v_tau
1065 TYPE(xc_rho_set_type), INTENT(IN) :: rho_set
1066 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(IN), POINTER :: rho1_r, tau1_r
1067 TYPE(pw_c1d_gs_type), DIMENSION(:), INTENT(IN), POINTER :: rho1_g
1068 TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool
1069 TYPE(pw_r3d_rs_type), INTENT(IN), POINTER :: weights
1070 TYPE(section_vals_type), INTENT(IN), POINTER :: xc_section
1071 LOGICAL, INTENT(IN) :: do_triplet
1072 LOGICAL, INTENT(IN), OPTIONAL :: calc_virial
1073 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT), &
1074 OPTIONAL :: virial_xc
1075 TYPE(xc_derivative_set_type), OPTIONAL :: deriv_set
1076
1077 CHARACTER(len=*), PARAMETER :: routinen = 'xc_calc_2nd_deriv_numerical'
1078 REAL(kind=dp), DIMENSION(-4:4, 4), PARAMETER :: &
1079 rweights = reshape([0.0_dp, 0.0_dp, 0.0_dp, -0.5_dp, 0.0_dp, 0.5_dp, 0.0_dp, 0.0_dp, 0.0_dp, &
1080 0.0_dp, 0.0_dp, 1.0_dp/12.0_dp, -2.0_dp/3.0_dp, 0.0_dp, 2.0_dp/3.0_dp, -1.0_dp/12.0_dp, 0.0_dp, 0.0_dp, &
1081 0.0_dp, -1.0_dp/60.0_dp, 0.15_dp, -0.75_dp, 0.0_dp, 0.75_dp, -0.15_dp, 1.0_dp/60.0_dp, 0.0_dp, &
1082 1.0_dp/280.0_dp, -4.0_dp/105.0_dp, 0.2_dp, -0.8_dp, 0.0_dp, 0.8_dp, -0.2_dp, 4.0_dp/105.0_dp, -1.0_dp/280.0_dp], [9, 4])
1083
1084 INTEGER :: handle, idir, ispin, nspins, istep, nsteps
1085 INTEGER, DIMENSION(2, 3) :: bo
1086 LOGICAL :: gradient_f, lsd, my_calc_virial, tau_f, laplace_f, rho_f
1087 REAL(kind=dp) :: exc, gradient_cut, h, rweight, step, rho_cutoff
1088 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: dr1dr, dra1dra, drb1drb
1089 REAL(kind=dp), DIMENSION(3, 3) :: virial_dummy
1090 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: norm_drho, norm_drho2, norm_drho2a, &
1091 norm_drho2b, norm_drhoa, norm_drhob, &
1092 rho, rho1, rho1a, rho1b, rhoa, rhob, &
1093 tau_a, tau_b, tau, tau1, tau1a, tau1b, laplace, laplace1, &
1094 laplacea, laplaceb, laplace1a, laplace1b, &
1095 laplace2, laplace2a, laplace2b, deriv_data
1096 TYPE(cp_3d_r_cp_type), DIMENSION(3) :: drho, drho1, drho1a, drho1b, drhoa, drhob
1097 TYPE(pw_r3d_rs_type) :: v_drho, v_drhoa, v_drhob
1098 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: vxc_rho, vxc_tau
1099 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
1100 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau_r
1101 TYPE(pw_r3d_rs_type) :: virial_pw, v_laplace, v_laplacea, v_laplaceb
1102 TYPE(section_vals_type), POINTER :: xc_fun_section
1103 TYPE(xc_derivative_set_type) :: deriv_set1
1104 TYPE(xc_rho_cflags_type) :: needs
1105 TYPE(xc_rho_set_type) :: rho1_set, rho2_set
1106
1107 CALL timeset(routinen, handle)
1108
1109 my_calc_virial = .false.
1110 IF (PRESENT(calc_virial) .AND. PRESENT(virial_xc)) my_calc_virial = calc_virial
1111
1112 nspins = SIZE(v_xc)
1113
1114 NULLIFY (tau, tau_r, tau_a, tau_b)
1115
1116 h = section_get_rval(xc_section, "STEP_SIZE")
1117 nsteps = section_get_ival(xc_section, "NSTEPS")
1118 IF (nsteps < lbound(rweights, 2) .OR. nsteps > ubound(rweights, 2)) THEN
1119 cpabort("The number of steps must be a value from 1 to 4.")
1120 END IF
1121
1122 IF (nspins == 2) THEN
1123 NULLIFY (vxc_rho, rho_g, vxc_tau)
1124 ALLOCATE (rho_r(2))
1125 DO ispin = 1, nspins
1126 CALL pw_pool%create_pw(rho_r(ispin))
1127 END DO
1128 IF (ASSOCIATED(tau1_r) .AND. ASSOCIATED(v_tau)) THEN
1129 ALLOCATE (tau_r(2))
1130 DO ispin = 1, nspins
1131 CALL pw_pool%create_pw(tau_r(ispin))
1132 END DO
1133 END IF
1134 CALL xc_rho_set_get(rho_set, can_return_null=.true., rhoa=rhoa, rhob=rhob, tau_a=tau_a, tau_b=tau_b)
1135 DO istep = -nsteps, nsteps
1136 IF (istep == 0) cycle
1137 rweight = rweights(istep, nsteps)/h
1138 step = real(istep, dp)*h
1139 CALL calc_resp_potential_numer_ab(rho_r, rho_g, rho1_r, rhoa, rhob, vxc_rho, &
1140 tau_r, tau1_r, tau_a, tau_b, vxc_tau, xc_section, &
1141 weights, pw_pool, step)
1142 DO ispin = 1, nspins
1143 CALL pw_axpy(vxc_rho(ispin), v_xc(ispin), rweight)
1144 IF (ASSOCIATED(vxc_tau) .AND. ASSOCIATED(v_tau)) THEN
1145 CALL pw_axpy(vxc_tau(ispin), v_tau(ispin), rweight)
1146 END IF
1147 END DO
1148 DO ispin = 1, nspins
1149 CALL vxc_rho(ispin)%release()
1150 END DO
1151 DEALLOCATE (vxc_rho)
1152 IF (ASSOCIATED(vxc_tau)) THEN
1153 DO ispin = 1, nspins
1154 CALL vxc_tau(ispin)%release()
1155 END DO
1156 DEALLOCATE (vxc_tau)
1157 END IF
1158 END DO
1159 ELSE IF (nspins == 1 .AND. do_triplet) THEN
1160 NULLIFY (vxc_rho, vxc_tau, rho_g)
1161 ALLOCATE (rho_r(2))
1162 DO ispin = 1, 2
1163 CALL pw_pool%create_pw(rho_r(ispin))
1164 END DO
1165 IF (ASSOCIATED(tau1_r) .AND. ASSOCIATED(v_tau)) THEN
1166 ALLOCATE (tau_r(2))
1167 DO ispin = 1, nspins
1168 CALL pw_pool%create_pw(tau_r(ispin))
1169 END DO
1170 END IF
1171 CALL xc_rho_set_get(rho_set, can_return_null=.true., rhoa=rhoa, rhob=rhob, tau_a=tau_a, tau_b=tau_b)
1172 DO istep = -nsteps, nsteps
1173 IF (istep == 0) cycle
1174 rweight = rweights(istep, nsteps)/h
1175 step = real(istep, dp)*h
1176 ! K(alpha,alpha)
1177!$OMP PARALLEL DEFAULT(NONE) SHARED(rho_r,rhoa,rhob,step,rho1_r,tau_r,tau_a,tau_b,tau1_r)
1178!$OMP WORKSHARE
1179 rho_r(1)%array(:, :, :) = rhoa(:, :, :) + step*rho1_r(1)%array(:, :, :)
1180!$OMP END WORKSHARE NOWAIT
1181!$OMP WORKSHARE
1182 rho_r(2)%array(:, :, :) = rhob(:, :, :)
1183!$OMP END WORKSHARE NOWAIT
1184 IF (ASSOCIATED(tau1_r)) THEN
1185!$OMP WORKSHARE
1186 tau_r(1)%array(:, :, :) = tau_a(:, :, :) + step*tau1_r(1)%array(:, :, :)
1187!$OMP END WORKSHARE NOWAIT
1188!$OMP WORKSHARE
1189 tau_r(2)%array(:, :, :) = tau_b(:, :, :)
1190!$OMP END WORKSHARE NOWAIT
1191 END IF
1192!$OMP END PARALLEL
1193 CALL xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau_r, xc_section, &
1194 weights, pw_pool, .false., virial_dummy)
1195 CALL pw_axpy(vxc_rho(1), v_xc(1), rweight)
1196 IF (ASSOCIATED(vxc_tau) .AND. ASSOCIATED(v_tau)) THEN
1197 CALL pw_axpy(vxc_tau(1), v_tau(1), rweight)
1198 END IF
1199 DO ispin = 1, 2
1200 CALL vxc_rho(ispin)%release()
1201 END DO
1202 DEALLOCATE (vxc_rho)
1203 IF (ASSOCIATED(vxc_tau)) THEN
1204 DO ispin = 1, 2
1205 CALL vxc_tau(ispin)%release()
1206 END DO
1207 DEALLOCATE (vxc_tau)
1208 END IF
1209!$OMP PARALLEL DEFAULT(NONE) SHARED(rho_r,rhoa,rhob,step,rho1_r,tau_r,tau_a,tau_b,tau1_r)
1210!$OMP WORKSHARE
1211 ! K(alpha,beta)
1212 rho_r(1)%array(:, :, :) = rhoa(:, :, :)
1213!$OMP END WORKSHARE NOWAIT
1214!$OMP WORKSHARE
1215 rho_r(2)%array(:, :, :) = rhob(:, :, :) + step*rho1_r(1)%array(:, :, :)
1216!$OMP END WORKSHARE NOWAIT
1217 IF (ASSOCIATED(tau1_r)) THEN
1218!$OMP WORKSHARE
1219 tau_r(1)%array(:, :, :) = tau_a(:, :, :)
1220!$OMP END WORKSHARE NOWAIT
1221!$OMP WORKSHARE
1222 tau_r(2)%array(:, :, :) = tau_b(:, :, :) + step*tau1_r(1)%array(:, :, :)
1223!$OMP END WORKSHARE NOWAIT
1224 END IF
1225!$OMP END PARALLEL
1226 CALL xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau_r, xc_section, &
1227 weights, pw_pool, .false., virial_dummy)
1228 CALL pw_axpy(vxc_rho(1), v_xc(1), rweight)
1229 IF (ASSOCIATED(vxc_tau) .AND. ASSOCIATED(v_tau)) THEN
1230 CALL pw_axpy(vxc_tau(1), v_tau(1), rweight)
1231 END IF
1232 DO ispin = 1, 2
1233 CALL vxc_rho(ispin)%release()
1234 END DO
1235 DEALLOCATE (vxc_rho)
1236 IF (ASSOCIATED(vxc_tau)) THEN
1237 DO ispin = 1, 2
1238 CALL vxc_tau(ispin)%release()
1239 END DO
1240 DEALLOCATE (vxc_tau)
1241 END IF
1242 END DO
1243 ELSE
1244 NULLIFY (vxc_rho, rho_r, rho_g, vxc_tau, tau_r, tau)
1245 ALLOCATE (rho_r(1))
1246 CALL pw_pool%create_pw(rho_r(1))
1247 IF (ASSOCIATED(tau1_r) .AND. ASSOCIATED(v_tau)) THEN
1248 ALLOCATE (tau_r(1))
1249 CALL pw_pool%create_pw(tau_r(1))
1250 END IF
1251 CALL xc_rho_set_get(rho_set, can_return_null=.true., rho=rho, tau=tau)
1252 DO istep = -nsteps, nsteps
1253 IF (istep == 0) cycle
1254 rweight = rweights(istep, nsteps)/h
1255 step = real(istep, dp)*h
1256!$OMP PARALLEL DEFAULT(NONE) SHARED(rho_r,rho,step,rho1_r,tau1_r,tau,tau_r)
1257!$OMP WORKSHARE
1258 rho_r(1)%array(:, :, :) = rho(:, :, :) + step*rho1_r(1)%array(:, :, :)
1259!$OMP END WORKSHARE NOWAIT
1260 IF (ASSOCIATED(tau1_r) .AND. ASSOCIATED(tau) .AND. ASSOCIATED(tau1_r)) THEN
1261!$OMP WORKSHARE
1262 tau_r(1)%array(:, :, :) = tau(:, :, :) + step*tau1_r(1)%array(:, :, :)
1263!$OMP END WORKSHARE NOWAIT
1264 END IF
1265!$OMP END PARALLEL
1266 CALL xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau_r, xc_section, &
1267 weights, pw_pool, .false., virial_dummy)
1268 CALL pw_axpy(vxc_rho(1), v_xc(1), rweight)
1269 IF (ASSOCIATED(vxc_tau) .AND. ASSOCIATED(v_tau)) THEN
1270 CALL pw_axpy(vxc_tau(1), v_tau(1), rweight)
1271 END IF
1272 CALL vxc_rho(1)%release()
1273 DEALLOCATE (vxc_rho)
1274 IF (ASSOCIATED(vxc_tau)) THEN
1275 CALL vxc_tau(1)%release()
1276 DEALLOCATE (vxc_tau)
1277 END IF
1278 END DO
1279 END IF
1280
1281 IF (my_calc_virial) THEN
1282 lsd = (nspins == 2)
1283 IF (nspins == 1 .AND. do_triplet) THEN
1284 lsd = .true.
1285 END IF
1286
1287 CALL check_for_derivatives(deriv_set, (nspins == 2), rho_f, gradient_f, tau_f, laplace_f)
1288
1289 ! Calculate the virial terms
1290 ! Those arising from the first derivatives are treated like in xc_calc_2nd_deriv_analytical
1291 ! Those arising from the second derivatives are calculated numerically
1292 ! We assume that all metaGGA functionals require the gradient
1293 IF (gradient_f) THEN
1294 bo = rho_set%local_bounds
1295
1296 ! Create the work grid for the virial terms
1297 CALL allocate_pw(virial_pw, pw_pool, bo)
1298
1299 gradient_cut = section_get_rval(xc_section, "GRADIENT_CUTOFF")
1300
1301 ! create the container to store the argument of the functionals
1302 CALL xc_rho_set_create(rho1_set, bo, &
1303 rho_cutoff=section_get_rval(xc_section, "DENSITY_CUTOFF"), &
1304 drho_cutoff=gradient_cut, &
1305 tau_cutoff=section_get_rval(xc_section, "TAU_CUTOFF"))
1306
1307 xc_fun_section => section_vals_get_subs_vals(xc_section, "XC_FUNCTIONAL")
1308 needs = xc_functionals_get_needs(xc_fun_section, lsd, .true.)
1309
1310 ! calculate the arguments needed by the functionals
1311 CALL xc_rho_set_update(rho1_set, rho1_r, rho1_g, tau1_r, needs, &
1312 section_get_ival(xc_section, "XC_GRID%XC_DERIV"), &
1313 section_get_ival(xc_section, "XC_GRID%XC_SMOOTH_RHO"), &
1314 pw_pool)
1315
1316 IF (lsd) THEN
1317 CALL xc_rho_set_get(rho_set, drhoa=drhoa, drhob=drhob, norm_drho=norm_drho, &
1318 norm_drhoa=norm_drhoa, norm_drhob=norm_drhob, tau_a=tau_a, tau_b=tau_b, &
1319 laplace_rhoa=laplacea, laplace_rhob=laplaceb, can_return_null=.true.)
1320 CALL xc_rho_set_get(rho1_set, rhoa=rho1a, rhob=rho1b, drhoa=drho1a, drhob=drho1b, laplace_rhoa=laplace1a, &
1321 laplace_rhob=laplace1b, can_return_null=.true.)
1322
1323 CALL calc_drho_from_ab(drho, drhoa, drhob)
1324 CALL calc_drho_from_ab(drho1, drho1a, drho1b)
1325 ELSE
1326 CALL xc_rho_set_get(rho_set, drho=drho, norm_drho=norm_drho, tau=tau, laplace_rho=laplace, can_return_null=.true.)
1327 CALL xc_rho_set_get(rho1_set, rho=rho1, drho=drho1, laplace_rho=laplace1, can_return_null=.true.)
1328 END IF
1329
1330 CALL prepare_dr1dr(dr1dr, drho, drho1)
1331
1332 IF (lsd) THEN
1333 CALL prepare_dr1dr(dra1dra, drhoa, drho1a)
1334 CALL prepare_dr1dr(drb1drb, drhob, drho1b)
1335
1336 CALL allocate_pw(v_drho, pw_pool, bo)
1337 CALL allocate_pw(v_drhoa, pw_pool, bo)
1338 CALL allocate_pw(v_drhob, pw_pool, bo)
1339
1340 IF (ASSOCIATED(norm_drhoa)) CALL apply_drho(deriv_set, [deriv_norm_drhoa], virial_pw, &
1341 drhoa, drho1a, virial_xc, &
1342 norm_drhoa, gradient_cut, dra1dra, v_drhoa%array)
1343 IF (ASSOCIATED(norm_drhob)) CALL apply_drho(deriv_set, [deriv_norm_drhob], virial_pw, &
1344 drhob, drho1b, virial_xc, &
1345 norm_drhob, gradient_cut, drb1drb, v_drhob%array)
1346 IF (ASSOCIATED(norm_drho)) CALL apply_drho(deriv_set, [deriv_norm_drho], virial_pw, &
1347 drho, drho1, virial_xc, &
1348 norm_drho, gradient_cut, dr1dr, v_drho%array)
1349 IF (laplace_f) THEN
1350 CALL xc_derivative_get(xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa]), deriv_data=deriv_data)
1351 cpassert(ASSOCIATED(deriv_data))
1352 virial_pw%array(:, :, :) = -rho1a(:, :, :)
1353 CALL virial_laplace(virial_pw, pw_pool, virial_xc, deriv_data)
1354
1355 CALL allocate_pw(v_laplacea, pw_pool, bo)
1356
1357 CALL xc_derivative_get(xc_dset_get_derivative(deriv_set, [deriv_laplace_rhob]), deriv_data=deriv_data)
1358 cpassert(ASSOCIATED(deriv_data))
1359 virial_pw%array(:, :, :) = -rho1b(:, :, :)
1360 CALL virial_laplace(virial_pw, pw_pool, virial_xc, deriv_data)
1361
1362 CALL allocate_pw(v_laplaceb, pw_pool, bo)
1363 END IF
1364
1365 ELSE
1366
1367 ! Create the work grid for the potential of the gradient part
1368 CALL allocate_pw(v_drho, pw_pool, bo)
1369
1370 CALL apply_drho(deriv_set, [deriv_norm_drho], virial_pw, drho, drho1, virial_xc, &
1371 norm_drho, gradient_cut, dr1dr, v_drho%array)
1372 IF (laplace_f) THEN
1373 CALL xc_derivative_get(xc_dset_get_derivative(deriv_set, [deriv_laplace_rho]), deriv_data=deriv_data)
1374 cpassert(ASSOCIATED(deriv_data))
1375 virial_pw%array(:, :, :) = -rho1(:, :, :)
1376 CALL virial_laplace(virial_pw, pw_pool, virial_xc, deriv_data)
1377
1378 CALL allocate_pw(v_laplace, pw_pool, bo)
1379 END IF
1380
1381 END IF
1382
1383 IF (lsd) THEN
1384 rho_r(1)%array = rhoa
1385 rho_r(2)%array = rhob
1386 ELSE
1387 rho_r(1)%array = rho
1388 END IF
1389 IF (ASSOCIATED(tau1_r)) THEN
1390 IF (lsd) THEN
1391 tau_r(1)%array = tau_a
1392 tau_r(2)%array = tau_b
1393 ELSE
1394 tau_r(1)%array = tau
1395 END IF
1396 END IF
1397
1398 ! Create deriv sets with same densities but different gradients
1399 CALL xc_dset_create(deriv_set1, pw_pool)
1400
1401 rho_cutoff = section_get_rval(xc_section, "DENSITY_CUTOFF")
1402
1403 ! create the place where to store the argument for the functionals
1404 CALL xc_rho_set_create(rho2_set, bo, &
1405 rho_cutoff=rho_cutoff, &
1406 drho_cutoff=section_get_rval(xc_section, "GRADIENT_CUTOFF"), &
1407 tau_cutoff=section_get_rval(xc_section, "TAU_CUTOFF"))
1408
1409 ! calculate the arguments needed by the functionals
1410 CALL xc_rho_set_update(rho2_set, rho_r, rho_g, tau_r, needs, &
1411 section_get_ival(xc_section, "XC_GRID%XC_DERIV"), &
1412 section_get_ival(xc_section, "XC_GRID%XC_SMOOTH_RHO"), &
1413 pw_pool)
1414
1415 IF (lsd) THEN
1416 CALL xc_rho_set_get(rho1_set, rhoa=rho1a, rhob=rho1b, tau_a=tau1a, tau_b=tau1b, &
1417 laplace_rhoa=laplace1a, laplace_rhob=laplace1b, can_return_null=.true.)
1418 CALL xc_rho_set_get(rho2_set, norm_drhoa=norm_drho2a, norm_drhob=norm_drho2b, &
1419 norm_drho=norm_drho2, laplace_rhoa=laplace2a, laplace_rhob=laplace2b, can_return_null=.true.)
1420
1421 DO istep = -nsteps, nsteps
1422 IF (istep == 0) cycle
1423 rweight = rweights(istep, nsteps)/h
1424 step = real(istep, dp)*h
1425 IF (ASSOCIATED(norm_drhoa)) THEN
1426 CALL get_derivs_rho(norm_drho2a, norm_drhoa, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1427 CALL update_deriv_rho(deriv_set1, [deriv_rhoa], bo, &
1428 norm_drhoa, gradient_cut, rweight, rho1a, v_drhoa%array)
1429 CALL update_deriv_rho(deriv_set1, [deriv_rhob], bo, &
1430 norm_drhoa, gradient_cut, rweight, rho1b, v_drhoa%array)
1431 CALL update_deriv_rho(deriv_set1, [deriv_norm_drhoa], bo, &
1432 norm_drhoa, gradient_cut, rweight, dra1dra, v_drhoa%array)
1433 CALL update_deriv_drho_ab(deriv_set1, [deriv_norm_drhob], bo, &
1434 norm_drhoa, gradient_cut, rweight, dra1dra, drb1drb, v_drhoa%array, v_drhob%array)
1435 CALL update_deriv_drho_ab(deriv_set1, [deriv_norm_drho], bo, &
1436 norm_drhoa, gradient_cut, rweight, dra1dra, dr1dr, v_drhoa%array, v_drho%array)
1437 IF (tau_f) THEN
1438 CALL update_deriv_rho(deriv_set1, [deriv_tau_a], bo, &
1439 norm_drhoa, gradient_cut, rweight, tau1a, v_drhoa%array)
1440 CALL update_deriv_rho(deriv_set1, [deriv_tau_b], bo, &
1441 norm_drhoa, gradient_cut, rweight, tau1b, v_drhoa%array)
1442 END IF
1443 IF (laplace_f) THEN
1444 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rhoa], bo, &
1445 norm_drhoa, gradient_cut, rweight, laplace1a, v_drhoa%array)
1446 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rhob], bo, &
1447 norm_drhoa, gradient_cut, rweight, laplace1b, v_drhoa%array)
1448 END IF
1449 END IF
1450
1451 IF (ASSOCIATED(norm_drhob)) THEN
1452 CALL get_derivs_rho(norm_drho2b, norm_drhob, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1453 CALL update_deriv_rho(deriv_set1, [deriv_rhoa], bo, &
1454 norm_drhob, gradient_cut, rweight, rho1a, v_drhob%array)
1455 CALL update_deriv_rho(deriv_set1, [deriv_rhob], bo, &
1456 norm_drhob, gradient_cut, rweight, rho1b, v_drhob%array)
1457 CALL update_deriv_rho(deriv_set1, [deriv_norm_drhob], bo, &
1458 norm_drhob, gradient_cut, rweight, drb1drb, v_drhob%array)
1459 CALL update_deriv_drho_ab(deriv_set1, [deriv_norm_drhoa], bo, &
1460 norm_drhob, gradient_cut, rweight, drb1drb, dra1dra, v_drhob%array, v_drhoa%array)
1461 CALL update_deriv_drho_ab(deriv_set1, [deriv_norm_drho], bo, &
1462 norm_drhob, gradient_cut, rweight, drb1drb, dr1dr, v_drhob%array, v_drho%array)
1463 IF (tau_f) THEN
1464 CALL update_deriv_rho(deriv_set1, [deriv_tau_a], bo, &
1465 norm_drhob, gradient_cut, rweight, tau1a, v_drhob%array)
1466 CALL update_deriv_rho(deriv_set1, [deriv_tau_b], bo, &
1467 norm_drhob, gradient_cut, rweight, tau1b, v_drhob%array)
1468 END IF
1469 IF (laplace_f) THEN
1470 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rhoa], bo, &
1471 norm_drhob, gradient_cut, rweight, laplace1a, v_drhob%array)
1472 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rhob], bo, &
1473 norm_drhob, gradient_cut, rweight, laplace1b, v_drhob%array)
1474 END IF
1475 END IF
1476
1477 IF (ASSOCIATED(norm_drho)) THEN
1478 CALL get_derivs_rho(norm_drho2, norm_drho, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1479 CALL update_deriv_rho(deriv_set1, [deriv_rhoa], bo, &
1480 norm_drho, gradient_cut, rweight, rho1a, v_drho%array)
1481 CALL update_deriv_rho(deriv_set1, [deriv_rhob], bo, &
1482 norm_drho, gradient_cut, rweight, rho1b, v_drho%array)
1483 CALL update_deriv_rho(deriv_set1, [deriv_norm_drho], bo, &
1484 norm_drho, gradient_cut, rweight, dr1dr, v_drho%array)
1485 CALL update_deriv_drho_ab(deriv_set1, [deriv_norm_drhoa], bo, &
1486 norm_drho, gradient_cut, rweight, dr1dr, dra1dra, v_drho%array, v_drhoa%array)
1487 CALL update_deriv_drho_ab(deriv_set1, [deriv_norm_drhob], bo, &
1488 norm_drho, gradient_cut, rweight, dr1dr, drb1drb, v_drho%array, v_drhob%array)
1489 IF (tau_f) THEN
1490 CALL update_deriv_rho(deriv_set1, [deriv_tau_a], bo, &
1491 norm_drho, gradient_cut, rweight, tau1a, v_drho%array)
1492 CALL update_deriv_rho(deriv_set1, [deriv_tau_b], bo, &
1493 norm_drho, gradient_cut, rweight, tau1b, v_drho%array)
1494 END IF
1495 IF (laplace_f) THEN
1496 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rhoa], bo, &
1497 norm_drho, gradient_cut, rweight, laplace1a, v_drho%array)
1498 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rhob], bo, &
1499 norm_drho, gradient_cut, rweight, laplace1b, v_drho%array)
1500 END IF
1501 END IF
1502
1503 IF (laplace_f) THEN
1504
1505 CALL get_derivs_rho(laplace2a, laplacea, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1506
1507 ! Obtain the numerical 2nd derivatives w.r.t. to drho and collect the potential
1508 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_rhoa], bo, &
1509 rweight, rho1a, v_laplacea%array)
1510 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_rhob], bo, &
1511 rweight, rho1b, v_laplacea%array)
1512 IF (ASSOCIATED(norm_drho)) THEN
1513 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_norm_drho], bo, &
1514 rweight, dr1dr, v_laplacea%array)
1515 END IF
1516 IF (ASSOCIATED(norm_drhoa)) THEN
1517 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_norm_drhoa], bo, &
1518 rweight, dra1dra, v_laplacea%array)
1519 END IF
1520 IF (ASSOCIATED(norm_drhob)) THEN
1521 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_norm_drhob], bo, &
1522 rweight, drb1drb, v_laplacea%array)
1523 END IF
1524
1525 IF (ASSOCIATED(tau1a)) THEN
1526 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_tau_a], bo, &
1527 rweight, tau1a, v_laplacea%array)
1528 END IF
1529 IF (ASSOCIATED(tau1b)) THEN
1530 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_tau_b], bo, &
1531 rweight, tau1b, v_laplacea%array)
1532 END IF
1533
1534 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_laplace_rhoa], bo, &
1535 rweight, laplace1a, v_laplacea%array)
1536
1537 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_laplace_rhob], bo, &
1538 rweight, laplace1b, v_laplacea%array)
1539
1540 ! The same for the beta spin
1541 CALL get_derivs_rho(laplace2b, laplaceb, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1542
1543 ! Obtain the numerical 2nd derivatives w.r.t. to drho and collect the potential
1544 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_rhoa], bo, &
1545 rweight, rho1a, v_laplaceb%array)
1546 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_rhob], bo, &
1547 rweight, rho1b, v_laplaceb%array)
1548 IF (ASSOCIATED(norm_drho)) THEN
1549 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_norm_drho], bo, &
1550 rweight, dr1dr, v_laplaceb%array)
1551 END IF
1552 IF (ASSOCIATED(norm_drhoa)) THEN
1553 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_norm_drhoa], bo, &
1554 rweight, dra1dra, v_laplaceb%array)
1555 END IF
1556 IF (ASSOCIATED(norm_drhob)) THEN
1557 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_norm_drhob], bo, &
1558 rweight, drb1drb, v_laplaceb%array)
1559 END IF
1560
1561 IF (tau_f) THEN
1562 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_tau_a], bo, &
1563 rweight, tau1a, v_laplaceb%array)
1564 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_tau_b], bo, &
1565 rweight, tau1b, v_laplaceb%array)
1566 END IF
1567
1568 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_laplace_rhoa], bo, &
1569 rweight, laplace1a, v_laplaceb%array)
1570
1571 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_laplace_rhob], bo, &
1572 rweight, laplace1b, v_laplaceb%array)
1573 END IF
1574 END DO
1575
1576 CALL virial_drho_drho(virial_pw, drhoa, v_drhoa, virial_xc)
1577 CALL virial_drho_drho(virial_pw, drhob, v_drhob, virial_xc)
1578 CALL virial_drho_drho(virial_pw, drho, v_drho, virial_xc)
1579
1580 CALL deallocate_pw(v_drho, pw_pool)
1581 CALL deallocate_pw(v_drhoa, pw_pool)
1582 CALL deallocate_pw(v_drhob, pw_pool)
1583
1584 IF (laplace_f) THEN
1585 virial_pw%array(:, :, :) = -rhoa(:, :, :)
1586 CALL virial_laplace(virial_pw, pw_pool, virial_xc, v_laplacea%array)
1587 CALL deallocate_pw(v_laplacea, pw_pool)
1588
1589 virial_pw%array(:, :, :) = -rhob(:, :, :)
1590 CALL virial_laplace(virial_pw, pw_pool, virial_xc, v_laplaceb%array)
1591 CALL deallocate_pw(v_laplaceb, pw_pool)
1592 END IF
1593
1594 CALL deallocate_pw(virial_pw, pw_pool)
1595
1596 DO idir = 1, 3
1597 DEALLOCATE (drho(idir)%array)
1598 DEALLOCATE (drho1(idir)%array)
1599 END DO
1600 DEALLOCATE (dra1dra, drb1drb)
1601
1602 ELSE
1603 CALL xc_rho_set_get(rho1_set, rho=rho1, tau=tau1, laplace_rho=laplace1, can_return_null=.true.)
1604 CALL xc_rho_set_get(rho2_set, norm_drho=norm_drho2, laplace_rho=laplace2, can_return_null=.true.)
1605
1606 DO istep = -nsteps, nsteps
1607 IF (istep == 0) cycle
1608 rweight = rweights(istep, nsteps)/h
1609 step = real(istep, dp)*h
1610 CALL get_derivs_rho(norm_drho2, norm_drho, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1611
1612 ! Obtain the numerical 2nd derivatives w.r.t. to drho and collect the potential
1613 CALL update_deriv_rho(deriv_set1, [deriv_rho], bo, &
1614 norm_drho, gradient_cut, rweight, rho1, v_drho%array)
1615 CALL update_deriv_rho(deriv_set1, [deriv_norm_drho], bo, &
1616 norm_drho, gradient_cut, rweight, dr1dr, v_drho%array)
1617
1618 IF (tau_f) THEN
1619 CALL update_deriv_rho(deriv_set1, [deriv_tau], bo, &
1620 norm_drho, gradient_cut, rweight, tau1, v_drho%array)
1621 END IF
1622 IF (laplace_f) THEN
1623 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rho], bo, &
1624 norm_drho, gradient_cut, rweight, laplace1, v_drho%array)
1625
1626 CALL get_derivs_rho(laplace2, laplace, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1627
1628 ! Obtain the numerical 2nd derivatives w.r.t. to drho and collect the potential
1629 CALL update_deriv(deriv_set1, laplace, rho_cutoff, [deriv_rho], bo, &
1630 rweight, rho1, v_laplace%array)
1631 CALL update_deriv(deriv_set1, laplace, rho_cutoff, [deriv_norm_drho], bo, &
1632 rweight, dr1dr, v_laplace%array)
1633
1634 IF (tau_f) THEN
1635 CALL update_deriv(deriv_set1, laplace, rho_cutoff, [deriv_tau], bo, &
1636 rweight, tau1, v_laplace%array)
1637 END IF
1638
1639 CALL update_deriv(deriv_set1, laplace, rho_cutoff, [deriv_laplace_rho], bo, &
1640 rweight, laplace1, v_laplace%array)
1641 END IF
1642 END DO
1643
1644 ! Calculate the virial contribution from the potential
1645 CALL virial_drho_drho(virial_pw, drho, v_drho, virial_xc)
1646
1647 CALL deallocate_pw(v_drho, pw_pool)
1648
1649 IF (laplace_f) THEN
1650 virial_pw%array(:, :, :) = -rho(:, :, :)
1651 CALL virial_laplace(virial_pw, pw_pool, virial_xc, v_laplace%array)
1652 CALL deallocate_pw(v_laplace, pw_pool)
1653 END IF
1654
1655 CALL deallocate_pw(virial_pw, pw_pool)
1656 END IF
1657
1658 END IF
1659
1660 CALL xc_dset_release(deriv_set1)
1661
1662 DEALLOCATE (dr1dr)
1663
1664 CALL xc_rho_set_release(rho1_set)
1665 CALL xc_rho_set_release(rho2_set)
1666 END IF
1667
1668 DO ispin = 1, SIZE(rho_r)
1669 CALL pw_pool%give_back_pw(rho_r(ispin))
1670 END DO
1671 DEALLOCATE (rho_r)
1672
1673 IF (ASSOCIATED(tau_r)) THEN
1674 DO ispin = 1, SIZE(tau_r)
1675 CALL pw_pool%give_back_pw(tau_r(ispin))
1676 END DO
1677 DEALLOCATE (tau_r)
1678 END IF
1679
1680 CALL timestop(handle)
1681
1682 END SUBROUTINE xc_calc_2nd_deriv_numerical
1683
1684! **************************************************************************************************
1685!> \brief ...
1686!> \param rho_r ...
1687!> \param rho_g ...
1688!> \param rho1_r ...
1689!> \param rhoa ...
1690!> \param rhob ...
1691!> \param vxc_rho ...
1692!> \param tau_r ...
1693!> \param tau1_r ...
1694!> \param tau_a ...
1695!> \param tau_b ...
1696!> \param vxc_tau ...
1697!> \param xc_section ...
1698!> \param pw_pool ...
1699!> \param step ...
1700! **************************************************************************************************
1701 SUBROUTINE calc_resp_potential_numer_ab(rho_r, rho_g, rho1_r, rhoa, rhob, vxc_rho, &
1702 tau_r, tau1_r, tau_a, tau_b, vxc_tau, &
1703 xc_section, weights, pw_pool, step)
1704
1705 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER, INTENT(IN) :: vxc_rho, vxc_tau
1706 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(IN) :: rho1_r
1707 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(IN), POINTER :: tau1_r
1708 TYPE(pw_r3d_rs_type), INTENT(IN), POINTER :: weights
1709 TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool
1710 TYPE(section_vals_type), INTENT(IN), POINTER :: xc_section
1711 REAL(kind=dp), INTENT(IN) :: step
1712 REAL(kind=dp), DIMENSION(:, :, :), POINTER, INTENT(IN) :: rhoa, rhob, tau_a, tau_b
1713 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER, INTENT(IN) :: rho_r
1714 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
1715 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: tau_r
1716
1717 CHARACTER(len=*), PARAMETER :: routinen = 'calc_resp_potential_numer_ab'
1718
1719 INTEGER :: handle
1720 REAL(kind=dp) :: exc
1721 REAL(kind=dp), DIMENSION(3, 3) :: virial_dummy
1722
1723 CALL timeset(routinen, handle)
1724
1725!$OMP PARALLEL DEFAULT(NONE) SHARED(rho_r,rhoa,rhob,step,rho1_r,tau_r,tau_a,tau_b,tau1_r)
1726!$OMP WORKSHARE
1727 rho_r(1)%array(:, :, :) = rhoa(:, :, :) + step*rho1_r(1)%array(:, :, :)
1728!$OMP END WORKSHARE NOWAIT
1729!$OMP WORKSHARE
1730 rho_r(2)%array(:, :, :) = rhob(:, :, :) + step*rho1_r(2)%array(:, :, :)
1731!$OMP END WORKSHARE NOWAIT
1732 IF (ASSOCIATED(tau1_r) .AND. ASSOCIATED(tau_r) .AND. ASSOCIATED(tau_a) .AND. ASSOCIATED(tau_b)) THEN
1733!$OMP WORKSHARE
1734 tau_r(1)%array(:, :, :) = tau_a(:, :, :) + step*tau1_r(1)%array(:, :, :)
1735!$OMP END WORKSHARE NOWAIT
1736!$OMP WORKSHARE
1737 tau_r(2)%array(:, :, :) = tau_b(:, :, :) + step*tau1_r(2)%array(:, :, :)
1738!$OMP END WORKSHARE NOWAIT
1739 END IF
1740!$OMP END PARALLEL
1741 CALL xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau_r, xc_section, &
1742 weights, pw_pool, .false., virial_dummy)
1743
1744 CALL timestop(handle)
1745
1746 END SUBROUTINE calc_resp_potential_numer_ab
1747
1748! **************************************************************************************************
1749!> \brief calculates stress tensor and potential contributions from the first derivative
1750!> \param deriv_set ...
1751!> \param description ...
1752!> \param virial_pw ...
1753!> \param drho ...
1754!> \param drho1 ...
1755!> \param virial_xc ...
1756!> \param norm_drho ...
1757!> \param gradient_cut ...
1758!> \param dr1dr ...
1759!> \param v_drho ...
1760! **************************************************************************************************
1761 SUBROUTINE apply_drho(deriv_set, description, virial_pw, drho, drho1, &
1762 virial_xc, norm_drho, gradient_cut, dr1dr, v_drho)
1763
1764 TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
1765 INTEGER, DIMENSION(:), INTENT(in) :: description
1766 TYPE(pw_r3d_rs_type), INTENT(IN) :: virial_pw
1767 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drho, drho1
1768 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT) :: virial_xc
1769 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: norm_drho
1770 REAL(kind=dp), INTENT(IN) :: gradient_cut
1771 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: dr1dr
1772 REAL(kind=dp), DIMENSION(:, :, :), INTENT(INOUT) :: v_drho
1773
1774 CHARACTER(len=*), PARAMETER :: routinen = 'apply_drho'
1775
1776 INTEGER :: handle
1777 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data
1778 TYPE(xc_derivative_type), POINTER :: deriv_att
1779
1780 CALL timeset(routinen, handle)
1781
1782 deriv_att => xc_dset_get_derivative(deriv_set, description)
1783 IF (ASSOCIATED(deriv_att)) THEN
1784 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
1785 CALL virial_drho_drho1(virial_pw, drho, drho1, deriv_data, virial_xc)
1786
1787!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dr1dr,gradient_cut,norm_drho,v_drho,deriv_data)
1788 v_drho(:, :, :) = v_drho(:, :, :) + &
1789 deriv_data(:, :, :)*dr1dr(:, :, :)/max(gradient_cut, norm_drho(:, :, :))**2
1790!$OMP END PARALLEL WORKSHARE
1791 END IF
1792
1793 CALL timestop(handle)
1794
1795 END SUBROUTINE apply_drho
1796
1797! **************************************************************************************************
1798!> \brief adds potential contributions from derivatives of rho or diagonal terms of norm_drho
1799!> \param deriv_set1 ...
1800!> \param description ...
1801!> \param bo ...
1802!> \param norm_drho norm_drho of which derivative is calculated
1803!> \param gradient_cut ...
1804!> \param h ...
1805!> \param rho1 function to contract the derivative with (rho1 for rho, dr1dr for norm_drho)
1806!> \param v_drho ...
1807! **************************************************************************************************
1808 SUBROUTINE update_deriv_rho(deriv_set1, description, bo, norm_drho, gradient_cut, weight, rho1, v_drho)
1809
1810 TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set1
1811 INTEGER, DIMENSION(:), INTENT(in) :: description
1812 INTEGER, DIMENSION(2, 3), INTENT(IN) :: bo
1813 REAL(kind=dp), DIMENSION(bo(1, 1):bo(2, 1), bo(1, & 2):bo(2, 2), bo(1, 3):bo(2, 3)), INTENT(IN) :: norm_drho
1814 REAL(kind=dp), INTENT(IN) :: gradient_cut, weight
1815 REAL(kind=dp), DIMENSION(bo(1, 1):bo(2, 1), bo(1, & 2):bo(2, 2), bo(1, 3):bo(2, 3)), INTENT(IN) :: rho1
1816 REAL(kind=dp), DIMENSION(bo(1, 1):bo(2, 1), bo(1, & 2):bo(2, 2), bo(1, 3):bo(2, 3)), INTENT(INOUT) :: v_drho
1817
1818 CHARACTER(len=*), PARAMETER :: routinen = 'update_deriv_rho'
1819
1820 INTEGER :: handle, i, j, k
1821 REAL(kind=dp) :: de
1822 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data1
1823 TYPE(xc_derivative_type), POINTER :: deriv_att1
1824
1825 CALL timeset(routinen, handle)
1826
1827 ! Obtain the numerical 2nd derivatives w.r.t. to drho and collect the potential
1828 deriv_att1 => xc_dset_get_derivative(deriv_set1, description)
1829 IF (ASSOCIATED(deriv_att1)) THEN
1830 CALL xc_derivative_get(deriv_att1, deriv_data=deriv_data1)
1831!$OMP PARALLEL DO DEFAULT(NONE) &
1832!$OMP SHARED(bo,deriv_data1,weight,norm_drho,v_drho,rho1,gradient_cut) &
1833!$OMP PRIVATE(i,j,k,de) &
1834!$OMP COLLAPSE(3)
1835 DO k = bo(1, 3), bo(2, 3)
1836 DO j = bo(1, 2), bo(2, 2)
1837 DO i = bo(1, 1), bo(2, 1)
1838 de = weight*deriv_data1(i, j, k)/max(gradient_cut, norm_drho(i, j, k))**2
1839 v_drho(i, j, k) = v_drho(i, j, k) - de*rho1(i, j, k)
1840 END DO
1841 END DO
1842 END DO
1843!$OMP END PARALLEL DO
1844 END IF
1845
1846 CALL timestop(handle)
1847
1848 END SUBROUTINE update_deriv_rho
1849
1850! **************************************************************************************************
1851!> \brief adds potential contributions from derivatives of a component with positive and negative values
1852!> \param deriv_set1 ...
1853!> \param description ...
1854!> \param bo ...
1855!> \param h ...
1856!> \param rho1 function to contract the derivative with (rho1 for rho, dr1dr for norm_drho)
1857!> \param v ...
1858! **************************************************************************************************
1859 SUBROUTINE update_deriv(deriv_set1, rho, rho_cutoff, description, bo, weight, rho1, v)
1860
1861 TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set1
1862 INTEGER, DIMENSION(:), INTENT(in) :: description
1863 INTEGER, DIMENSION(2, 3), INTENT(IN) :: bo
1864 REAL(kind=dp), INTENT(IN) :: weight, rho_cutoff
1865 REAL(kind=dp), DIMENSION(bo(1, 1):bo(2, 1), bo(1, & 2):bo(2, 2), bo(1, 3):bo(2, 3)), INTENT(IN) :: rho, rho1
1866 REAL(kind=dp), DIMENSION(bo(1, 1):bo(2, 1), bo(1, & 2):bo(2, 2), bo(1, 3):bo(2, 3)), INTENT(INOUT) :: v
1867
1868 CHARACTER(len=*), PARAMETER :: routinen = 'update_deriv'
1869
1870 INTEGER :: handle, i, j, k
1871 REAL(kind=dp) :: de
1872 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data1
1873 TYPE(xc_derivative_type), POINTER :: deriv_att1
1874
1875 CALL timeset(routinen, handle)
1876
1877 ! Obtain the numerical 2nd derivatives w.r.t. to drho and collect the potential
1878 deriv_att1 => xc_dset_get_derivative(deriv_set1, description)
1879 IF (ASSOCIATED(deriv_att1)) THEN
1880 CALL xc_derivative_get(deriv_att1, deriv_data=deriv_data1)
1881!$OMP PARALLEL DO DEFAULT(NONE) &
1882!$OMP SHARED(bo,deriv_data1,weight,v,rho1,rho, rho_cutoff) &
1883!$OMP PRIVATE(i,j,k,de) &
1884!$OMP COLLAPSE(3)
1885 DO k = bo(1, 3), bo(2, 3)
1886 DO j = bo(1, 2), bo(2, 2)
1887 DO i = bo(1, 1), bo(2, 1)
1888 ! We have to consider that the given density (mostly the Laplacian) may have positive and negative values
1889 de = weight*deriv_data1(i, j, k)/sign(max(abs(rho(i, j, k)), rho_cutoff), rho(i, j, k))
1890 v(i, j, k) = v(i, j, k) + de*rho1(i, j, k)
1891 END DO
1892 END DO
1893 END DO
1894!$OMP END PARALLEL DO
1895 END IF
1896
1897 CALL timestop(handle)
1898
1899 END SUBROUTINE update_deriv
1900
1901! **************************************************************************************************
1902!> \brief adds mixed derivatives of norm_drho
1903!> \param deriv_set1 ...
1904!> \param description ...
1905!> \param bo ...
1906!> \param norm_drhoa norm_drho of which derivatives is calculated
1907!> \param gradient_cut ...
1908!> \param h ...
1909!> \param dra1dra dr1dr corresponding to norm_drho
1910!> \param drb1drb ...
1911!> \param v_drhoa potential corresponding to norm_drho
1912!> \param v_drhob ...
1913! **************************************************************************************************
1914 SUBROUTINE update_deriv_drho_ab(deriv_set1, description, bo, &
1915 norm_drhoa, gradient_cut, weight, dra1dra, drb1drb, v_drhoa, v_drhob)
1916
1917 TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set1
1918 INTEGER, DIMENSION(:), INTENT(in) :: description
1919 INTEGER, DIMENSION(2, 3), INTENT(IN) :: bo
1920 REAL(kind=dp), DIMENSION(bo(1, 1):bo(2, 1), bo(1, & 2):bo(2, 2), bo(1, 3):bo(2, 3)), INTENT(IN) :: norm_drhoa
1921 REAL(kind=dp), INTENT(IN) :: gradient_cut, weight
1922 REAL(kind=dp), DIMENSION(bo(1, 1):bo(2, 1), bo(1, & 2):bo(2, 2), bo(1, 3):bo(2, 3)), INTENT(IN) :: dra1dra, drb1drb
1923 REAL(kind=dp), DIMENSION(bo(1, 1):bo(2, 1), bo(1, & 2):bo(2, 2), bo(1, 3):bo(2, 3)), INTENT(INOUT) :: v_drhoa, v_drhob
1924
1925 CHARACTER(len=*), PARAMETER :: routinen = 'update_deriv_drho_ab'
1926
1927 INTEGER :: handle, i, j, k
1928 REAL(kind=dp) :: de
1929 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data1
1930 TYPE(xc_derivative_type), POINTER :: deriv_att1
1931
1932 CALL timeset(routinen, handle)
1933
1934 deriv_att1 => xc_dset_get_derivative(deriv_set1, description)
1935 IF (ASSOCIATED(deriv_att1)) THEN
1936 CALL xc_derivative_get(deriv_att1, deriv_data=deriv_data1)
1937!$OMP PARALLEL DO DEFAULT(NONE) &
1938!$OMP PRIVATE(k,j,i,de) &
1939!$OMP SHARED(bo,drb1drb,dra1dra,deriv_data1,weight,gradient_cut,norm_drhoa,v_drhoa,v_drhob) &
1940!$OMP COLLAPSE(3)
1941 DO k = bo(1, 3), bo(2, 3)
1942 DO j = bo(1, 2), bo(2, 2)
1943 DO i = bo(1, 1), bo(2, 1)
1944 ! We introduce a factor of two because we will average between both numerical derivatives
1945 de = 0.5_dp*weight*deriv_data1(i, j, k)/max(gradient_cut, norm_drhoa(i, j, k))**2
1946 v_drhoa(i, j, k) = v_drhoa(i, j, k) - de*drb1drb(i, j, k)
1947 v_drhob(i, j, k) = v_drhob(i, j, k) - de*dra1dra(i, j, k)
1948 END DO
1949 END DO
1950 END DO
1951!$OMP END PARALLEL DO
1952 END IF
1953
1954 CALL timestop(handle)
1955
1956 END SUBROUTINE update_deriv_drho_ab
1957
1958! **************************************************************************************************
1959!> \brief calculate derivative sets for helper points
1960!> \param norm_drho2 norm_drho of new points
1961!> \param norm_drho norm_drho of KS density
1962!> \param h ...
1963!> \param xc_fun_section ...
1964!> \param lsd ...
1965!> \param rho2_set rho_set for new points
1966!> \param deriv_set1 will contain derivatives of the perturbed density
1967! **************************************************************************************************
1968 SUBROUTINE get_derivs_rho(norm_drho2, norm_drho, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1969 REAL(kind=dp), DIMENSION(:, :, :), INTENT(OUT) :: norm_drho2
1970 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: norm_drho
1971 REAL(kind=dp), INTENT(IN) :: step
1972 TYPE(section_vals_type), INTENT(IN), POINTER :: xc_fun_section
1973 LOGICAL, INTENT(IN) :: lsd
1974 TYPE(xc_rho_set_type), INTENT(INOUT) :: rho2_set
1975 TYPE(xc_derivative_set_type) :: deriv_set1
1976
1977 CHARACTER(len=*), PARAMETER :: routinen = 'get_derivs_rho'
1978
1979 INTEGER :: handle
1980
1981 CALL timeset(routinen, handle)
1982
1983 ! Copy the densities, do one step into the direction of drho
1984!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(norm_drho,norm_drho2,step)
1985 norm_drho2 = norm_drho*(1.0_dp + step)
1986!$OMP END PARALLEL WORKSHARE
1987
1988 CALL xc_dset_zero_all(deriv_set1)
1989
1990 ! Calculate the derivatives of the functional
1991 CALL xc_functionals_eval(xc_fun_section, &
1992 lsd=lsd, &
1993 rho_set=rho2_set, &
1994 deriv_set=deriv_set1, &
1995 deriv_order=1)
1996
1997 ! Return to the original values
1998!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(norm_drho,norm_drho2)
1999 norm_drho2 = norm_drho
2000!$OMP END PARALLEL WORKSHARE
2001
2002 CALL divide_by_norm_drho(deriv_set1, rho2_set, lsd)
2003
2004 CALL timestop(handle)
2005
2006 END SUBROUTINE get_derivs_rho
2007
2008! **************************************************************************************************
2009!> \brief Calculates the second derivative of E_xc at rho in the direction
2010!> rho1 (if you see the second derivative as bilinear form)
2011!> partial_rho|_(rho=rho) partial_rho|_(rho=rho) E_xc drho(rho1)drho
2012!> The other direction is still undetermined, thus it returns
2013!> a potential (partial integration is performed to reduce it to
2014!> function of rho, removing the dependence from its partial derivs)
2015!> Has to be called after the setup by xc_prep_2nd_deriv.
2016!> \param v_xc exchange-correlation potential
2017!> \param v_xc_tau ...
2018!> \param deriv_set derivatives of the exchange-correlation potential
2019!> \param rho_set object containing the density at which the derivatives were calculated
2020!> \param rho1_set object containing the density with which to fold
2021!> \param pw_pool the pool for the grids
2022!> \param xc_section XC parameters
2023!> \param gapw Gaussian and augmented plane waves calculation
2024!> \param vxg ...
2025!> \param tddfpt_fac factor that multiplies the crossterms (tddfpt triplets
2026!> on a closed shell system it should be -1, defaults to 1)
2027!> \param compute_virial ...
2028!> \param virial_xc ...
2029!> \note
2030!> The old version of this routine was smarter: it handled split_desc(1)
2031!> and split_desc(2) separately, thus the code automatically handled all
2032!> possible cross terms (you only had to check if it was diagonal to avoid
2033!> double counting). I think that is the way to go if you want to add more
2034!> terms (tau,rho in LSD,...). The problem with the old code was that it
2035!> because of the old functional structure it sometime guessed wrongly
2036!> which derivative was where. There were probably still bugs with gradient
2037!> corrected functionals (never tested), and it didn't contain first
2038!> derivatives with respect to drho (that contribute also to the second
2039!> derivative wrt. rho).
2040!> The code was a little complex because it really tried to handle any
2041!> functional derivative in the most efficient way with the given contents of
2042!> rho_set.
2043!> Anyway I strongly encourage whoever wants to modify this code to give a
2044!> look to the old version. [fawzi]
2045! **************************************************************************************************
2046 SUBROUTINE xc_calc_2nd_deriv_analytical(v_xc, v_xc_tau, deriv_set, rho_set, rho1_set, &
2047 pw_pool, xc_section, gapw, vxg, tddfpt_fac, &
2048 compute_virial, virial_xc, spinflip)
2049
2050 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_xc, v_xc_tau
2051 TYPE(xc_derivative_set_type) :: deriv_set
2052 TYPE(xc_rho_set_type), INTENT(IN) :: rho_set, rho1_set
2053 TYPE(pw_pool_type), POINTER :: pw_pool
2054 TYPE(section_vals_type), POINTER :: xc_section
2055 LOGICAL, INTENT(IN), OPTIONAL :: gapw
2056 REAL(kind=dp), DIMENSION(:, :, :, :), OPTIONAL, &
2057 POINTER :: vxg
2058 REAL(kind=dp), INTENT(in), OPTIONAL :: tddfpt_fac
2059 LOGICAL, INTENT(IN), OPTIONAL :: compute_virial
2060 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT), &
2061 OPTIONAL :: virial_xc
2062 LOGICAL, INTENT(in), OPTIONAL :: spinflip
2063
2064 CHARACTER(len=*), PARAMETER :: routinen = 'xc_calc_2nd_deriv_analytical'
2065
2066 INTEGER :: handle, i, ia, idir, ir, ispin, j, jdir, &
2067 k, nspins, xc_deriv_method_id
2068 INTEGER, DIMENSION(2, 3) :: bo
2069 LOGICAL :: gradient_f, lsd, my_compute_virial, alda0, &
2070 my_gapw, tau_f, laplace_f, rho_f, do_spinflip
2071 REAL(kind=dp) :: fac, gradient_cut, tmp, factor2, s, s_thresh
2072 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: dr1dr, dra1dra, drb1drb
2073 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data, deriv_data2, &
2074 e_drhoa, e_drhob, e_drho, norm_drho, norm_drhoa, &
2075 norm_drhob, rho1, rho1a, rho1b, &
2076 tau1, tau1a, tau1b, laplace1, laplace1a, laplace1b, &
2077 rho, rhoa, rhob
2078 TYPE(cp_3d_r_cp_type), DIMENSION(3) :: drho, drho1, drho1a, drho1b, drhoa, drhob
2079 TYPE(pw_r3d_rs_type), DIMENSION(:), ALLOCATABLE :: v_drhoa, v_drhob, v_drho, v_laplace
2080 TYPE(pw_r3d_rs_type), DIMENSION(:, :), ALLOCATABLE :: v_drho_r
2081 TYPE(pw_r3d_rs_type) :: virial_pw
2082 TYPE(pw_c1d_gs_type) :: tmp_g, vxc_g
2083 TYPE(xc_derivative_type), POINTER :: deriv_att
2084
2085 CALL timeset(routinen, handle)
2086
2087 NULLIFY (e_drhoa, e_drhob, e_drho)
2088
2089 my_gapw = .false.
2090 IF (PRESENT(gapw)) my_gapw = gapw
2091
2092 my_compute_virial = .false.
2093 IF (PRESENT(compute_virial)) my_compute_virial = compute_virial
2094
2095 cpassert(ASSOCIATED(v_xc))
2096 cpassert(ASSOCIATED(xc_section))
2097 IF (my_gapw) THEN
2098 cpassert(PRESENT(vxg))
2099 END IF
2100 IF (my_compute_virial) THEN
2101 cpassert(PRESENT(virial_xc))
2102 END IF
2103
2104 CALL section_vals_val_get(xc_section, "XC_GRID%XC_DERIV", &
2105 i_val=xc_deriv_method_id)
2106 CALL xc_rho_set_get(rho_set, drho_cutoff=gradient_cut)
2107 nspins = SIZE(v_xc)
2108 lsd = ASSOCIATED(rho_set%rhoa)
2109 fac = 0.0_dp
2110 factor2 = 1.0_dp
2111 IF (PRESENT(tddfpt_fac)) fac = tddfpt_fac
2112 IF (PRESENT(tddfpt_fac)) factor2 = tddfpt_fac
2113 do_spinflip = .false.
2114 IF (PRESENT(spinflip)) do_spinflip = spinflip
2115
2116 bo = rho_set%local_bounds
2117
2118 CALL check_for_derivatives(deriv_set, lsd, rho_f, gradient_f, tau_f, laplace_f)
2119
2120 alda0 = .false.
2121 IF (gradient_f) THEN
2122 s_thresh = 1.0e-04
2123 ELSE
2124 s_thresh = 1.0e-10
2125 END IF
2126
2127 IF (tau_f) THEN
2128 cpassert(ASSOCIATED(v_xc_tau))
2129 END IF
2130
2131 IF (gradient_f) THEN
2132 ALLOCATE (v_drho_r(3, nspins), v_drho(nspins))
2133 DO ispin = 1, nspins
2134 DO idir = 1, 3
2135 CALL allocate_pw(v_drho_r(idir, ispin), pw_pool, bo)
2136 END DO
2137 CALL allocate_pw(v_drho(ispin), pw_pool, bo)
2138 END DO
2139
2140 IF (xc_requires_tmp_g(xc_deriv_method_id) .AND. .NOT. my_gapw) THEN
2141 IF (ASSOCIATED(pw_pool)) THEN
2142 CALL pw_pool%create_pw(tmp_g)
2143 CALL pw_pool%create_pw(vxc_g)
2144 ELSE
2145 ! remember to refix for gapw
2146 cpabort("XC_DERIV method is not implemented in GAPW")
2147 END IF
2148 END IF
2149 END IF
2150
2151 DO ispin = 1, nspins
2152 v_xc(ispin)%array = 0.0_dp
2153 END DO
2154
2155 IF (tau_f) THEN
2156 DO ispin = 1, nspins
2157 v_xc_tau(ispin)%array = 0.0_dp
2158 END DO
2159 END IF
2160
2161 IF (laplace_f .AND. my_gapw) THEN
2162 cpabort("Laplace-dependent functional not implemented with GAPW!")
2163 END IF
2164
2165 IF (my_compute_virial .AND. (gradient_f .OR. laplace_f)) CALL allocate_pw(virial_pw, pw_pool, bo)
2166
2167 IF (lsd) THEN
2168
2169 !-------------------!
2170 ! UNrestricted case !
2171 !-------------------!
2172
2173 IF (do_spinflip) THEN
2174 CALL xc_rho_set_get(rho1_set, rhoa=rho1a)
2175 CALL xc_rho_set_get(rho_set, rhoa=rhoa, rhob=rhob)
2176 ELSE
2177 CALL xc_rho_set_get(rho1_set, rhoa=rho1a, rhob=rho1b)
2178 END IF
2179
2180 IF (gradient_f) THEN
2181 CALL xc_rho_set_get(rho_set, drhoa=drhoa, drhob=drhob, &
2182 norm_drho=norm_drho, norm_drhoa=norm_drhoa, norm_drhob=norm_drhob)
2183 IF (do_spinflip) THEN
2184 CALL xc_rho_set_get(rho1_set, drhoa=drho1a)
2185 CALL calc_drho_from_a(drho1, drho1a)
2186 ELSE
2187 CALL xc_rho_set_get(rho1_set, drhoa=drho1a, drhob=drho1b)
2188 CALL calc_drho_from_ab(drho1, drho1a, drho1b)
2189 END IF
2190
2191 CALL calc_drho_from_ab(drho, drhoa, drhob)
2192
2193 CALL prepare_dr1dr(dra1dra, drhoa, drho1a)
2194 IF (do_spinflip) THEN
2195 CALL prepare_dr1dr(drb1drb, drhob, drho1a)
2196 CALL prepare_dr1dr(dr1dr, drho, drho1a)
2197 ELSE IF (nspins /= 1) THEN
2198 CALL prepare_dr1dr(drb1drb, drhob, drho1b)
2199 CALL prepare_dr1dr(dr1dr, drho, drho1)
2200 ELSE
2201 CALL prepare_dr1dr(drb1drb, drhob, drho1b)
2202 CALL prepare_dr1dr_ab(dr1dr, drhoa, drhob, drho1a, drho1b, fac)
2203 END IF
2204
2205 ALLOCATE (v_drhoa(nspins), v_drhob(nspins))
2206 DO ispin = 1, nspins
2207 CALL allocate_pw(v_drhoa(ispin), pw_pool, bo)
2208 CALL allocate_pw(v_drhob(ispin), pw_pool, bo)
2209 END DO
2210
2211 END IF
2212
2213 IF (laplace_f) THEN
2214 CALL xc_rho_set_get(rho1_set, laplace_rhoa=laplace1a, laplace_rhob=laplace1b)
2215
2216 ALLOCATE (v_laplace(nspins))
2217 DO ispin = 1, nspins
2218 CALL allocate_pw(v_laplace(ispin), pw_pool, bo)
2219 END DO
2220
2221 IF (my_compute_virial) CALL xc_rho_set_get(rho_set, rhoa=rhoa, rhob=rhob)
2222 END IF
2223
2224 IF (tau_f) THEN
2225 CALL xc_rho_set_get(rho1_set, tau_a=tau1a, tau_b=tau1b)
2226 END IF
2227
2228 IF (do_spinflip) THEN
2229
2230 ! vxc contributions
2231 ! vxc = (vxc^{\alpha}-vxc^{\beta})*rho1/(rhoa-rhob)
2232 ! Alpha LDA contribution
2233 ! | d e_xc d e_xc | rho1a
2234 ! vxca = |-------- - --------|*-------------
2235 ! | drhoa drhob | |rhoa - rhob|
2236 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa])
2237 IF (ASSOCIATED(deriv_att)) THEN
2238 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2239 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob])
2240 IF (ASSOCIATED(deriv_att)) THEN
2241 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
2242!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
2243!$OMP SHARED(bo,v_xc,deriv_data,deriv_data2,rho1a,rhoa,rhob,S_THRESH) COLLAPSE(3)
2244 DO k = bo(1, 3), bo(2, 3)
2245 DO j = bo(1, 2), bo(2, 2)
2246 DO i = bo(1, 1), bo(2, 1)
2247 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
2248 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2249 (deriv_data(i, j, k) - deriv_data2(i, j, k))*rho1a(i, j, k)/s
2250 END DO
2251 END DO
2252 END DO
2253!$OMP END PARALLEL DO
2254 END IF
2255 END IF
2256 ! GGA contributions to the spin-flip xcKernel
2257 ! GGA contribution
2258 ! | d e_xc d e_xc | 1
2259 ! vxca += |----------* dra1dra - ----------*drb1drb|*-------------
2260 ! | d|drhoa| d|drhob| | |rhoa - rhob|
2261 IF (.NOT. alda0) THEN
2262 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa])
2263 IF (ASSOCIATED(deriv_att)) THEN
2264 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2265 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob])
2266 IF (ASSOCIATED(deriv_att)) THEN
2267 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
2268!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
2269!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,v_xc,rhoa,rhob,S_THRESH) COLLAPSE(3)
2270 DO k = bo(1, 3), bo(2, 3)
2271 DO j = bo(1, 2), bo(2, 2)
2272 DO i = bo(1, 1), bo(2, 1)
2273 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
2274 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2275 (deriv_data(i, j, k)*dra1dra(i, j, k) - &
2276 deriv_data2(i, j, k)*drb1drb(i, j, k))/s
2277 END DO
2278 END DO
2279 END DO
2280!$OMP END PARALLEL DO
2281 END IF
2282 END IF
2283 END IF
2284
2285 ELSE IF (nspins /= 1) THEN
2286
2287 ! Compute \sum_{\tau}fxc^{\sigma\tau}*\rho^{\tau}(1) over the grid points
2288 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_rhoa])
2289 IF (ASSOCIATED(deriv_att)) THEN
2290 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2291!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2292!$OMP SHARED(bo,v_xc,deriv_data,rho1a,fac) COLLAPSE(3)
2293 DO k = bo(1, 3), bo(2, 3)
2294 DO j = bo(1, 2), bo(2, 2)
2295 DO i = bo(1, 1), bo(2, 1)
2296 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2297 deriv_data(i, j, k)*rho1a(i, j, k)
2298 END DO
2299 END DO
2300 END DO
2301 END IF
2302 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_rhob])
2303 IF (ASSOCIATED(deriv_att)) THEN
2304 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2305!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2306!$OMP SHARED(bo,v_xc,deriv_data,rho1b,fac) COLLAPSE(3)
2307 DO k = bo(1, 3), bo(2, 3)
2308 DO j = bo(1, 2), bo(2, 2)
2309 DO i = bo(1, 1), bo(2, 1)
2310 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2311 deriv_data(i, j, k)*rho1b(i, j, k)
2312 END DO
2313 END DO
2314 END DO
2315 END IF
2316 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drho])
2317 IF (ASSOCIATED(deriv_att)) THEN
2318 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2319!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2320!$OMP SHARED(bo,v_xc,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
2321 DO k = bo(1, 3), bo(2, 3)
2322 DO j = bo(1, 2), bo(2, 2)
2323 DO i = bo(1, 1), bo(2, 1)
2324 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2325 deriv_data(i, j, k)*dr1dr(i, j, k)
2326 END DO
2327 END DO
2328 END DO
2329 END IF
2330 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drhoa])
2331 IF (ASSOCIATED(deriv_att)) THEN
2332 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2333!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2334!$OMP SHARED(bo,v_xc,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
2335 DO k = bo(1, 3), bo(2, 3)
2336 DO j = bo(1, 2), bo(2, 2)
2337 DO i = bo(1, 1), bo(2, 1)
2338 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2339 deriv_data(i, j, k)*dra1dra(i, j, k)
2340 END DO
2341 END DO
2342 END DO
2343 END IF
2344 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drhob])
2345 IF (ASSOCIATED(deriv_att)) THEN
2346 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2347!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2348!$OMP SHARED(bo,v_xc,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
2349 DO k = bo(1, 3), bo(2, 3)
2350 DO j = bo(1, 2), bo(2, 2)
2351 DO i = bo(1, 1), bo(2, 1)
2352 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2353 deriv_data(i, j, k)*drb1drb(i, j, k)
2354 END DO
2355 END DO
2356 END DO
2357 END IF
2358 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_tau_a])
2359 IF (ASSOCIATED(deriv_att)) THEN
2360 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2361!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2362!$OMP SHARED(bo,v_xc,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
2363 DO k = bo(1, 3), bo(2, 3)
2364 DO j = bo(1, 2), bo(2, 2)
2365 DO i = bo(1, 1), bo(2, 1)
2366 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2367 deriv_data(i, j, k)*tau1a(i, j, k)
2368 END DO
2369 END DO
2370 END DO
2371 END IF
2372 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_tau_b])
2373 IF (ASSOCIATED(deriv_att)) THEN
2374 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2375!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2376!$OMP SHARED(bo,v_xc,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
2377 DO k = bo(1, 3), bo(2, 3)
2378 DO j = bo(1, 2), bo(2, 2)
2379 DO i = bo(1, 1), bo(2, 1)
2380 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2381 deriv_data(i, j, k)*tau1b(i, j, k)
2382 END DO
2383 END DO
2384 END DO
2385 END IF
2386 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_laplace_rhoa])
2387 IF (ASSOCIATED(deriv_att)) THEN
2388 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2389!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2390!$OMP SHARED(bo,v_xc,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
2391 DO k = bo(1, 3), bo(2, 3)
2392 DO j = bo(1, 2), bo(2, 2)
2393 DO i = bo(1, 1), bo(2, 1)
2394 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2395 deriv_data(i, j, k)*laplace1a(i, j, k)
2396 END DO
2397 END DO
2398 END DO
2399 END IF
2400 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_laplace_rhob])
2401 IF (ASSOCIATED(deriv_att)) THEN
2402 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2403!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2404!$OMP SHARED(bo,v_xc,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
2405 DO k = bo(1, 3), bo(2, 3)
2406 DO j = bo(1, 2), bo(2, 2)
2407 DO i = bo(1, 1), bo(2, 1)
2408 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2409 deriv_data(i, j, k)*laplace1b(i, j, k)
2410 END DO
2411 END DO
2412 END DO
2413 END IF
2414
2415
2416 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_rhoa])
2417 IF (ASSOCIATED(deriv_att)) THEN
2418 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2419!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2420!$OMP SHARED(bo,v_xc,deriv_data,rho1a,fac) COLLAPSE(3)
2421 DO k = bo(1, 3), bo(2, 3)
2422 DO j = bo(1, 2), bo(2, 2)
2423 DO i = bo(1, 1), bo(2, 1)
2424 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2425 deriv_data(i, j, k)*rho1a(i, j, k)
2426 END DO
2427 END DO
2428 END DO
2429 END IF
2430 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_rhob])
2431 IF (ASSOCIATED(deriv_att)) THEN
2432 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2433!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2434!$OMP SHARED(bo,v_xc,deriv_data,rho1b,fac) COLLAPSE(3)
2435 DO k = bo(1, 3), bo(2, 3)
2436 DO j = bo(1, 2), bo(2, 2)
2437 DO i = bo(1, 1), bo(2, 1)
2438 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2439 deriv_data(i, j, k)*rho1b(i, j, k)
2440 END DO
2441 END DO
2442 END DO
2443 END IF
2444 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_norm_drho])
2445 IF (ASSOCIATED(deriv_att)) THEN
2446 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2447!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2448!$OMP SHARED(bo,v_xc,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
2449 DO k = bo(1, 3), bo(2, 3)
2450 DO j = bo(1, 2), bo(2, 2)
2451 DO i = bo(1, 1), bo(2, 1)
2452 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2453 deriv_data(i, j, k)*dr1dr(i, j, k)
2454 END DO
2455 END DO
2456 END DO
2457 END IF
2458 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_norm_drhoa])
2459 IF (ASSOCIATED(deriv_att)) THEN
2460 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2461!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2462!$OMP SHARED(bo,v_xc,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
2463 DO k = bo(1, 3), bo(2, 3)
2464 DO j = bo(1, 2), bo(2, 2)
2465 DO i = bo(1, 1), bo(2, 1)
2466 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2467 deriv_data(i, j, k)*dra1dra(i, j, k)
2468 END DO
2469 END DO
2470 END DO
2471 END IF
2472 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_norm_drhob])
2473 IF (ASSOCIATED(deriv_att)) THEN
2474 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2475!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2476!$OMP SHARED(bo,v_xc,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
2477 DO k = bo(1, 3), bo(2, 3)
2478 DO j = bo(1, 2), bo(2, 2)
2479 DO i = bo(1, 1), bo(2, 1)
2480 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2481 deriv_data(i, j, k)*drb1drb(i, j, k)
2482 END DO
2483 END DO
2484 END DO
2485 END IF
2486 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_tau_a])
2487 IF (ASSOCIATED(deriv_att)) THEN
2488 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2489!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2490!$OMP SHARED(bo,v_xc,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
2491 DO k = bo(1, 3), bo(2, 3)
2492 DO j = bo(1, 2), bo(2, 2)
2493 DO i = bo(1, 1), bo(2, 1)
2494 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2495 deriv_data(i, j, k)*tau1a(i, j, k)
2496 END DO
2497 END DO
2498 END DO
2499 END IF
2500 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_tau_b])
2501 IF (ASSOCIATED(deriv_att)) THEN
2502 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2503!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2504!$OMP SHARED(bo,v_xc,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
2505 DO k = bo(1, 3), bo(2, 3)
2506 DO j = bo(1, 2), bo(2, 2)
2507 DO i = bo(1, 1), bo(2, 1)
2508 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2509 deriv_data(i, j, k)*tau1b(i, j, k)
2510 END DO
2511 END DO
2512 END DO
2513 END IF
2514 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_laplace_rhoa])
2515 IF (ASSOCIATED(deriv_att)) THEN
2516 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2517!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2518!$OMP SHARED(bo,v_xc,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
2519 DO k = bo(1, 3), bo(2, 3)
2520 DO j = bo(1, 2), bo(2, 2)
2521 DO i = bo(1, 1), bo(2, 1)
2522 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2523 deriv_data(i, j, k)*laplace1a(i, j, k)
2524 END DO
2525 END DO
2526 END DO
2527 END IF
2528 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_laplace_rhob])
2529 IF (ASSOCIATED(deriv_att)) THEN
2530 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2531!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2532!$OMP SHARED(bo,v_xc,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
2533 DO k = bo(1, 3), bo(2, 3)
2534 DO j = bo(1, 2), bo(2, 2)
2535 DO i = bo(1, 1), bo(2, 1)
2536 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2537 deriv_data(i, j, k)*laplace1b(i, j, k)
2538 END DO
2539 END DO
2540 END DO
2541 END IF
2542
2543
2544 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rhoa])
2545 IF (ASSOCIATED(deriv_att)) THEN
2546 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2547!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2548!$OMP SHARED(bo,v_drho,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
2549 DO k = bo(1, 3), bo(2, 3)
2550 DO j = bo(1, 2), bo(2, 2)
2551 DO i = bo(1, 1), bo(2, 1)
2552 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2553 deriv_data(i, j, k)*rho1a(i, j, k)
2554 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2555 deriv_data(i, j, k)*rho1a(i, j, k)
2556 END DO
2557 END DO
2558 END DO
2559 END IF
2560 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rhob])
2561 IF (ASSOCIATED(deriv_att)) THEN
2562 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2563!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2564!$OMP SHARED(bo,v_drho,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
2565 DO k = bo(1, 3), bo(2, 3)
2566 DO j = bo(1, 2), bo(2, 2)
2567 DO i = bo(1, 1), bo(2, 1)
2568 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2569 deriv_data(i, j, k)*rho1b(i, j, k)
2570 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2571 deriv_data(i, j, k)*rho1b(i, j, k)
2572 END DO
2573 END DO
2574 END DO
2575 END IF
2576 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drho])
2577 IF (ASSOCIATED(deriv_att)) THEN
2578 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2579!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2580!$OMP SHARED(bo,v_drho,deriv_data,dr1dr,fac) COLLAPSE(3)
2581 DO k = bo(1, 3), bo(2, 3)
2582 DO j = bo(1, 2), bo(2, 2)
2583 DO i = bo(1, 1), bo(2, 1)
2584 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2585 deriv_data(i, j, k)*dr1dr(i, j, k)
2586 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2587 deriv_data(i, j, k)*dr1dr(i, j, k)
2588 END DO
2589 END DO
2590 END DO
2591 END IF
2592 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drhoa])
2593 IF (ASSOCIATED(deriv_att)) THEN
2594 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2595!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2596!$OMP SHARED(bo,v_drho,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
2597 DO k = bo(1, 3), bo(2, 3)
2598 DO j = bo(1, 2), bo(2, 2)
2599 DO i = bo(1, 1), bo(2, 1)
2600 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2601 deriv_data(i, j, k)*dra1dra(i, j, k)
2602 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2603 deriv_data(i, j, k)*dra1dra(i, j, k)
2604 END DO
2605 END DO
2606 END DO
2607 END IF
2608 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drhob])
2609 IF (ASSOCIATED(deriv_att)) THEN
2610 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2611!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2612!$OMP SHARED(bo,v_drho,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
2613 DO k = bo(1, 3), bo(2, 3)
2614 DO j = bo(1, 2), bo(2, 2)
2615 DO i = bo(1, 1), bo(2, 1)
2616 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2617 deriv_data(i, j, k)*drb1drb(i, j, k)
2618 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2619 deriv_data(i, j, k)*drb1drb(i, j, k)
2620 END DO
2621 END DO
2622 END DO
2623 END IF
2624 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_tau_a])
2625 IF (ASSOCIATED(deriv_att)) THEN
2626 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2627!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2628!$OMP SHARED(bo,v_drho,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
2629 DO k = bo(1, 3), bo(2, 3)
2630 DO j = bo(1, 2), bo(2, 2)
2631 DO i = bo(1, 1), bo(2, 1)
2632 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2633 deriv_data(i, j, k)*tau1a(i, j, k)
2634 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2635 deriv_data(i, j, k)*tau1a(i, j, k)
2636 END DO
2637 END DO
2638 END DO
2639 END IF
2640 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_tau_b])
2641 IF (ASSOCIATED(deriv_att)) THEN
2642 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2643!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2644!$OMP SHARED(bo,v_drho,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
2645 DO k = bo(1, 3), bo(2, 3)
2646 DO j = bo(1, 2), bo(2, 2)
2647 DO i = bo(1, 1), bo(2, 1)
2648 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2649 deriv_data(i, j, k)*tau1b(i, j, k)
2650 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2651 deriv_data(i, j, k)*tau1b(i, j, k)
2652 END DO
2653 END DO
2654 END DO
2655 END IF
2657 IF (ASSOCIATED(deriv_att)) THEN
2658 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2659!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2660!$OMP SHARED(bo,v_drho,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
2661 DO k = bo(1, 3), bo(2, 3)
2662 DO j = bo(1, 2), bo(2, 2)
2663 DO i = bo(1, 1), bo(2, 1)
2664 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2665 deriv_data(i, j, k)*laplace1a(i, j, k)
2666 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2667 deriv_data(i, j, k)*laplace1a(i, j, k)
2668 END DO
2669 END DO
2670 END DO
2671 END IF
2673 IF (ASSOCIATED(deriv_att)) THEN
2674 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2675!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2676!$OMP SHARED(bo,v_drho,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
2677 DO k = bo(1, 3), bo(2, 3)
2678 DO j = bo(1, 2), bo(2, 2)
2679 DO i = bo(1, 1), bo(2, 1)
2680 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2681 deriv_data(i, j, k)*laplace1b(i, j, k)
2682 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2683 deriv_data(i, j, k)*laplace1b(i, j, k)
2684 END DO
2685 END DO
2686 END DO
2687 END IF
2688
2689 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho])
2690 IF (ASSOCIATED(deriv_att)) THEN
2691 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2692 CALL xc_derivative_get(deriv_att, deriv_data=e_drho)
2693
2694 IF (my_compute_virial) THEN
2695 CALL virial_drho_drho1(virial_pw, drho, drho1, deriv_data, virial_xc)
2696 END IF ! my_compute_virial
2697
2698!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dr1dr,gradient_cut,norm_drho,v_drho,deriv_data)
2699 v_drho(1)%array(:, :, :) = v_drho(1)%array(:, :, :) + &
2700 deriv_data(:, :, :)*dr1dr(:, :, :)/max(gradient_cut, norm_drho(:, :, :))**2
2701 v_drho(2)%array(:, :, :) = v_drho(2)%array(:, :, :) + &
2702 deriv_data(:, :, :)*dr1dr(:, :, :)/max(gradient_cut, norm_drho(:, :, :))**2
2703!$OMP END PARALLEL WORKSHARE
2704 END IF
2705
2706 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_rhoa])
2707 IF (ASSOCIATED(deriv_att)) THEN
2708 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2709!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2710!$OMP SHARED(bo,v_drhoa,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
2711 DO k = bo(1, 3), bo(2, 3)
2712 DO j = bo(1, 2), bo(2, 2)
2713 DO i = bo(1, 1), bo(2, 1)
2714 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2715 deriv_data(i, j, k)*rho1a(i, j, k)
2716 END DO
2717 END DO
2718 END DO
2719 END IF
2720 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_rhob])
2721 IF (ASSOCIATED(deriv_att)) THEN
2722 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2723!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2724!$OMP SHARED(bo,v_drhoa,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
2725 DO k = bo(1, 3), bo(2, 3)
2726 DO j = bo(1, 2), bo(2, 2)
2727 DO i = bo(1, 1), bo(2, 1)
2728 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2729 deriv_data(i, j, k)*rho1b(i, j, k)
2730 END DO
2731 END DO
2732 END DO
2733 END IF
2734 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drho])
2735 IF (ASSOCIATED(deriv_att)) THEN
2736 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2737!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2738!$OMP SHARED(bo,v_drhoa,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
2739 DO k = bo(1, 3), bo(2, 3)
2740 DO j = bo(1, 2), bo(2, 2)
2741 DO i = bo(1, 1), bo(2, 1)
2742 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2743 deriv_data(i, j, k)*dr1dr(i, j, k)
2744 END DO
2745 END DO
2746 END DO
2747 END IF
2748 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drhoa])
2749 IF (ASSOCIATED(deriv_att)) THEN
2750 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2751!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2752!$OMP SHARED(bo,v_drhoa,deriv_data,dra1dra,fac) COLLAPSE(3)
2753 DO k = bo(1, 3), bo(2, 3)
2754 DO j = bo(1, 2), bo(2, 2)
2755 DO i = bo(1, 1), bo(2, 1)
2756 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2757 deriv_data(i, j, k)*dra1dra(i, j, k)
2758 END DO
2759 END DO
2760 END DO
2761 END IF
2762 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drhob])
2763 IF (ASSOCIATED(deriv_att)) THEN
2764 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2765!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2766!$OMP SHARED(bo,v_drhoa,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
2767 DO k = bo(1, 3), bo(2, 3)
2768 DO j = bo(1, 2), bo(2, 2)
2769 DO i = bo(1, 1), bo(2, 1)
2770 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2771 deriv_data(i, j, k)*drb1drb(i, j, k)
2772 END DO
2773 END DO
2774 END DO
2775 END IF
2776 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_tau_a])
2777 IF (ASSOCIATED(deriv_att)) THEN
2778 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2779!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2780!$OMP SHARED(bo,v_drhoa,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
2781 DO k = bo(1, 3), bo(2, 3)
2782 DO j = bo(1, 2), bo(2, 2)
2783 DO i = bo(1, 1), bo(2, 1)
2784 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2785 deriv_data(i, j, k)*tau1a(i, j, k)
2786 END DO
2787 END DO
2788 END DO
2789 END IF
2790 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_tau_b])
2791 IF (ASSOCIATED(deriv_att)) THEN
2792 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2793!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2794!$OMP SHARED(bo,v_drhoa,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
2795 DO k = bo(1, 3), bo(2, 3)
2796 DO j = bo(1, 2), bo(2, 2)
2797 DO i = bo(1, 1), bo(2, 1)
2798 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2799 deriv_data(i, j, k)*tau1b(i, j, k)
2800 END DO
2801 END DO
2802 END DO
2803 END IF
2805 IF (ASSOCIATED(deriv_att)) THEN
2806 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2807!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2808!$OMP SHARED(bo,v_drhoa,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
2809 DO k = bo(1, 3), bo(2, 3)
2810 DO j = bo(1, 2), bo(2, 2)
2811 DO i = bo(1, 1), bo(2, 1)
2812 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2813 deriv_data(i, j, k)*laplace1a(i, j, k)
2814 END DO
2815 END DO
2816 END DO
2817 END IF
2819 IF (ASSOCIATED(deriv_att)) THEN
2820 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2821!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2822!$OMP SHARED(bo,v_drhoa,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
2823 DO k = bo(1, 3), bo(2, 3)
2824 DO j = bo(1, 2), bo(2, 2)
2825 DO i = bo(1, 1), bo(2, 1)
2826 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2827 deriv_data(i, j, k)*laplace1b(i, j, k)
2828 END DO
2829 END DO
2830 END DO
2831 END IF
2832
2833 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa])
2834 IF (ASSOCIATED(deriv_att)) THEN
2835 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2836 CALL xc_derivative_get(deriv_att, deriv_data=e_drhoa)
2837
2838 IF (my_compute_virial) THEN
2839 CALL virial_drho_drho1(virial_pw, drhoa, drho1a, deriv_data, virial_xc)
2840 END IF ! my_compute_virial
2841
2842!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dra1dra,gradient_cut,norm_drhoa,v_drhoa,deriv_data)
2843 v_drhoa(1)%array(:, :, :) = v_drhoa(1)%array(:, :, :) + &
2844 deriv_data(:, :, :)*dra1dra(:, :, :)/max(gradient_cut, norm_drhoa(:, :, :))**2
2845!$OMP END PARALLEL WORKSHARE
2846 END IF
2847
2848 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_rhoa])
2849 IF (ASSOCIATED(deriv_att)) THEN
2850 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2851!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2852!$OMP SHARED(bo,v_drhob,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
2853 DO k = bo(1, 3), bo(2, 3)
2854 DO j = bo(1, 2), bo(2, 2)
2855 DO i = bo(1, 1), bo(2, 1)
2856 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2857 deriv_data(i, j, k)*rho1a(i, j, k)
2858 END DO
2859 END DO
2860 END DO
2861 END IF
2862 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_rhob])
2863 IF (ASSOCIATED(deriv_att)) THEN
2864 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2865!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2866!$OMP SHARED(bo,v_drhob,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
2867 DO k = bo(1, 3), bo(2, 3)
2868 DO j = bo(1, 2), bo(2, 2)
2869 DO i = bo(1, 1), bo(2, 1)
2870 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2871 deriv_data(i, j, k)*rho1b(i, j, k)
2872 END DO
2873 END DO
2874 END DO
2875 END IF
2876 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_norm_drho])
2877 IF (ASSOCIATED(deriv_att)) THEN
2878 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2879!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2880!$OMP SHARED(bo,v_drhob,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
2881 DO k = bo(1, 3), bo(2, 3)
2882 DO j = bo(1, 2), bo(2, 2)
2883 DO i = bo(1, 1), bo(2, 1)
2884 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2885 deriv_data(i, j, k)*dr1dr(i, j, k)
2886 END DO
2887 END DO
2888 END DO
2889 END IF
2890 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_norm_drhoa])
2891 IF (ASSOCIATED(deriv_att)) THEN
2892 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2893!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2894!$OMP SHARED(bo,v_drhob,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
2895 DO k = bo(1, 3), bo(2, 3)
2896 DO j = bo(1, 2), bo(2, 2)
2897 DO i = bo(1, 1), bo(2, 1)
2898 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2899 deriv_data(i, j, k)*dra1dra(i, j, k)
2900 END DO
2901 END DO
2902 END DO
2903 END IF
2904 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_norm_drhob])
2905 IF (ASSOCIATED(deriv_att)) THEN
2906 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2907!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2908!$OMP SHARED(bo,v_drhob,deriv_data,drb1drb,fac) COLLAPSE(3)
2909 DO k = bo(1, 3), bo(2, 3)
2910 DO j = bo(1, 2), bo(2, 2)
2911 DO i = bo(1, 1), bo(2, 1)
2912 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2913 deriv_data(i, j, k)*drb1drb(i, j, k)
2914 END DO
2915 END DO
2916 END DO
2917 END IF
2918 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_tau_a])
2919 IF (ASSOCIATED(deriv_att)) THEN
2920 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2921!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2922!$OMP SHARED(bo,v_drhob,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
2923 DO k = bo(1, 3), bo(2, 3)
2924 DO j = bo(1, 2), bo(2, 2)
2925 DO i = bo(1, 1), bo(2, 1)
2926 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2927 deriv_data(i, j, k)*tau1a(i, j, k)
2928 END DO
2929 END DO
2930 END DO
2931 END IF
2932 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_tau_b])
2933 IF (ASSOCIATED(deriv_att)) THEN
2934 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2935!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2936!$OMP SHARED(bo,v_drhob,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
2937 DO k = bo(1, 3), bo(2, 3)
2938 DO j = bo(1, 2), bo(2, 2)
2939 DO i = bo(1, 1), bo(2, 1)
2940 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2941 deriv_data(i, j, k)*tau1b(i, j, k)
2942 END DO
2943 END DO
2944 END DO
2945 END IF
2947 IF (ASSOCIATED(deriv_att)) THEN
2948 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2949!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2950!$OMP SHARED(bo,v_drhob,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
2951 DO k = bo(1, 3), bo(2, 3)
2952 DO j = bo(1, 2), bo(2, 2)
2953 DO i = bo(1, 1), bo(2, 1)
2954 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2955 deriv_data(i, j, k)*laplace1a(i, j, k)
2956 END DO
2957 END DO
2958 END DO
2959 END IF
2961 IF (ASSOCIATED(deriv_att)) THEN
2962 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2963!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2964!$OMP SHARED(bo,v_drhob,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
2965 DO k = bo(1, 3), bo(2, 3)
2966 DO j = bo(1, 2), bo(2, 2)
2967 DO i = bo(1, 1), bo(2, 1)
2968 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2969 deriv_data(i, j, k)*laplace1b(i, j, k)
2970 END DO
2971 END DO
2972 END DO
2973 END IF
2974
2975 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob])
2976 IF (ASSOCIATED(deriv_att)) THEN
2977 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2978 CALL xc_derivative_get(deriv_att, deriv_data=e_drhob)
2979
2980 IF (my_compute_virial) THEN
2981 CALL virial_drho_drho1(virial_pw, drhob, drho1b, deriv_data, virial_xc)
2982 END IF ! my_compute_virial
2983
2984!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drb1drb,gradient_cut,norm_drhob,v_drhob,deriv_data)
2985 v_drhob(2)%array(:, :, :) = v_drhob(2)%array(:, :, :) + &
2986 deriv_data(:, :, :)*drb1drb(:, :, :)/max(gradient_cut, norm_drhob(:, :, :))**2
2987!$OMP END PARALLEL WORKSHARE
2988 END IF
2989
2990 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_rhoa])
2991 IF (ASSOCIATED(deriv_att)) THEN
2992 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2993!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2994!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
2995 DO k = bo(1, 3), bo(2, 3)
2996 DO j = bo(1, 2), bo(2, 2)
2997 DO i = bo(1, 1), bo(2, 1)
2998 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
2999 deriv_data(i, j, k)*rho1a(i, j, k)
3000 END DO
3001 END DO
3002 END DO
3003 END IF
3004 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_rhob])
3005 IF (ASSOCIATED(deriv_att)) THEN
3006 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3007!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3008!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
3009 DO k = bo(1, 3), bo(2, 3)
3010 DO j = bo(1, 2), bo(2, 2)
3011 DO i = bo(1, 1), bo(2, 1)
3012 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3013 deriv_data(i, j, k)*rho1b(i, j, k)
3014 END DO
3015 END DO
3016 END DO
3017 END IF
3018 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_norm_drho])
3019 IF (ASSOCIATED(deriv_att)) THEN
3020 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3021!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3022!$OMP SHARED(bo,v_xc_tau,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3023 DO k = bo(1, 3), bo(2, 3)
3024 DO j = bo(1, 2), bo(2, 2)
3025 DO i = bo(1, 1), bo(2, 1)
3026 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3027 deriv_data(i, j, k)*dr1dr(i, j, k)
3028 END DO
3029 END DO
3030 END DO
3031 END IF
3032 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_norm_drhoa])
3033 IF (ASSOCIATED(deriv_att)) THEN
3034 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3035!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3036!$OMP SHARED(bo,v_xc_tau,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3037 DO k = bo(1, 3), bo(2, 3)
3038 DO j = bo(1, 2), bo(2, 2)
3039 DO i = bo(1, 1), bo(2, 1)
3040 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3041 deriv_data(i, j, k)*dra1dra(i, j, k)
3042 END DO
3043 END DO
3044 END DO
3045 END IF
3046 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_norm_drhob])
3047 IF (ASSOCIATED(deriv_att)) THEN
3048 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3049!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3050!$OMP SHARED(bo,v_xc_tau,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3051 DO k = bo(1, 3), bo(2, 3)
3052 DO j = bo(1, 2), bo(2, 2)
3053 DO i = bo(1, 1), bo(2, 1)
3054 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3055 deriv_data(i, j, k)*drb1drb(i, j, k)
3056 END DO
3057 END DO
3058 END DO
3059 END IF
3060 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_tau_a])
3061 IF (ASSOCIATED(deriv_att)) THEN
3062 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3063!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3064!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1a,fac) COLLAPSE(3)
3065 DO k = bo(1, 3), bo(2, 3)
3066 DO j = bo(1, 2), bo(2, 2)
3067 DO i = bo(1, 1), bo(2, 1)
3068 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3069 deriv_data(i, j, k)*tau1a(i, j, k)
3070 END DO
3071 END DO
3072 END DO
3073 END IF
3074 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_tau_b])
3075 IF (ASSOCIATED(deriv_att)) THEN
3076 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3077!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3078!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1b,fac) COLLAPSE(3)
3079 DO k = bo(1, 3), bo(2, 3)
3080 DO j = bo(1, 2), bo(2, 2)
3081 DO i = bo(1, 1), bo(2, 1)
3082 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3083 deriv_data(i, j, k)*tau1b(i, j, k)
3084 END DO
3085 END DO
3086 END DO
3087 END IF
3088 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_laplace_rhoa])
3089 IF (ASSOCIATED(deriv_att)) THEN
3090 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3091!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3092!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
3093 DO k = bo(1, 3), bo(2, 3)
3094 DO j = bo(1, 2), bo(2, 2)
3095 DO i = bo(1, 1), bo(2, 1)
3096 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3097 deriv_data(i, j, k)*laplace1a(i, j, k)
3098 END DO
3099 END DO
3100 END DO
3101 END IF
3102 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_laplace_rhob])
3103 IF (ASSOCIATED(deriv_att)) THEN
3104 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3105!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3106!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
3107 DO k = bo(1, 3), bo(2, 3)
3108 DO j = bo(1, 2), bo(2, 2)
3109 DO i = bo(1, 1), bo(2, 1)
3110 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3111 deriv_data(i, j, k)*laplace1b(i, j, k)
3112 END DO
3113 END DO
3114 END DO
3115 END IF
3116
3117
3118 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_rhoa])
3119 IF (ASSOCIATED(deriv_att)) THEN
3120 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3121!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3122!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
3123 DO k = bo(1, 3), bo(2, 3)
3124 DO j = bo(1, 2), bo(2, 2)
3125 DO i = bo(1, 1), bo(2, 1)
3126 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3127 deriv_data(i, j, k)*rho1a(i, j, k)
3128 END DO
3129 END DO
3130 END DO
3131 END IF
3132 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_rhob])
3133 IF (ASSOCIATED(deriv_att)) THEN
3134 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3135!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3136!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
3137 DO k = bo(1, 3), bo(2, 3)
3138 DO j = bo(1, 2), bo(2, 2)
3139 DO i = bo(1, 1), bo(2, 1)
3140 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3141 deriv_data(i, j, k)*rho1b(i, j, k)
3142 END DO
3143 END DO
3144 END DO
3145 END IF
3146 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_norm_drho])
3147 IF (ASSOCIATED(deriv_att)) THEN
3148 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3149!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3150!$OMP SHARED(bo,v_xc_tau,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3151 DO k = bo(1, 3), bo(2, 3)
3152 DO j = bo(1, 2), bo(2, 2)
3153 DO i = bo(1, 1), bo(2, 1)
3154 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3155 deriv_data(i, j, k)*dr1dr(i, j, k)
3156 END DO
3157 END DO
3158 END DO
3159 END IF
3160 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_norm_drhoa])
3161 IF (ASSOCIATED(deriv_att)) THEN
3162 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3163!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3164!$OMP SHARED(bo,v_xc_tau,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3165 DO k = bo(1, 3), bo(2, 3)
3166 DO j = bo(1, 2), bo(2, 2)
3167 DO i = bo(1, 1), bo(2, 1)
3168 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3169 deriv_data(i, j, k)*dra1dra(i, j, k)
3170 END DO
3171 END DO
3172 END DO
3173 END IF
3174 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_norm_drhob])
3175 IF (ASSOCIATED(deriv_att)) THEN
3176 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3177!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3178!$OMP SHARED(bo,v_xc_tau,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3179 DO k = bo(1, 3), bo(2, 3)
3180 DO j = bo(1, 2), bo(2, 2)
3181 DO i = bo(1, 1), bo(2, 1)
3182 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3183 deriv_data(i, j, k)*drb1drb(i, j, k)
3184 END DO
3185 END DO
3186 END DO
3187 END IF
3188 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_tau_a])
3189 IF (ASSOCIATED(deriv_att)) THEN
3190 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3191!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3192!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1a,fac) COLLAPSE(3)
3193 DO k = bo(1, 3), bo(2, 3)
3194 DO j = bo(1, 2), bo(2, 2)
3195 DO i = bo(1, 1), bo(2, 1)
3196 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3197 deriv_data(i, j, k)*tau1a(i, j, k)
3198 END DO
3199 END DO
3200 END DO
3201 END IF
3202 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_tau_b])
3203 IF (ASSOCIATED(deriv_att)) THEN
3204 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3205!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3206!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1b,fac) COLLAPSE(3)
3207 DO k = bo(1, 3), bo(2, 3)
3208 DO j = bo(1, 2), bo(2, 2)
3209 DO i = bo(1, 1), bo(2, 1)
3210 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3211 deriv_data(i, j, k)*tau1b(i, j, k)
3212 END DO
3213 END DO
3214 END DO
3215 END IF
3216 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_laplace_rhoa])
3217 IF (ASSOCIATED(deriv_att)) THEN
3218 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3219!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3220!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
3221 DO k = bo(1, 3), bo(2, 3)
3222 DO j = bo(1, 2), bo(2, 2)
3223 DO i = bo(1, 1), bo(2, 1)
3224 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3225 deriv_data(i, j, k)*laplace1a(i, j, k)
3226 END DO
3227 END DO
3228 END DO
3229 END IF
3230 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_laplace_rhob])
3231 IF (ASSOCIATED(deriv_att)) THEN
3232 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3233!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3234!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
3235 DO k = bo(1, 3), bo(2, 3)
3236 DO j = bo(1, 2), bo(2, 2)
3237 DO i = bo(1, 1), bo(2, 1)
3238 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3239 deriv_data(i, j, k)*laplace1b(i, j, k)
3240 END DO
3241 END DO
3242 END DO
3243 END IF
3244
3245
3246 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_rhoa])
3247 IF (ASSOCIATED(deriv_att)) THEN
3248 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3249!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3250!$OMP SHARED(bo,v_laplace,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
3251 DO k = bo(1, 3), bo(2, 3)
3252 DO j = bo(1, 2), bo(2, 2)
3253 DO i = bo(1, 1), bo(2, 1)
3254 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3255 deriv_data(i, j, k)*rho1a(i, j, k)
3256 END DO
3257 END DO
3258 END DO
3259 END IF
3260 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_rhob])
3261 IF (ASSOCIATED(deriv_att)) THEN
3262 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3263!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3264!$OMP SHARED(bo,v_laplace,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
3265 DO k = bo(1, 3), bo(2, 3)
3266 DO j = bo(1, 2), bo(2, 2)
3267 DO i = bo(1, 1), bo(2, 1)
3268 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3269 deriv_data(i, j, k)*rho1b(i, j, k)
3270 END DO
3271 END DO
3272 END DO
3273 END IF
3275 IF (ASSOCIATED(deriv_att)) THEN
3276 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3277!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3278!$OMP SHARED(bo,v_laplace,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3279 DO k = bo(1, 3), bo(2, 3)
3280 DO j = bo(1, 2), bo(2, 2)
3281 DO i = bo(1, 1), bo(2, 1)
3282 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3283 deriv_data(i, j, k)*dr1dr(i, j, k)
3284 END DO
3285 END DO
3286 END DO
3287 END IF
3289 IF (ASSOCIATED(deriv_att)) THEN
3290 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3291!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3292!$OMP SHARED(bo,v_laplace,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3293 DO k = bo(1, 3), bo(2, 3)
3294 DO j = bo(1, 2), bo(2, 2)
3295 DO i = bo(1, 1), bo(2, 1)
3296 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3297 deriv_data(i, j, k)*dra1dra(i, j, k)
3298 END DO
3299 END DO
3300 END DO
3301 END IF
3303 IF (ASSOCIATED(deriv_att)) THEN
3304 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3305!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3306!$OMP SHARED(bo,v_laplace,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3307 DO k = bo(1, 3), bo(2, 3)
3308 DO j = bo(1, 2), bo(2, 2)
3309 DO i = bo(1, 1), bo(2, 1)
3310 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3311 deriv_data(i, j, k)*drb1drb(i, j, k)
3312 END DO
3313 END DO
3314 END DO
3315 END IF
3316 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_tau_a])
3317 IF (ASSOCIATED(deriv_att)) THEN
3318 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3319!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3320!$OMP SHARED(bo,v_laplace,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
3321 DO k = bo(1, 3), bo(2, 3)
3322 DO j = bo(1, 2), bo(2, 2)
3323 DO i = bo(1, 1), bo(2, 1)
3324 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3325 deriv_data(i, j, k)*tau1a(i, j, k)
3326 END DO
3327 END DO
3328 END DO
3329 END IF
3330 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_tau_b])
3331 IF (ASSOCIATED(deriv_att)) THEN
3332 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3333!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3334!$OMP SHARED(bo,v_laplace,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
3335 DO k = bo(1, 3), bo(2, 3)
3336 DO j = bo(1, 2), bo(2, 2)
3337 DO i = bo(1, 1), bo(2, 1)
3338 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3339 deriv_data(i, j, k)*tau1b(i, j, k)
3340 END DO
3341 END DO
3342 END DO
3343 END IF
3345 IF (ASSOCIATED(deriv_att)) THEN
3346 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3347!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3348!$OMP SHARED(bo,v_laplace,deriv_data,laplace1a,fac) COLLAPSE(3)
3349 DO k = bo(1, 3), bo(2, 3)
3350 DO j = bo(1, 2), bo(2, 2)
3351 DO i = bo(1, 1), bo(2, 1)
3352 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3353 deriv_data(i, j, k)*laplace1a(i, j, k)
3354 END DO
3355 END DO
3356 END DO
3357 END IF
3359 IF (ASSOCIATED(deriv_att)) THEN
3360 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3361!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3362!$OMP SHARED(bo,v_laplace,deriv_data,laplace1b,fac) COLLAPSE(3)
3363 DO k = bo(1, 3), bo(2, 3)
3364 DO j = bo(1, 2), bo(2, 2)
3365 DO i = bo(1, 1), bo(2, 1)
3366 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3367 deriv_data(i, j, k)*laplace1b(i, j, k)
3368 END DO
3369 END DO
3370 END DO
3371 END IF
3372
3373
3374 IF (my_compute_virial) THEN
3375 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa])
3376 IF (ASSOCIATED(deriv_att)) THEN
3377 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3378
3379 virial_pw%array(:, :, :) = -rho1a(:, :, :)
3380 CALL virial_laplace(virial_pw, pw_pool, virial_xc, deriv_data)
3381 END IF
3382 END IF ! my_compute_virial
3383 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhob, deriv_rhoa])
3384 IF (ASSOCIATED(deriv_att)) THEN
3385 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3386!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3387!$OMP SHARED(bo,v_laplace,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
3388 DO k = bo(1, 3), bo(2, 3)
3389 DO j = bo(1, 2), bo(2, 2)
3390 DO i = bo(1, 1), bo(2, 1)
3391 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3392 deriv_data(i, j, k)*rho1a(i, j, k)
3393 END DO
3394 END DO
3395 END DO
3396 END IF
3397 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhob, deriv_rhob])
3398 IF (ASSOCIATED(deriv_att)) THEN
3399 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3400!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3401!$OMP SHARED(bo,v_laplace,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
3402 DO k = bo(1, 3), bo(2, 3)
3403 DO j = bo(1, 2), bo(2, 2)
3404 DO i = bo(1, 1), bo(2, 1)
3405 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3406 deriv_data(i, j, k)*rho1b(i, j, k)
3407 END DO
3408 END DO
3409 END DO
3410 END IF
3412 IF (ASSOCIATED(deriv_att)) THEN
3413 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3414!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3415!$OMP SHARED(bo,v_laplace,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3416 DO k = bo(1, 3), bo(2, 3)
3417 DO j = bo(1, 2), bo(2, 2)
3418 DO i = bo(1, 1), bo(2, 1)
3419 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3420 deriv_data(i, j, k)*dr1dr(i, j, k)
3421 END DO
3422 END DO
3423 END DO
3424 END IF
3426 IF (ASSOCIATED(deriv_att)) THEN
3427 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3428!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3429!$OMP SHARED(bo,v_laplace,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3430 DO k = bo(1, 3), bo(2, 3)
3431 DO j = bo(1, 2), bo(2, 2)
3432 DO i = bo(1, 1), bo(2, 1)
3433 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3434 deriv_data(i, j, k)*dra1dra(i, j, k)
3435 END DO
3436 END DO
3437 END DO
3438 END IF
3440 IF (ASSOCIATED(deriv_att)) THEN
3441 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3442!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3443!$OMP SHARED(bo,v_laplace,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3444 DO k = bo(1, 3), bo(2, 3)
3445 DO j = bo(1, 2), bo(2, 2)
3446 DO i = bo(1, 1), bo(2, 1)
3447 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3448 deriv_data(i, j, k)*drb1drb(i, j, k)
3449 END DO
3450 END DO
3451 END DO
3452 END IF
3453 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhob, deriv_tau_a])
3454 IF (ASSOCIATED(deriv_att)) THEN
3455 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3456!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3457!$OMP SHARED(bo,v_laplace,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
3458 DO k = bo(1, 3), bo(2, 3)
3459 DO j = bo(1, 2), bo(2, 2)
3460 DO i = bo(1, 1), bo(2, 1)
3461 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3462 deriv_data(i, j, k)*tau1a(i, j, k)
3463 END DO
3464 END DO
3465 END DO
3466 END IF
3467 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhob, deriv_tau_b])
3468 IF (ASSOCIATED(deriv_att)) THEN
3469 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3470!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3471!$OMP SHARED(bo,v_laplace,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
3472 DO k = bo(1, 3), bo(2, 3)
3473 DO j = bo(1, 2), bo(2, 2)
3474 DO i = bo(1, 1), bo(2, 1)
3475 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3476 deriv_data(i, j, k)*tau1b(i, j, k)
3477 END DO
3478 END DO
3479 END DO
3480 END IF
3482 IF (ASSOCIATED(deriv_att)) THEN
3483 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3484!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3485!$OMP SHARED(bo,v_laplace,deriv_data,laplace1a,fac) COLLAPSE(3)
3486 DO k = bo(1, 3), bo(2, 3)
3487 DO j = bo(1, 2), bo(2, 2)
3488 DO i = bo(1, 1), bo(2, 1)
3489 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3490 deriv_data(i, j, k)*laplace1a(i, j, k)
3491 END DO
3492 END DO
3493 END DO
3494 END IF
3496 IF (ASSOCIATED(deriv_att)) THEN
3497 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3498!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3499!$OMP SHARED(bo,v_laplace,deriv_data,laplace1b,fac) COLLAPSE(3)
3500 DO k = bo(1, 3), bo(2, 3)
3501 DO j = bo(1, 2), bo(2, 2)
3502 DO i = bo(1, 1), bo(2, 1)
3503 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3504 deriv_data(i, j, k)*laplace1b(i, j, k)
3505 END DO
3506 END DO
3507 END DO
3508 END IF
3509
3510
3511 IF (my_compute_virial) THEN
3512 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhob])
3513 IF (ASSOCIATED(deriv_att)) THEN
3514 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3515
3516 virial_pw%array(:, :, :) = -rho1b(:, :, :)
3517 CALL virial_laplace(virial_pw, pw_pool, virial_xc, deriv_data)
3518 END IF
3519 END IF ! my_compute_virial
3520
3521
3522 ELSE
3523
3524 ! Compute (fxc^{\alpha\alpha}+-fxc^{\beta\beta})*\rho(1) over the grid points
3525 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_rhoa])
3526 IF (ASSOCIATED(deriv_att)) THEN
3527 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3528!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3529!$OMP SHARED(bo,v_xc,deriv_data,rho1a,fac) COLLAPSE(3)
3530 DO k = bo(1, 3), bo(2, 3)
3531 DO j = bo(1, 2), bo(2, 2)
3532 DO i = bo(1, 1), bo(2, 1)
3533 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3534 deriv_data(i, j, k)*rho1a(i, j, k)
3535 END DO
3536 END DO
3537 END DO
3538 END IF
3539 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drho])
3540 IF (ASSOCIATED(deriv_att)) THEN
3541 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3542!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3543!$OMP SHARED(bo,v_xc,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3544 DO k = bo(1, 3), bo(2, 3)
3545 DO j = bo(1, 2), bo(2, 2)
3546 DO i = bo(1, 1), bo(2, 1)
3547 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3548 deriv_data(i, j, k)*dr1dr(i, j, k)
3549 END DO
3550 END DO
3551 END DO
3552 END IF
3553 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drhoa])
3554 IF (ASSOCIATED(deriv_att)) THEN
3555 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3556!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3557!$OMP SHARED(bo,v_xc,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3558 DO k = bo(1, 3), bo(2, 3)
3559 DO j = bo(1, 2), bo(2, 2)
3560 DO i = bo(1, 1), bo(2, 1)
3561 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3562 deriv_data(i, j, k)*dra1dra(i, j, k)
3563 END DO
3564 END DO
3565 END DO
3566 END IF
3567 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_tau_a])
3568 IF (ASSOCIATED(deriv_att)) THEN
3569 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3570!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3571!$OMP SHARED(bo,v_xc,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
3572 DO k = bo(1, 3), bo(2, 3)
3573 DO j = bo(1, 2), bo(2, 2)
3574 DO i = bo(1, 1), bo(2, 1)
3575 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3576 deriv_data(i, j, k)*tau1a(i, j, k)
3577 END DO
3578 END DO
3579 END DO
3580 END IF
3581 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_laplace_rhoa])
3582 IF (ASSOCIATED(deriv_att)) THEN
3583 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3584!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3585!$OMP SHARED(bo,v_xc,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
3586 DO k = bo(1, 3), bo(2, 3)
3587 DO j = bo(1, 2), bo(2, 2)
3588 DO i = bo(1, 1), bo(2, 1)
3589 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3590 deriv_data(i, j, k)*laplace1a(i, j, k)
3591 END DO
3592 END DO
3593 END DO
3594 END IF
3595 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_rhob])
3596 IF (ASSOCIATED(deriv_att)) THEN
3597 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3598!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3599!$OMP SHARED(bo,v_xc,deriv_data,rho1b,fac) COLLAPSE(3)
3600 DO k = bo(1, 3), bo(2, 3)
3601 DO j = bo(1, 2), bo(2, 2)
3602 DO i = bo(1, 1), bo(2, 1)
3603 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3604 fac*deriv_data(i, j, k)*rho1b(i, j, k)
3605 END DO
3606 END DO
3607 END DO
3608 END IF
3609 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drhob])
3610 IF (ASSOCIATED(deriv_att)) THEN
3611 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3612!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3613!$OMP SHARED(bo,v_xc,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3614 DO k = bo(1, 3), bo(2, 3)
3615 DO j = bo(1, 2), bo(2, 2)
3616 DO i = bo(1, 1), bo(2, 1)
3617 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3618 fac*deriv_data(i, j, k)*drb1drb(i, j, k)
3619 END DO
3620 END DO
3621 END DO
3622 END IF
3623 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_tau_b])
3624 IF (ASSOCIATED(deriv_att)) THEN
3625 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3626!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3627!$OMP SHARED(bo,v_xc,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
3628 DO k = bo(1, 3), bo(2, 3)
3629 DO j = bo(1, 2), bo(2, 2)
3630 DO i = bo(1, 1), bo(2, 1)
3631 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3632 fac*deriv_data(i, j, k)*tau1b(i, j, k)
3633 END DO
3634 END DO
3635 END DO
3636 END IF
3637 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_laplace_rhob])
3638 IF (ASSOCIATED(deriv_att)) THEN
3639 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3640!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3641!$OMP SHARED(bo,v_xc,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
3642 DO k = bo(1, 3), bo(2, 3)
3643 DO j = bo(1, 2), bo(2, 2)
3644 DO i = bo(1, 1), bo(2, 1)
3645 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3646 fac*deriv_data(i, j, k)*laplace1b(i, j, k)
3647 END DO
3648 END DO
3649 END DO
3650 END IF
3651
3652
3653 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rhoa])
3654 IF (ASSOCIATED(deriv_att)) THEN
3655 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3656!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3657!$OMP SHARED(bo,v_drho,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
3658 DO k = bo(1, 3), bo(2, 3)
3659 DO j = bo(1, 2), bo(2, 2)
3660 DO i = bo(1, 1), bo(2, 1)
3661 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3662 deriv_data(i, j, k)*rho1a(i, j, k)
3663 END DO
3664 END DO
3665 END DO
3666 END IF
3667 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drho])
3668 IF (ASSOCIATED(deriv_att)) THEN
3669 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3670!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3671!$OMP SHARED(bo,v_drho,deriv_data,dr1dr,fac) COLLAPSE(3)
3672 DO k = bo(1, 3), bo(2, 3)
3673 DO j = bo(1, 2), bo(2, 2)
3674 DO i = bo(1, 1), bo(2, 1)
3675 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3676 deriv_data(i, j, k)*dr1dr(i, j, k)
3677 END DO
3678 END DO
3679 END DO
3680 END IF
3681 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drhoa])
3682 IF (ASSOCIATED(deriv_att)) THEN
3683 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3684!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3685!$OMP SHARED(bo,v_drho,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3686 DO k = bo(1, 3), bo(2, 3)
3687 DO j = bo(1, 2), bo(2, 2)
3688 DO i = bo(1, 1), bo(2, 1)
3689 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3690 deriv_data(i, j, k)*dra1dra(i, j, k)
3691 END DO
3692 END DO
3693 END DO
3694 END IF
3695 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_tau_a])
3696 IF (ASSOCIATED(deriv_att)) THEN
3697 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3698!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3699!$OMP SHARED(bo,v_drho,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
3700 DO k = bo(1, 3), bo(2, 3)
3701 DO j = bo(1, 2), bo(2, 2)
3702 DO i = bo(1, 1), bo(2, 1)
3703 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3704 deriv_data(i, j, k)*tau1a(i, j, k)
3705 END DO
3706 END DO
3707 END DO
3708 END IF
3710 IF (ASSOCIATED(deriv_att)) THEN
3711 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3712!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3713!$OMP SHARED(bo,v_drho,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
3714 DO k = bo(1, 3), bo(2, 3)
3715 DO j = bo(1, 2), bo(2, 2)
3716 DO i = bo(1, 1), bo(2, 1)
3717 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3718 deriv_data(i, j, k)*laplace1a(i, j, k)
3719 END DO
3720 END DO
3721 END DO
3722 END IF
3723 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rhob])
3724 IF (ASSOCIATED(deriv_att)) THEN
3725 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3726!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3727!$OMP SHARED(bo,v_drho,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
3728 DO k = bo(1, 3), bo(2, 3)
3729 DO j = bo(1, 2), bo(2, 2)
3730 DO i = bo(1, 1), bo(2, 1)
3731 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3732 fac*deriv_data(i, j, k)*rho1b(i, j, k)
3733 END DO
3734 END DO
3735 END DO
3736 END IF
3737 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drhob])
3738 IF (ASSOCIATED(deriv_att)) THEN
3739 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3740!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3741!$OMP SHARED(bo,v_drho,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3742 DO k = bo(1, 3), bo(2, 3)
3743 DO j = bo(1, 2), bo(2, 2)
3744 DO i = bo(1, 1), bo(2, 1)
3745 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3746 fac*deriv_data(i, j, k)*drb1drb(i, j, k)
3747 END DO
3748 END DO
3749 END DO
3750 END IF
3751 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_tau_b])
3752 IF (ASSOCIATED(deriv_att)) THEN
3753 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3754!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3755!$OMP SHARED(bo,v_drho,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
3756 DO k = bo(1, 3), bo(2, 3)
3757 DO j = bo(1, 2), bo(2, 2)
3758 DO i = bo(1, 1), bo(2, 1)
3759 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3760 fac*deriv_data(i, j, k)*tau1b(i, j, k)
3761 END DO
3762 END DO
3763 END DO
3764 END IF
3766 IF (ASSOCIATED(deriv_att)) THEN
3767 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3768!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3769!$OMP SHARED(bo,v_drho,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
3770 DO k = bo(1, 3), bo(2, 3)
3771 DO j = bo(1, 2), bo(2, 2)
3772 DO i = bo(1, 1), bo(2, 1)
3773 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3774 fac*deriv_data(i, j, k)*laplace1b(i, j, k)
3775 END DO
3776 END DO
3777 END DO
3778 END IF
3779
3780 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho])
3781 IF (ASSOCIATED(deriv_att)) THEN
3782 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3783 CALL xc_derivative_get(deriv_att, deriv_data=e_drho)
3784
3785
3786!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dr1dr,gradient_cut,norm_drho,v_drho,deriv_data)
3787 v_drho(1)%array(:, :, :) = v_drho(1)%array(:, :, :) + &
3788 deriv_data(:, :, :)*dr1dr(:, :, :)/max(gradient_cut, norm_drho(:, :, :))**2
3789!$OMP END PARALLEL WORKSHARE
3790 END IF
3791
3792 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_rhoa])
3793 IF (ASSOCIATED(deriv_att)) THEN
3794 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3795!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3796!$OMP SHARED(bo,v_drhoa,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
3797 DO k = bo(1, 3), bo(2, 3)
3798 DO j = bo(1, 2), bo(2, 2)
3799 DO i = bo(1, 1), bo(2, 1)
3800 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3801 deriv_data(i, j, k)*rho1a(i, j, k)
3802 END DO
3803 END DO
3804 END DO
3805 END IF
3806 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drho])
3807 IF (ASSOCIATED(deriv_att)) THEN
3808 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3809!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3810!$OMP SHARED(bo,v_drhoa,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3811 DO k = bo(1, 3), bo(2, 3)
3812 DO j = bo(1, 2), bo(2, 2)
3813 DO i = bo(1, 1), bo(2, 1)
3814 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3815 deriv_data(i, j, k)*dr1dr(i, j, k)
3816 END DO
3817 END DO
3818 END DO
3819 END IF
3820 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drhoa])
3821 IF (ASSOCIATED(deriv_att)) THEN
3822 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3823!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3824!$OMP SHARED(bo,v_drhoa,deriv_data,dra1dra,fac) COLLAPSE(3)
3825 DO k = bo(1, 3), bo(2, 3)
3826 DO j = bo(1, 2), bo(2, 2)
3827 DO i = bo(1, 1), bo(2, 1)
3828 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3829 deriv_data(i, j, k)*dra1dra(i, j, k)
3830 END DO
3831 END DO
3832 END DO
3833 END IF
3834 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_tau_a])
3835 IF (ASSOCIATED(deriv_att)) THEN
3836 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3837!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3838!$OMP SHARED(bo,v_drhoa,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
3839 DO k = bo(1, 3), bo(2, 3)
3840 DO j = bo(1, 2), bo(2, 2)
3841 DO i = bo(1, 1), bo(2, 1)
3842 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3843 deriv_data(i, j, k)*tau1a(i, j, k)
3844 END DO
3845 END DO
3846 END DO
3847 END IF
3849 IF (ASSOCIATED(deriv_att)) THEN
3850 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3851!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3852!$OMP SHARED(bo,v_drhoa,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
3853 DO k = bo(1, 3), bo(2, 3)
3854 DO j = bo(1, 2), bo(2, 2)
3855 DO i = bo(1, 1), bo(2, 1)
3856 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3857 deriv_data(i, j, k)*laplace1a(i, j, k)
3858 END DO
3859 END DO
3860 END DO
3861 END IF
3862 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_rhob])
3863 IF (ASSOCIATED(deriv_att)) THEN
3864 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3865!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3866!$OMP SHARED(bo,v_drhoa,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
3867 DO k = bo(1, 3), bo(2, 3)
3868 DO j = bo(1, 2), bo(2, 2)
3869 DO i = bo(1, 1), bo(2, 1)
3870 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3871 fac*deriv_data(i, j, k)*rho1b(i, j, k)
3872 END DO
3873 END DO
3874 END DO
3875 END IF
3876 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drhob])
3877 IF (ASSOCIATED(deriv_att)) THEN
3878 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3879!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3880!$OMP SHARED(bo,v_drhoa,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3881 DO k = bo(1, 3), bo(2, 3)
3882 DO j = bo(1, 2), bo(2, 2)
3883 DO i = bo(1, 1), bo(2, 1)
3884 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3885 fac*deriv_data(i, j, k)*drb1drb(i, j, k)
3886 END DO
3887 END DO
3888 END DO
3889 END IF
3890 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_tau_b])
3891 IF (ASSOCIATED(deriv_att)) THEN
3892 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3893!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3894!$OMP SHARED(bo,v_drhoa,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
3895 DO k = bo(1, 3), bo(2, 3)
3896 DO j = bo(1, 2), bo(2, 2)
3897 DO i = bo(1, 1), bo(2, 1)
3898 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3899 fac*deriv_data(i, j, k)*tau1b(i, j, k)
3900 END DO
3901 END DO
3902 END DO
3903 END IF
3905 IF (ASSOCIATED(deriv_att)) THEN
3906 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3907!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3908!$OMP SHARED(bo,v_drhoa,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
3909 DO k = bo(1, 3), bo(2, 3)
3910 DO j = bo(1, 2), bo(2, 2)
3911 DO i = bo(1, 1), bo(2, 1)
3912 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3913 fac*deriv_data(i, j, k)*laplace1b(i, j, k)
3914 END DO
3915 END DO
3916 END DO
3917 END IF
3918
3919 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa])
3920 IF (ASSOCIATED(deriv_att)) THEN
3921 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3922 CALL xc_derivative_get(deriv_att, deriv_data=e_drhoa)
3923
3924
3925!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dra1dra,gradient_cut,norm_drhoa,v_drhoa,deriv_data)
3926 v_drhoa(1)%array(:, :, :) = v_drhoa(1)%array(:, :, :) + &
3927 deriv_data(:, :, :)*dra1dra(:, :, :)/max(gradient_cut, norm_drhoa(:, :, :))**2
3928!$OMP END PARALLEL WORKSHARE
3929 END IF
3930
3931 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_rhoa])
3932 IF (ASSOCIATED(deriv_att)) THEN
3933 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3934!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3935!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
3936 DO k = bo(1, 3), bo(2, 3)
3937 DO j = bo(1, 2), bo(2, 2)
3938 DO i = bo(1, 1), bo(2, 1)
3939 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3940 deriv_data(i, j, k)*rho1a(i, j, k)
3941 END DO
3942 END DO
3943 END DO
3944 END IF
3945 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_norm_drho])
3946 IF (ASSOCIATED(deriv_att)) THEN
3947 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3948!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3949!$OMP SHARED(bo,v_xc_tau,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3950 DO k = bo(1, 3), bo(2, 3)
3951 DO j = bo(1, 2), bo(2, 2)
3952 DO i = bo(1, 1), bo(2, 1)
3953 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3954 deriv_data(i, j, k)*dr1dr(i, j, k)
3955 END DO
3956 END DO
3957 END DO
3958 END IF
3959 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_norm_drhoa])
3960 IF (ASSOCIATED(deriv_att)) THEN
3961 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3962!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3963!$OMP SHARED(bo,v_xc_tau,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3964 DO k = bo(1, 3), bo(2, 3)
3965 DO j = bo(1, 2), bo(2, 2)
3966 DO i = bo(1, 1), bo(2, 1)
3967 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3968 deriv_data(i, j, k)*dra1dra(i, j, k)
3969 END DO
3970 END DO
3971 END DO
3972 END IF
3973 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_tau_a])
3974 IF (ASSOCIATED(deriv_att)) THEN
3975 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3976!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3977!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1a,fac) COLLAPSE(3)
3978 DO k = bo(1, 3), bo(2, 3)
3979 DO j = bo(1, 2), bo(2, 2)
3980 DO i = bo(1, 1), bo(2, 1)
3981 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3982 deriv_data(i, j, k)*tau1a(i, j, k)
3983 END DO
3984 END DO
3985 END DO
3986 END IF
3987 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_laplace_rhoa])
3988 IF (ASSOCIATED(deriv_att)) THEN
3989 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3990!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3991!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
3992 DO k = bo(1, 3), bo(2, 3)
3993 DO j = bo(1, 2), bo(2, 2)
3994 DO i = bo(1, 1), bo(2, 1)
3995 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3996 deriv_data(i, j, k)*laplace1a(i, j, k)
3997 END DO
3998 END DO
3999 END DO
4000 END IF
4001 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_rhob])
4002 IF (ASSOCIATED(deriv_att)) THEN
4003 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4004!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4005!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
4006 DO k = bo(1, 3), bo(2, 3)
4007 DO j = bo(1, 2), bo(2, 2)
4008 DO i = bo(1, 1), bo(2, 1)
4009 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4010 fac*deriv_data(i, j, k)*rho1b(i, j, k)
4011 END DO
4012 END DO
4013 END DO
4014 END IF
4015 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_norm_drhob])
4016 IF (ASSOCIATED(deriv_att)) THEN
4017 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4018!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4019!$OMP SHARED(bo,v_xc_tau,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
4020 DO k = bo(1, 3), bo(2, 3)
4021 DO j = bo(1, 2), bo(2, 2)
4022 DO i = bo(1, 1), bo(2, 1)
4023 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4024 fac*deriv_data(i, j, k)*drb1drb(i, j, k)
4025 END DO
4026 END DO
4027 END DO
4028 END IF
4029 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_tau_b])
4030 IF (ASSOCIATED(deriv_att)) THEN
4031 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4032!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4033!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1b,fac) COLLAPSE(3)
4034 DO k = bo(1, 3), bo(2, 3)
4035 DO j = bo(1, 2), bo(2, 2)
4036 DO i = bo(1, 1), bo(2, 1)
4037 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4038 fac*deriv_data(i, j, k)*tau1b(i, j, k)
4039 END DO
4040 END DO
4041 END DO
4042 END IF
4043 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_laplace_rhob])
4044 IF (ASSOCIATED(deriv_att)) THEN
4045 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4046!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4047!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
4048 DO k = bo(1, 3), bo(2, 3)
4049 DO j = bo(1, 2), bo(2, 2)
4050 DO i = bo(1, 1), bo(2, 1)
4051 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4052 fac*deriv_data(i, j, k)*laplace1b(i, j, k)
4053 END DO
4054 END DO
4055 END DO
4056 END IF
4057
4058
4059 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_rhoa])
4060 IF (ASSOCIATED(deriv_att)) THEN
4061 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4062!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4063!$OMP SHARED(bo,v_laplace,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
4064 DO k = bo(1, 3), bo(2, 3)
4065 DO j = bo(1, 2), bo(2, 2)
4066 DO i = bo(1, 1), bo(2, 1)
4067 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4068 deriv_data(i, j, k)*rho1a(i, j, k)
4069 END DO
4070 END DO
4071 END DO
4072 END IF
4074 IF (ASSOCIATED(deriv_att)) THEN
4075 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4076!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4077!$OMP SHARED(bo,v_laplace,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
4078 DO k = bo(1, 3), bo(2, 3)
4079 DO j = bo(1, 2), bo(2, 2)
4080 DO i = bo(1, 1), bo(2, 1)
4081 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4082 deriv_data(i, j, k)*dr1dr(i, j, k)
4083 END DO
4084 END DO
4085 END DO
4086 END IF
4088 IF (ASSOCIATED(deriv_att)) THEN
4089 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4090!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4091!$OMP SHARED(bo,v_laplace,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
4092 DO k = bo(1, 3), bo(2, 3)
4093 DO j = bo(1, 2), bo(2, 2)
4094 DO i = bo(1, 1), bo(2, 1)
4095 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4096 deriv_data(i, j, k)*dra1dra(i, j, k)
4097 END DO
4098 END DO
4099 END DO
4100 END IF
4101 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_tau_a])
4102 IF (ASSOCIATED(deriv_att)) THEN
4103 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4104!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4105!$OMP SHARED(bo,v_laplace,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
4106 DO k = bo(1, 3), bo(2, 3)
4107 DO j = bo(1, 2), bo(2, 2)
4108 DO i = bo(1, 1), bo(2, 1)
4109 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4110 deriv_data(i, j, k)*tau1a(i, j, k)
4111 END DO
4112 END DO
4113 END DO
4114 END IF
4116 IF (ASSOCIATED(deriv_att)) THEN
4117 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4118!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4119!$OMP SHARED(bo,v_laplace,deriv_data,laplace1a,fac) COLLAPSE(3)
4120 DO k = bo(1, 3), bo(2, 3)
4121 DO j = bo(1, 2), bo(2, 2)
4122 DO i = bo(1, 1), bo(2, 1)
4123 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4124 deriv_data(i, j, k)*laplace1a(i, j, k)
4125 END DO
4126 END DO
4127 END DO
4128 END IF
4129 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_rhob])
4130 IF (ASSOCIATED(deriv_att)) THEN
4131 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4132!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4133!$OMP SHARED(bo,v_laplace,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
4134 DO k = bo(1, 3), bo(2, 3)
4135 DO j = bo(1, 2), bo(2, 2)
4136 DO i = bo(1, 1), bo(2, 1)
4137 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4138 fac*deriv_data(i, j, k)*rho1b(i, j, k)
4139 END DO
4140 END DO
4141 END DO
4142 END IF
4144 IF (ASSOCIATED(deriv_att)) THEN
4145 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4146!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4147!$OMP SHARED(bo,v_laplace,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
4148 DO k = bo(1, 3), bo(2, 3)
4149 DO j = bo(1, 2), bo(2, 2)
4150 DO i = bo(1, 1), bo(2, 1)
4151 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4152 fac*deriv_data(i, j, k)*drb1drb(i, j, k)
4153 END DO
4154 END DO
4155 END DO
4156 END IF
4157 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_tau_b])
4158 IF (ASSOCIATED(deriv_att)) THEN
4159 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4160!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4161!$OMP SHARED(bo,v_laplace,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
4162 DO k = bo(1, 3), bo(2, 3)
4163 DO j = bo(1, 2), bo(2, 2)
4164 DO i = bo(1, 1), bo(2, 1)
4165 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4166 fac*deriv_data(i, j, k)*tau1b(i, j, k)
4167 END DO
4168 END DO
4169 END DO
4170 END IF
4172 IF (ASSOCIATED(deriv_att)) THEN
4173 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4174!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4175!$OMP SHARED(bo,v_laplace,deriv_data,laplace1b,fac) COLLAPSE(3)
4176 DO k = bo(1, 3), bo(2, 3)
4177 DO j = bo(1, 2), bo(2, 2)
4178 DO i = bo(1, 1), bo(2, 1)
4179 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4180 fac*deriv_data(i, j, k)*laplace1b(i, j, k)
4181 END DO
4182 END DO
4183 END DO
4184 END IF
4185
4186
4187
4188
4189 END IF
4190
4191 IF (gradient_f) THEN
4192 IF (.NOT. do_spinflip) THEN
4193
4194 IF (my_compute_virial) THEN
4195 CALL virial_drho_drho(virial_pw, drhoa, v_drhoa(1), virial_xc)
4196 CALL virial_drho_drho(virial_pw, drhob, v_drhob(2), virial_xc)
4197 DO idir = 1, 3
4198!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drho,idir,v_drho,virial_pw)
4199 virial_pw%array(:, :, :) = drho(idir)%array(:, :, :)*(v_drho(1)%array(:, :, :) + v_drho(2)%array(:, :, :))
4200!$OMP END PARALLEL WORKSHARE
4201 DO jdir = 1, idir
4202 tmp = -0.5_dp*virial_pw%pw_grid%dvol*accurate_dot_product(virial_pw%array(:, :, :), &
4203 drho(jdir)%array(:, :, :))
4204 virial_xc(jdir, idir) = virial_xc(jdir, idir) + tmp
4205 virial_xc(idir, jdir) = virial_xc(jdir, idir)
4206 END DO
4207 END DO
4208 END IF ! my_compute_virial
4209
4210 IF (my_gapw) THEN
4211!$OMP PARALLEL DO DEFAULT(NONE) &
4212!$OMP PRIVATE(ia,idir,ispin,ir) &
4213!$OMP SHARED(bo,nspins,vxg,drhoa,drhob,v_drhoa,v_drhob,v_drho, &
4214!$OMP e_drhoa,e_drhob,e_drho,drho1a,drho1b,fac,drho,drho1) COLLAPSE(3)
4215 DO ir = bo(1, 2), bo(2, 2)
4216 DO ia = bo(1, 1), bo(2, 1)
4217 DO idir = 1, 3
4218 DO ispin = 1, nspins
4219 vxg(idir, ia, ir, ispin) = &
4220 -(v_drhoa(ispin)%array(ia, ir, 1)*drhoa(idir)%array(ia, ir, 1) + &
4221 v_drhob(ispin)%array(ia, ir, 1)*drhob(idir)%array(ia, ir, 1) + &
4222 v_drho(ispin)%array(ia, ir, 1)*drho(idir)%array(ia, ir, 1))
4223 END DO
4224 IF (ASSOCIATED(e_drhoa)) THEN
4225 vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1) + &
4226 e_drhoa(ia, ir, 1)*drho1a(idir)%array(ia, ir, 1)
4227 END IF
4228 IF (nspins /= 1 .AND. ASSOCIATED(e_drhob)) THEN
4229 vxg(idir, ia, ir, 2) = vxg(idir, ia, ir, 2) + &
4230 e_drhob(ia, ir, 1)*drho1b(idir)%array(ia, ir, 1)
4231 END IF
4232 IF (ASSOCIATED(e_drho)) THEN
4233 IF (nspins /= 1) THEN
4234 vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1) + &
4235 e_drho(ia, ir, 1)*drho1(idir)%array(ia, ir, 1)
4236 vxg(idir, ia, ir, 2) = vxg(idir, ia, ir, 2) + &
4237 e_drho(ia, ir, 1)*drho1(idir)%array(ia, ir, 1)
4238 ELSE
4239 vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1) + &
4240 e_drho(ia, ir, 1)*(drho1a(idir)%array(ia, ir, 1) + &
4241 fac*drho1b(idir)%array(ia, ir, 1))
4242 END IF
4243 END IF
4244 END DO
4245 END DO
4246 END DO
4247!$OMP END PARALLEL DO
4248 ELSE
4249
4250 ! partial integration
4251 DO idir = 1, 3
4252
4253 DO ispin = 1, nspins
4254!$OMP PARALLEL WORKSHARE DEFAULT(NONE) &
4255!$OMP SHARED(v_drho_r,v_drhoa,v_drhob,v_drho,drhoa,drhob,drho,ispin,idir)
4256 v_drho_r(idir, ispin)%array(:, :, :) = &
4257 v_drhoa(ispin)%array(:, :, :)*drhoa(idir)%array(:, :, :) + &
4258 v_drhob(ispin)%array(:, :, :)*drhob(idir)%array(:, :, :) + &
4259 v_drho(ispin)%array(:, :, :)*drho(idir)%array(:, :, :)
4260!$OMP END PARALLEL WORKSHARE
4261 END DO
4262 IF (ASSOCIATED(e_drhoa)) THEN
4263!$OMP PARALLEL WORKSHARE DEFAULT(NONE) &
4264!$OMP SHARED(v_drho_r,e_drhoa,drho1a,idir)
4265 v_drho_r(idir, 1)%array(:, :, :) = v_drho_r(idir, 1)%array(:, :, :) - &
4266 e_drhoa(:, :, :)*drho1a(idir)%array(:, :, :)
4267!$OMP END PARALLEL WORKSHARE
4268 END IF
4269 IF (nspins /= 1 .AND. ASSOCIATED(e_drhob)) THEN
4270!$OMP PARALLEL WORKSHARE DEFAULT(NONE)&
4271!$OMP SHARED(v_drho_r,e_drhob,drho1b,idir)
4272 v_drho_r(idir, 2)%array(:, :, :) = v_drho_r(idir, 2)%array(:, :, :) - &
4273 e_drhob(:, :, :)*drho1b(idir)%array(:, :, :)
4274!$OMP END PARALLEL WORKSHARE
4275 END IF
4276 IF (ASSOCIATED(e_drho)) THEN
4277!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4278!$OMP SHARED(bo,v_drho_r,e_drho,drho1a,drho1b,drho1,fac,idir,nspins) COLLAPSE(3)
4279 DO k = bo(1, 3), bo(2, 3)
4280 DO j = bo(1, 2), bo(2, 2)
4281 DO i = bo(1, 1), bo(2, 1)
4282 IF (nspins /= 1) THEN
4283 v_drho_r(idir, 1)%array(i, j, k) = v_drho_r(idir, 1)%array(i, j, k) - &
4284 e_drho(i, j, k)*drho1(idir)%array(i, j, k)
4285 v_drho_r(idir, 2)%array(i, j, k) = v_drho_r(idir, 2)%array(i, j, k) - &
4286 e_drho(i, j, k)*drho1(idir)%array(i, j, k)
4287 ELSE
4288 v_drho_r(idir, 1)%array(i, j, k) = v_drho_r(idir, 1)%array(i, j, k) - &
4289 e_drho(i, j, k)*(drho1a(idir)%array(i, j, k) + &
4290 fac*drho1b(idir)%array(i, j, k))
4291 END IF
4292 END DO
4293 END DO
4294 END DO
4295!$OMP END PARALLEL DO
4296 END IF
4297 END DO
4298
4299 ! partial integration
4300 DO ispin = 1, nspins
4301 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, ispin), tmp_g, vxc_g, v_xc(ispin))
4302 END DO ! ispin
4303
4304 END IF
4305
4306 END IF ! .NOT.do_spinflip
4307
4308 DO idir = 1, 3
4309 DEALLOCATE (drho(idir)%array)
4310 DEALLOCATE (drho1(idir)%array)
4311 END DO
4312
4313 DO ispin = 1, nspins
4314 CALL deallocate_pw(v_drhoa(ispin), pw_pool)
4315 CALL deallocate_pw(v_drhob(ispin), pw_pool)
4316 END DO
4317
4318 DEALLOCATE (v_drhoa, v_drhob)
4319
4320 END IF ! gradient_f
4321
4322 IF (laplace_f .AND. my_compute_virial) THEN
4323 virial_pw%array(:, :, :) = -rhoa(:, :, :)
4324 CALL virial_laplace(virial_pw, pw_pool, virial_xc, v_laplace(1)%array)
4325 virial_pw%array(:, :, :) = -rhob(:, :, :)
4326 CALL virial_laplace(virial_pw, pw_pool, virial_xc, v_laplace(2)%array)
4327 END IF
4328
4329 ELSE
4330
4331 !-----------------!
4332 ! restricted case !
4333 !-----------------!
4334
4335 CALL xc_rho_set_get(rho1_set, rho=rho1)
4336
4337 IF (gradient_f) THEN
4338 CALL xc_rho_set_get(rho_set, drho=drho, norm_drho=norm_drho)
4339 CALL xc_rho_set_get(rho1_set, drho=drho1)
4340 CALL prepare_dr1dr(dr1dr, drho, drho1)
4341 END IF
4342
4343 IF (laplace_f) THEN
4344 CALL xc_rho_set_get(rho1_set, laplace_rho=laplace1)
4345
4346 ALLOCATE (v_laplace(nspins))
4347 DO ispin = 1, nspins
4348 CALL allocate_pw(v_laplace(ispin), pw_pool, bo)
4349 END DO
4350
4351 IF (my_compute_virial) CALL xc_rho_set_get(rho_set, rho=rho)
4352 END IF
4353
4354 IF (tau_f) THEN
4355 CALL xc_rho_set_get(rho1_set, tau=tau1)
4356 END IF
4357
4358 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_rho])
4359 IF (ASSOCIATED(deriv_att)) THEN
4360 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4361!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4362!$OMP SHARED(bo,v_xc,deriv_data,rho1,fac) COLLAPSE(3)
4363 DO k = bo(1, 3), bo(2, 3)
4364 DO j = bo(1, 2), bo(2, 2)
4365 DO i = bo(1, 1), bo(2, 1)
4366 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
4367 deriv_data(i, j, k)*rho1(i, j, k)
4368 END DO
4369 END DO
4370 END DO
4371 END IF
4372 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_norm_drho])
4373 IF (ASSOCIATED(deriv_att)) THEN
4374 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4375!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4376!$OMP SHARED(bo,v_xc,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
4377 DO k = bo(1, 3), bo(2, 3)
4378 DO j = bo(1, 2), bo(2, 2)
4379 DO i = bo(1, 1), bo(2, 1)
4380 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
4381 deriv_data(i, j, k)*dr1dr(i, j, k)
4382 END DO
4383 END DO
4384 END DO
4385 END IF
4386 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_tau])
4387 IF (ASSOCIATED(deriv_att)) THEN
4388 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4389!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4390!$OMP SHARED(bo,v_xc,deriv_data,tau1,v_xc_tau,fac) COLLAPSE(3)
4391 DO k = bo(1, 3), bo(2, 3)
4392 DO j = bo(1, 2), bo(2, 2)
4393 DO i = bo(1, 1), bo(2, 1)
4394 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
4395 deriv_data(i, j, k)*tau1(i, j, k)
4396 END DO
4397 END DO
4398 END DO
4399 END IF
4400 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_laplace_rho])
4401 IF (ASSOCIATED(deriv_att)) THEN
4402 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4403!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4404!$OMP SHARED(bo,v_xc,deriv_data,laplace1,v_laplace,fac) COLLAPSE(3)
4405 DO k = bo(1, 3), bo(2, 3)
4406 DO j = bo(1, 2), bo(2, 2)
4407 DO i = bo(1, 1), bo(2, 1)
4408 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
4409 deriv_data(i, j, k)*laplace1(i, j, k)
4410 END DO
4411 END DO
4412 END DO
4413 END IF
4414
4415
4416 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rho])
4417 IF (ASSOCIATED(deriv_att)) THEN
4418 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4419!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4420!$OMP SHARED(bo,v_drho,deriv_data,rho1,v_xc,fac) COLLAPSE(3)
4421 DO k = bo(1, 3), bo(2, 3)
4422 DO j = bo(1, 2), bo(2, 2)
4423 DO i = bo(1, 1), bo(2, 1)
4424 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
4425 deriv_data(i, j, k)*rho1(i, j, k)
4426 END DO
4427 END DO
4428 END DO
4429 END IF
4430 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drho])
4431 IF (ASSOCIATED(deriv_att)) THEN
4432 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4433!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4434!$OMP SHARED(bo,v_drho,deriv_data,dr1dr,fac) COLLAPSE(3)
4435 DO k = bo(1, 3), bo(2, 3)
4436 DO j = bo(1, 2), bo(2, 2)
4437 DO i = bo(1, 1), bo(2, 1)
4438 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
4439 deriv_data(i, j, k)*dr1dr(i, j, k)
4440 END DO
4441 END DO
4442 END DO
4443 END IF
4444 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_tau])
4445 IF (ASSOCIATED(deriv_att)) THEN
4446 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4447!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4448!$OMP SHARED(bo,v_drho,deriv_data,tau1,v_xc_tau,fac) COLLAPSE(3)
4449 DO k = bo(1, 3), bo(2, 3)
4450 DO j = bo(1, 2), bo(2, 2)
4451 DO i = bo(1, 1), bo(2, 1)
4452 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
4453 deriv_data(i, j, k)*tau1(i, j, k)
4454 END DO
4455 END DO
4456 END DO
4457 END IF
4458 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_laplace_rho])
4459 IF (ASSOCIATED(deriv_att)) THEN
4460 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4461!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4462!$OMP SHARED(bo,v_drho,deriv_data,laplace1,v_laplace,fac) COLLAPSE(3)
4463 DO k = bo(1, 3), bo(2, 3)
4464 DO j = bo(1, 2), bo(2, 2)
4465 DO i = bo(1, 1), bo(2, 1)
4466 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
4467 deriv_data(i, j, k)*laplace1(i, j, k)
4468 END DO
4469 END DO
4470 END DO
4471 END IF
4472
4473 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho])
4474 IF (ASSOCIATED(deriv_att)) THEN
4475 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4476 CALL xc_derivative_get(deriv_att, deriv_data=e_drho)
4477
4478 IF (my_compute_virial) THEN
4479 CALL virial_drho_drho1(virial_pw, drho, drho1, deriv_data, virial_xc)
4480 END IF ! my_compute_virial
4481
4482!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dr1dr,gradient_cut,norm_drho,v_drho,deriv_data)
4483 v_drho(1)%array(:, :, :) = v_drho(1)%array(:, :, :) + &
4484 deriv_data(:, :, :)*dr1dr(:, :, :)/max(gradient_cut, norm_drho(:, :, :))**2
4485!$OMP END PARALLEL WORKSHARE
4486 END IF
4487
4488 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau, deriv_rho])
4489 IF (ASSOCIATED(deriv_att)) THEN
4490 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4491!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4492!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1,v_xc,fac) COLLAPSE(3)
4493 DO k = bo(1, 3), bo(2, 3)
4494 DO j = bo(1, 2), bo(2, 2)
4495 DO i = bo(1, 1), bo(2, 1)
4496 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4497 deriv_data(i, j, k)*rho1(i, j, k)
4498 END DO
4499 END DO
4500 END DO
4501 END IF
4502 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau, deriv_norm_drho])
4503 IF (ASSOCIATED(deriv_att)) THEN
4504 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4505!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4506!$OMP SHARED(bo,v_xc_tau,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
4507 DO k = bo(1, 3), bo(2, 3)
4508 DO j = bo(1, 2), bo(2, 2)
4509 DO i = bo(1, 1), bo(2, 1)
4510 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4511 deriv_data(i, j, k)*dr1dr(i, j, k)
4512 END DO
4513 END DO
4514 END DO
4515 END IF
4516 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau, deriv_tau])
4517 IF (ASSOCIATED(deriv_att)) THEN
4518 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4519!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4520!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1,fac) COLLAPSE(3)
4521 DO k = bo(1, 3), bo(2, 3)
4522 DO j = bo(1, 2), bo(2, 2)
4523 DO i = bo(1, 1), bo(2, 1)
4524 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4525 deriv_data(i, j, k)*tau1(i, j, k)
4526 END DO
4527 END DO
4528 END DO
4529 END IF
4530 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau, deriv_laplace_rho])
4531 IF (ASSOCIATED(deriv_att)) THEN
4532 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4533!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4534!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1,v_laplace,fac) COLLAPSE(3)
4535 DO k = bo(1, 3), bo(2, 3)
4536 DO j = bo(1, 2), bo(2, 2)
4537 DO i = bo(1, 1), bo(2, 1)
4538 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4539 deriv_data(i, j, k)*laplace1(i, j, k)
4540 END DO
4541 END DO
4542 END DO
4543 END IF
4544
4545
4546 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rho, deriv_rho])
4547 IF (ASSOCIATED(deriv_att)) THEN
4548 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4549!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4550!$OMP SHARED(bo,v_laplace,deriv_data,rho1,v_xc,fac) COLLAPSE(3)
4551 DO k = bo(1, 3), bo(2, 3)
4552 DO j = bo(1, 2), bo(2, 2)
4553 DO i = bo(1, 1), bo(2, 1)
4554 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
4555 deriv_data(i, j, k)*rho1(i, j, k)
4556 END DO
4557 END DO
4558 END DO
4559 END IF
4560 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rho, deriv_norm_drho])
4561 IF (ASSOCIATED(deriv_att)) THEN
4562 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4563!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4564!$OMP SHARED(bo,v_laplace,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
4565 DO k = bo(1, 3), bo(2, 3)
4566 DO j = bo(1, 2), bo(2, 2)
4567 DO i = bo(1, 1), bo(2, 1)
4568 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
4569 deriv_data(i, j, k)*dr1dr(i, j, k)
4570 END DO
4571 END DO
4572 END DO
4573 END IF
4574 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rho, deriv_tau])
4575 IF (ASSOCIATED(deriv_att)) THEN
4576 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4577!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4578!$OMP SHARED(bo,v_laplace,deriv_data,tau1,v_xc_tau,fac) COLLAPSE(3)
4579 DO k = bo(1, 3), bo(2, 3)
4580 DO j = bo(1, 2), bo(2, 2)
4581 DO i = bo(1, 1), bo(2, 1)
4582 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
4583 deriv_data(i, j, k)*tau1(i, j, k)
4584 END DO
4585 END DO
4586 END DO
4587 END IF
4589 IF (ASSOCIATED(deriv_att)) THEN
4590 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4591!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4592!$OMP SHARED(bo,v_laplace,deriv_data,laplace1,fac) COLLAPSE(3)
4593 DO k = bo(1, 3), bo(2, 3)
4594 DO j = bo(1, 2), bo(2, 2)
4595 DO i = bo(1, 1), bo(2, 1)
4596 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
4597 deriv_data(i, j, k)*laplace1(i, j, k)
4598 END DO
4599 END DO
4600 END DO
4601 END IF
4602
4603
4604 IF (my_compute_virial) THEN
4605 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rho])
4606 IF (ASSOCIATED(deriv_att)) THEN
4607 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4608
4609 virial_pw%array(:, :, :) = -rho1(:, :, :)
4610 CALL virial_laplace(virial_pw, pw_pool, virial_xc, deriv_data)
4611 END IF
4612 END IF ! my_compute_virial
4613
4614
4615 IF (gradient_f) THEN
4616
4617 IF (my_compute_virial) THEN
4618 CALL virial_drho_drho(virial_pw, drho, v_drho(1), virial_xc)
4619 END IF ! my_compute_virial
4620
4621 IF (my_gapw) THEN
4622
4623 DO idir = 1, 3
4624!$OMP PARALLEL DO DEFAULT(NONE) &
4625!$OMP PRIVATE(ia,ir) &
4626!$OMP SHARED(bo,vxg,drho,v_drho,e_drho,drho1,idir,factor2) &
4627!$OMP COLLAPSE(2)
4628 DO ia = bo(1, 1), bo(2, 1)
4629 DO ir = bo(1, 2), bo(2, 2)
4630 vxg(idir, ia, ir, 1) = -drho(idir)%array(ia, ir, 1)*v_drho(1)%array(ia, ir, 1)
4631 IF (ASSOCIATED(e_drho)) THEN
4632 vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1) + factor2*drho1(idir)%array(ia, ir, 1)*e_drho(ia, ir, 1)
4633 END IF
4634 END DO
4635 END DO
4636!$OMP END PARALLEL DO
4637 END DO
4638
4639 ELSE
4640 ! partial integration
4641 DO idir = 1, 3
4642!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(v_drho_r,drho,v_drho,drho1,e_drho,idir)
4643 v_drho_r(idir, 1)%array(:, :, :) = drho(idir)%array(:, :, :)*v_drho(1)%array(:, :, :) - &
4644 drho1(idir)%array(:, :, :)*e_drho(:, :, :)
4645!$OMP END PARALLEL WORKSHARE
4646 END DO
4647
4648 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 1), tmp_g, vxc_g, v_xc(1))
4649 END IF
4650
4651 END IF
4652
4653 IF (laplace_f .AND. my_compute_virial) THEN
4654 virial_pw%array(:, :, :) = -rho(:, :, :)
4655 CALL virial_laplace(virial_pw, pw_pool, virial_xc, v_laplace(1)%array)
4656 END IF
4657
4658 END IF
4659
4660 IF (laplace_f) THEN
4661 DO ispin = 1, nspins
4662 CALL xc_pw_laplace(v_laplace(ispin), pw_pool, xc_deriv_method_id)
4663 CALL pw_axpy(v_laplace(ispin), v_xc(ispin))
4664 END DO
4665 END IF
4666
4667 IF (gradient_f) THEN
4668
4669 DO ispin = 1, nspins
4670 CALL deallocate_pw(v_drho(ispin), pw_pool)
4671 DO idir = 1, 3
4672 CALL deallocate_pw(v_drho_r(idir, ispin), pw_pool)
4673 END DO
4674 END DO
4675 DEALLOCATE (v_drho, v_drho_r)
4676
4677 END IF
4678
4679 IF (laplace_f) THEN
4680 DO ispin = 1, nspins
4681 CALL deallocate_pw(v_laplace(ispin), pw_pool)
4682 END DO
4683 DEALLOCATE (v_laplace)
4684 END IF
4685
4686 IF (ASSOCIATED(tmp_g%pw_grid) .AND. ASSOCIATED(pw_pool)) THEN
4687 CALL pw_pool%give_back_pw(tmp_g)
4688 END IF
4689
4690 IF (ASSOCIATED(vxc_g%pw_grid) .AND. ASSOCIATED(pw_pool)) THEN
4691 CALL pw_pool%give_back_pw(vxc_g)
4692 END IF
4693
4694 IF (my_compute_virial .AND. (gradient_f .OR. laplace_f)) THEN
4695 CALL deallocate_pw(virial_pw, pw_pool)
4696 END IF
4697
4698 CALL timestop(handle)
4699
4700 END SUBROUTINE xc_calc_2nd_deriv_analytical
4701
4702! **************************************************************************************************
4703!> \brief Calculates the third functional derivative of the exchange-correlation functional, E_xc.
4704!> Any GGA functional can be written as:
4705!>
4706!> E_xc[\rho] = \int e_xc(\rho,\nabla\rho)dr
4707!>
4708!> This routine gives you back the contraction of the derivatives of e_xc with respect to the
4709!> alpha or beta density or with respect to the norm of their gradients contracted with rho1.
4710!> For example, the alpha component would be (d stands for total derivative):
4711!>
4712!> d^3 e_xc
4713!> v_xc(1) = \sum_{s,s'}^{a,b} ---------------------\rhos1\rho1s'
4714!> d\rhoa d\rhos d\rhos'
4715!>
4716!> \param v_xc Third derivative of the exchange-correlation functional
4717!> \param v_xc_tau ...
4718!> \param deriv_set derivatives of the exchange-correlation potential, e_xc
4719!> \param rho_set object containing the density at which the derivatives were calculated, \rho
4720!> \param rho1_set object containing the density with which to fold, \rho1s
4721!> \param pw_pool the pool for the grids
4722!> \param xc_section XC parameters
4723!> \par History
4724!> * 07.2024 Created [LHS]
4725! **************************************************************************************************
4726 SUBROUTINE xc_calc_3rd_deriv_analytical(v_xc, v_xc_tau, deriv_set, rho_set, rho1_set, &
4727 pw_pool, xc_section, spinflip, gapw, vxg)
4728
4729 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_xc, v_xc_tau
4730 TYPE(xc_derivative_set_type) :: deriv_set
4731 TYPE(xc_rho_set_type), INTENT(IN) :: rho_set, rho1_set
4732 TYPE(pw_pool_type), POINTER :: pw_pool
4733 TYPE(section_vals_type), POINTER :: xc_section
4734 LOGICAL, INTENT(in), OPTIONAL :: spinflip
4735 LOGICAL, INTENT(IN), OPTIONAL :: gapw
4736 REAL(kind=dp), DIMENSION(:, :, :, :), OPTIONAL, POINTER :: vxg
4737
4738 CHARACTER(len=*), PARAMETER :: routinen = 'xc_calc_3rd_deriv_analytical'
4739
4740 INTEGER :: handle, i, idir, ispin, j, &
4741 k, nspins, xc_deriv_method_id
4742 INTEGER, DIMENSION(2, 3) :: bo
4743 LOGICAL :: my_gapw
4744 LOGICAL :: lsd, do_spinflip, alda0, &
4745 rho_f, gradient_f, tau_f, laplace_f
4746 REAL(kind=dp) :: s, s_thresh, s_thresh2, gradient_cut
4747 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: dr1dr, dra1dra, drb1drb, dr1dr1
4748 REAL(kind=dp) :: g1, g11, uu, aa, bb
4749 ! restricted meta-GGA (gamma formulation)
4750 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), TARGET :: zero_f
4751 TYPE(pw_r3d_rs_type), DIMENSION(:), ALLOCATABLE :: v_laplace
4752 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: tau1, laplace1
4753 ! open-shell meta-GGA
4754 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: tau1a, tau1b, laplace1a, laplace1b
4755 REAL(kind=dp) :: mp_rhoa, q_rhoa
4756 REAL(kind=dp) :: mp_rhob, q_rhob
4757 REAL(kind=dp) :: mp_gamma_aa, q_gamma_aa
4758 REAL(kind=dp) :: mp_gamma_ab, q_gamma_ab
4759 REAL(kind=dp) :: mp_gamma_bb, q_gamma_bb
4760 REAL(kind=dp) :: mp_laplace_rhoa, q_laplace_rhoa
4761 REAL(kind=dp) :: mp_laplace_rhob, q_laplace_rhob
4762 REAL(kind=dp) :: mp_tau_a, q_tau_a
4763 REAL(kind=dp) :: mp_tau_b, q_tau_b
4764 REAL(kind=dp) :: mpp_gamma_aa, nb_gamma_aa
4765 REAL(kind=dp) :: mpp_gamma_ab, nb_gamma_ab
4766 REAL(kind=dp) :: mpp_gamma_bb, nb_gamma_bb
4767 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa
4768 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob
4769 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa
4770 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab
4771 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_bb
4772 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhoa
4773 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhob
4774 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_tau_a
4775 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_tau_b
4776 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob
4777 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa
4778 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab
4779 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_bb
4780 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhoa
4781 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhob
4782 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_tau_a
4783 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_tau_b
4784 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa
4785 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab
4786 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_bb
4787 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhoa
4788 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhob
4789 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_tau_a
4790 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_tau_b
4791 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab
4792 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_bb
4793 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhoa
4794 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhob
4795 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_tau_a
4796 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_tau_b
4797 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_gamma_bb
4798 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhoa
4799 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhob
4800 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_tau_a
4801 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_tau_b
4802 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhoa
4803 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhob
4804 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_tau_a
4805 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_tau_b
4806 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_laplace_rhob
4807 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_tau_a
4808 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_tau_b
4809 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_a_tau_a
4810 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_a_tau_b
4811 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_b_tau_b
4812 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_rhoa
4813 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_rhob
4814 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_gamma_aa
4815 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_gamma_ab
4816 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_gamma_bb
4817 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_laplace_rhoa
4818 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_laplace_rhob
4819 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_tau_a
4820 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_tau_b
4821 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_rhob
4822 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_gamma_aa
4823 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_gamma_ab
4824 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_gamma_bb
4825 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_laplace_rhoa
4826 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_laplace_rhob
4827 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_tau_a
4828 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_tau_b
4829 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_gamma_aa
4830 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_gamma_ab
4831 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_gamma_bb
4832 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_laplace_rhoa
4833 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_laplace_rhob
4834 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_tau_a
4835 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_tau_b
4836 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab_gamma_ab
4837 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab_gamma_bb
4838 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab_laplace_rhoa
4839 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab_laplace_rhob
4840 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab_tau_a
4841 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab_tau_b
4842 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_bb_gamma_bb
4843 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_bb_laplace_rhoa
4844 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_bb_laplace_rhob
4845 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_bb_tau_a
4846 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_bb_tau_b
4847 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhoa_laplace_rhoa
4848 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhoa_laplace_rhob
4849 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhoa_tau_a
4850 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhoa_tau_b
4851 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhob_laplace_rhob
4852 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhob_tau_a
4853 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhob_tau_b
4854 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_tau_a_tau_a
4855 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_tau_a_tau_b
4856 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_tau_b_tau_b
4857 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_rhob
4858 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_gamma_aa
4859 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_gamma_ab
4860 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_gamma_bb
4861 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_laplace_rhoa
4862 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_laplace_rhob
4863 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_tau_a
4864 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_tau_b
4865 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_gamma_aa
4866 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_gamma_ab
4867 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_gamma_bb
4868 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_laplace_rhoa
4869 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_laplace_rhob
4870 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_tau_a
4871 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_tau_b
4872 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab_gamma_ab
4873 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab_gamma_bb
4874 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab_laplace_rhoa
4875 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab_laplace_rhob
4876 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab_tau_a
4877 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab_tau_b
4878 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_bb_gamma_bb
4879 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_bb_laplace_rhoa
4880 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_bb_laplace_rhob
4881 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_bb_tau_a
4882 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_bb_tau_b
4883 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhoa_laplace_rhoa
4884 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhoa_laplace_rhob
4885 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhoa_tau_a
4886 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhoa_tau_b
4887 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhob_laplace_rhob
4888 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhob_tau_a
4889 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhob_tau_b
4890 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_tau_a_tau_a
4891 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_tau_a_tau_b
4892 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_tau_b_tau_b
4893 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_gamma_aa
4894 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_gamma_ab
4895 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_gamma_bb
4896 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_laplace_rhoa
4897 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_laplace_rhob
4898 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_tau_a
4899 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_tau_b
4900 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab_gamma_ab
4901 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab_gamma_bb
4902 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab_laplace_rhoa
4903 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab_laplace_rhob
4904 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab_tau_a
4905 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab_tau_b
4906 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_bb_gamma_bb
4907 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_bb_laplace_rhoa
4908 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_bb_laplace_rhob
4909 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_bb_tau_a
4910 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_bb_tau_b
4911 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhoa_laplace_rhoa
4912 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhoa_laplace_rhob
4913 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhoa_tau_a
4914 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhoa_tau_b
4915 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhob_laplace_rhob
4916 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhob_tau_a
4917 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhob_tau_b
4918 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_tau_a_tau_a
4919 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_tau_a_tau_b
4920 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_tau_b_tau_b
4921 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab_gamma_ab
4922 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab_gamma_bb
4923 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab_laplace_rhoa
4924 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab_laplace_rhob
4925 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab_tau_a
4926 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab_tau_b
4927 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_bb_gamma_bb
4928 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_bb_laplace_rhoa
4929 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_bb_laplace_rhob
4930 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_bb_tau_a
4931 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_bb_tau_b
4932 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhoa_laplace_rhoa
4933 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhoa_laplace_rhob
4934 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhoa_tau_a
4935 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhoa_tau_b
4936 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhob_laplace_rhob
4937 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhob_tau_a
4938 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhob_tau_b
4939 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_tau_a_tau_a
4940 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_tau_a_tau_b
4941 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_tau_b_tau_b
4942 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_gamma_bb_gamma_bb
4943 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_gamma_bb_laplace_rhoa
4944 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_gamma_bb_laplace_rhob
4945 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_gamma_bb_tau_a
4946 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_gamma_bb_tau_b
4947 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhoa_laplace_rhoa
4948 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhoa_laplace_rhob
4949 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhoa_tau_a
4950 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhoa_tau_b
4951 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhob_laplace_rhob
4952 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhob_tau_a
4953 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhob_tau_b
4954 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_tau_a_tau_a
4955 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_tau_a_tau_b
4956 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_tau_b_tau_b
4957 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhoa_laplace_rhoa
4958 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhoa_laplace_rhob
4959 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhoa_tau_a
4960 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhoa_tau_b
4961 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhob_laplace_rhob
4962 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhob_tau_a
4963 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhob_tau_b
4964 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_tau_a_tau_a
4965 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_tau_a_tau_b
4966 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_tau_b_tau_b
4967 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_laplace_rhob_laplace_rhob
4968 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_laplace_rhob_tau_a
4969 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_laplace_rhob_tau_b
4970 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_tau_a_tau_a
4971 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_tau_a_tau_b
4972 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_tau_b_tau_b
4973 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_a_tau_a_tau_a
4974 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_a_tau_a_tau_b
4975 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_a_tau_b_tau_b
4976 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_b_tau_b_tau_b
4977 REAL(kind=dp) :: mp_rho, mp_gamma, mp_laplace_rho, mp_tau, mpp_gamma
4978 REAL(kind=dp) :: m_rho, m_gamma, m_laplace_rho, m_tau, m_b
4979 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_rho
4980 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_gamma
4981 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_laplace_rho
4982 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_tau
4983 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_gamma
4984 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_laplace_rho
4985 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_tau
4986 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_laplace_rho_laplace_rho
4987 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_laplace_rho_tau
4988 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_tau_tau
4989 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_rho_rho
4990 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_rho_gamma
4991 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_rho_laplace_rho
4992 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_rho_tau
4993 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_gamma_gamma
4994 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_gamma_laplace_rho
4995 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_gamma_tau
4996 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_laplace_rho_laplace_rho
4997 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_laplace_rho_tau
4998 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_tau_tau
4999 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_gamma_gamma
5000 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_gamma_laplace_rho
5001 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_gamma_tau
5002 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_laplace_rho_laplace_rho
5003 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_laplace_rho_tau
5004 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_tau_tau
5005 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_laplace_rho_laplace_rho_laplace_rho
5006 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_laplace_rho_laplace_rho_tau
5007 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_laplace_rho_tau_tau
5008 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_tau_tau_tau
5009 ! open-shell gamma formulation
5010 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: gaa1, gab1, gbb1, gaa11, gab11, gbb11
5011 REAL(kind=dp) :: p_rhoa, p_rhob, p_gamma_aa, p_gamma_ab, p_gamma_bb
5012 REAL(kind=dp) :: pp_gamma_aa, pp_gamma_ab, pp_gamma_bb
5013 REAL(kind=dp) :: u_a, u_b, a_gamma_aa, a_gamma_ab, a_gamma_bb, &
5014 b_gamma_aa, b_gamma_ab, b_gamma_bb
5015 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhoa
5016 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhob
5017 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_aa
5018 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_ab
5019 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_bb
5020 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_rhob
5021 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_aa
5022 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_ab
5023 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_bb
5024 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_aa
5025 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_ab
5026 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_bb
5027 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_ab_gamma_ab
5028 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_ab_gamma_bb
5029 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_bb_gamma_bb
5030 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhoa_rhoa
5031 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhoa_rhob
5032 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhoa_gamma_aa
5033 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhoa_gamma_ab
5034 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhoa_gamma_bb
5035 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhob_rhob
5036 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhob_gamma_aa
5037 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhob_gamma_ab
5038 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhob_gamma_bb
5039 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_aa_gamma_aa
5040 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_aa_gamma_ab
5041 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_aa_gamma_bb
5042 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_ab_gamma_ab
5043 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_ab_gamma_bb
5044 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_bb_gamma_bb
5045 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_rhob_rhob
5046 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_rhob_gamma_aa
5047 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_rhob_gamma_ab
5048 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_rhob_gamma_bb
5049 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_aa_gamma_aa
5050 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_aa_gamma_ab
5051 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_aa_gamma_bb
5052 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_ab_gamma_ab
5053 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_ab_gamma_bb
5054 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_bb_gamma_bb
5055 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_aa_gamma_aa
5056 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_aa_gamma_ab
5057 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_aa_gamma_bb
5058 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_ab_gamma_ab
5059 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_ab_gamma_bb
5060 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_bb_gamma_bb
5061 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_ab_gamma_ab_gamma_ab
5062 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_ab_gamma_ab_gamma_bb
5063 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_ab_gamma_bb_gamma_bb
5064 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_bb_gamma_bb_gamma_bb
5065 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data, deriv_data2, e_drhoa, e_drhob, &
5066 e_drho, norm_drho, norm_drhoa, &
5067 norm_drhob, rho1a, rho1b, &
5068 rhoa, rhob, rho1, &
5069 e_rrr, e_rrg, e_rgg, e_ggg, e_rg, e_gg
5070 TYPE(cp_3d_r_cp_type), DIMENSION(3) :: drho, drho1, drho1a, drho1b, drhoa, drhob
5071 TYPE(pw_r3d_rs_type), DIMENSION(:), ALLOCATABLE :: v_drhoa, v_drhob, v_drho
5072 TYPE(pw_r3d_rs_type), DIMENSION(:, :), ALLOCATABLE :: v_drho_r
5073 TYPE(pw_c1d_gs_type) :: tmp_g, vxc_g
5074 TYPE(xc_derivative_type), POINTER :: deriv_att
5075
5076 CALL timeset(routinen, handle)
5077
5078 NULLIFY (e_drhoa, e_drhob, e_drho)
5079
5080 cpassert(ASSOCIATED(v_xc))
5081 cpassert(ASSOCIATED(xc_section))
5082
5083 ! Initialize parameters
5084 CALL section_vals_val_get(xc_section, "XC_GRID%XC_DERIV", &
5085 i_val=xc_deriv_method_id)
5086 !
5087 nspins = SIZE(v_xc)
5088 lsd = ASSOCIATED(rho_set%rhoa)
5089 !
5090 do_spinflip = .false.
5091 IF (PRESENT(spinflip)) do_spinflip = spinflip
5092 my_gapw = .false.
5093 IF (PRESENT(gapw)) my_gapw = gapw
5094 IF (my_gapw) THEN
5095 cpassert(PRESENT(vxg))
5096 ! the atomic path integrates the gradient channel itself, and CP2K does
5097 ! not support Laplacian-dependent functionals in GAPW at all
5098 IF (laplace_f) cpabort("Laplace-dependent functional not implemented with GAPW!")
5099 END IF
5100 !
5101 bo = rho_set%local_bounds
5102 !
5103 CALL check_for_derivatives(deriv_set, lsd, rho_f, gradient_f, tau_f, laplace_f)
5104 !
5105 CALL xc_rho_set_get(rho_set, drho_cutoff=gradient_cut)
5106 !
5107 !S_THRESH has to be the same as S_THRESH in xc_calc_2nd_deriv_analytical
5108 alda0 = .false.
5109 s_thresh = 1.0e-04
5110 s_thresh2 = 1.0e-07
5111
5112 ! Initialize potential
5113 DO ispin = 1, nspins
5114 !CALL pw_zero(v_xc(ispin))
5115 v_xc(ispin)%array = 0.0_dp
5116 END DO
5117
5118 ! Create GGA fields
5119 IF (gradient_f) THEN
5120 ALLOCATE (v_drho_r(3, nspins), v_drho(nspins))
5121 DO ispin = 1, nspins
5122 DO idir = 1, 3
5123 CALL allocate_pw(v_drho_r(idir, ispin), pw_pool, bo)
5124 END DO
5125 CALL allocate_pw(v_drho(ispin), pw_pool, bo)
5126 END DO
5127
5128 IF (xc_requires_tmp_g(xc_deriv_method_id)) THEN
5129 IF (ASSOCIATED(pw_pool)) THEN
5130 CALL pw_pool%create_pw(tmp_g)
5131 CALL pw_pool%create_pw(vxc_g)
5132 ELSE
5133 ! remember to refix for gapw
5134 cpabort("XC_DERIV method is not implemented in GAPW")
5135 END IF
5136 END IF
5137
5138 END IF
5139
5140 ! Initialize mGGA potential
5141 IF (tau_f) THEN
5142 cpassert(ASSOCIATED(v_xc_tau))
5143 DO ispin = 1, nspins
5144 v_xc_tau(ispin)%array = 0.0_dp
5145 END DO
5146 END IF
5147
5148 IF (lsd) THEN
5149
5150 !-------------------!
5151 ! UNrestricted case !
5152 !-------------------!
5153
5154 IF (do_spinflip) THEN
5155 CALL xc_rho_set_get(rho1_set, rhoa=rho1a)
5156 CALL xc_rho_set_get(rho_set, rhoa=rhoa, rhob=rhob)
5157 ELSE
5158 CALL xc_rho_set_get(rho1_set, rhoa=rho1a, rhob=rho1b)
5159 END IF
5160
5161 IF (gradient_f) THEN
5162 CALL xc_rho_set_get(rho_set, drhoa=drhoa, drhob=drhob, &
5163 norm_drho=norm_drho, norm_drhoa=norm_drhoa, norm_drhob=norm_drhob)
5164 IF (do_spinflip) THEN
5165 CALL xc_rho_set_get(rho1_set, drhoa=drho1a)
5166 CALL calc_drho_from_a(drho1, drho1a)
5167 ELSE
5168 CALL xc_rho_set_get(rho1_set, drhoa=drho1a, drhob=drho1b)
5169 CALL calc_drho_from_ab(drho1, drho1a, drho1b)
5170 END IF
5171
5172 CALL calc_drho_from_ab(drho, drhoa, drhob)
5173
5174 CALL prepare_dr1dr(dra1dra, drhoa, drho1a)
5175 IF (do_spinflip) THEN
5176 CALL prepare_dr1dr(drb1drb, drhob, drho1a)
5177 CALL prepare_dr1dr(dr1dr, drho, drho1a)
5178 ELSE IF (nspins /= 1) THEN
5179 CALL prepare_dr1dr(drb1drb, drhob, drho1b)
5180 CALL prepare_dr1dr(dr1dr, drho, drho1)
5181 ELSE
5182 cpabort("Exchange-correlation's third derivative for closed-shell not yet implemented")
5183 END IF
5184
5185 ! Create vectors for partial integration term
5186 ALLOCATE (v_drhoa(nspins), v_drhob(nspins))
5187 DO ispin = 1, nspins
5188 CALL allocate_pw(v_drhoa(ispin), pw_pool, bo)
5189 CALL allocate_pw(v_drhob(ispin), pw_pool, bo)
5190 END DO
5191
5192 END IF
5193
5194 ! The gamma formulation below covers tau and the Laplacian for the
5195 ! ordinary unrestricted case; the spin-flip kernel and the closed-shell
5196 ! triplet path are still LDA/GGA only.
5197 IF (laplace_f .AND. (do_spinflip .OR. nspins == 1)) THEN
5198 cpabort("Exchange-correlation's laplace analytic third derivative not implemented")
5199 END IF
5200
5201 IF (tau_f .AND. (do_spinflip .OR. nspins == 1)) THEN
5202 cpabort("Exchange-correlation's mGGA analytic third derivative not implemented")
5203 END IF
5204
5205 IF (nspins /= 1) THEN
5206
5207 IF (.NOT. do_spinflip) THEN
5208
5209 ! Spin-polarized third derivative in the reduced-gradient variables
5210 ! gamma_ij = grad rho_i . grad rho_j, contracted twice with rho1:
5211 !
5212 ! u_s = sum_XY e_{rho_s X Y} X1 Y1 + sum_K e_{rho_s gK} gK11
5213 ! A_K = sum_XY e_{gK X Y} X1 Y1 + sum_L e_{gK gL} gL11
5214 ! B_K = sum_Y e_{gK Y} Y1
5215 ! v_a = 2 grad rhoa A_aa + grad rhob A_ab
5216 ! + 2 ( 2 grad rho1a B_aa + grad rho1b B_ab )
5217 !
5218 ! and g_xc,s = u_s - div(v_s). X, Y run over rhoa, rhob and the three
5219 ! gammas. Nothing here divides by |grad rho|.
5220
5221 IF (tau_f .OR. laplace_f) THEN
5222
5223 ! Spin-polarized meta-GGA. The same gamma formulation, with the
5224 ! variable set widened to nine: rhoa, rhob, the three gammas,
5225 ! the two Laplacians and the two taus. Only gamma is nonlinear
5226 ! in the density, so only it carries a second variation.
5227
5228 CALL xc_rho_set_get(rho_set, drhoa=drhoa, drhob=drhob)
5229 CALL xc_rho_set_get(rho1_set, drhoa=drho1a, drhob=drho1b)
5230 IF (tau_f) CALL xc_rho_set_get(rho1_set, tau_a=tau1a, tau_b=tau1b)
5231 IF (laplace_f) CALL xc_rho_set_get(rho1_set, laplace_rhoa=laplace1a, &
5232 laplace_rhob=laplace1b)
5233 CALL prepare_dr1dr(gaa1, drhoa, drho1a)
5234 CALL prepare_dr1dr(gbb1, drhob, drho1b)
5235 CALL prepare_dr1dr(gab1, drhoa, drho1b)
5236 CALL prepare_dr1dr(gaa11, drho1a, drho1a)
5237 CALL prepare_dr1dr(gbb11, drho1b, drho1b)
5238 CALL prepare_dr1dr(gab11, drho1a, drho1b)
5239 block
5240 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: tmp_ba
5241 CALL prepare_dr1dr(tmp_ba, drhob, drho1a)
5242 gab1(:, :, :) = gab1(:, :, :) + tmp_ba(:, :, :)
5243 END block
5244
5245 ALLOCATE (zero_f(bo(1, 1):bo(2, 1), bo(1, 2):bo(2, 2), bo(1, 3):bo(2, 3)))
5246 zero_f = 0.0_dp
5247 deriv_att => xc_dset_get_derivative(deriv_set, &
5249 IF (ASSOCIATED(deriv_att)) THEN
5250 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa)
5251 ELSE
5252 n_rhoa_rhoa => zero_f
5253 END IF
5254 deriv_att => xc_dset_get_derivative(deriv_set, &
5256 IF (ASSOCIATED(deriv_att)) THEN
5257 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob)
5258 ELSE
5259 n_rhoa_rhob => zero_f
5260 END IF
5261 deriv_att => xc_dset_get_derivative(deriv_set, &
5263 IF (ASSOCIATED(deriv_att)) THEN
5264 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa)
5265 ELSE
5266 n_rhoa_gamma_aa => zero_f
5267 END IF
5268 deriv_att => xc_dset_get_derivative(deriv_set, &
5270 IF (ASSOCIATED(deriv_att)) THEN
5271 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab)
5272 ELSE
5273 n_rhoa_gamma_ab => zero_f
5274 END IF
5275 deriv_att => xc_dset_get_derivative(deriv_set, &
5277 IF (ASSOCIATED(deriv_att)) THEN
5278 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_bb)
5279 ELSE
5280 n_rhoa_gamma_bb => zero_f
5281 END IF
5282 deriv_att => xc_dset_get_derivative(deriv_set, &
5284 IF (ASSOCIATED(deriv_att)) THEN
5285 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhoa)
5286 ELSE
5287 n_rhoa_laplace_rhoa => zero_f
5288 END IF
5289 deriv_att => xc_dset_get_derivative(deriv_set, &
5291 IF (ASSOCIATED(deriv_att)) THEN
5292 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhob)
5293 ELSE
5294 n_rhoa_laplace_rhob => zero_f
5295 END IF
5296 deriv_att => xc_dset_get_derivative(deriv_set, &
5298 IF (ASSOCIATED(deriv_att)) THEN
5299 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_tau_a)
5300 ELSE
5301 n_rhoa_tau_a => zero_f
5302 END IF
5303 deriv_att => xc_dset_get_derivative(deriv_set, &
5305 IF (ASSOCIATED(deriv_att)) THEN
5306 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_tau_b)
5307 ELSE
5308 n_rhoa_tau_b => zero_f
5309 END IF
5310 deriv_att => xc_dset_get_derivative(deriv_set, &
5312 IF (ASSOCIATED(deriv_att)) THEN
5313 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob)
5314 ELSE
5315 n_rhob_rhob => zero_f
5316 END IF
5317 deriv_att => xc_dset_get_derivative(deriv_set, &
5319 IF (ASSOCIATED(deriv_att)) THEN
5320 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa)
5321 ELSE
5322 n_rhob_gamma_aa => zero_f
5323 END IF
5324 deriv_att => xc_dset_get_derivative(deriv_set, &
5326 IF (ASSOCIATED(deriv_att)) THEN
5327 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab)
5328 ELSE
5329 n_rhob_gamma_ab => zero_f
5330 END IF
5331 deriv_att => xc_dset_get_derivative(deriv_set, &
5333 IF (ASSOCIATED(deriv_att)) THEN
5334 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_bb)
5335 ELSE
5336 n_rhob_gamma_bb => zero_f
5337 END IF
5338 deriv_att => xc_dset_get_derivative(deriv_set, &
5340 IF (ASSOCIATED(deriv_att)) THEN
5341 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhoa)
5342 ELSE
5343 n_rhob_laplace_rhoa => zero_f
5344 END IF
5345 deriv_att => xc_dset_get_derivative(deriv_set, &
5347 IF (ASSOCIATED(deriv_att)) THEN
5348 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhob)
5349 ELSE
5350 n_rhob_laplace_rhob => zero_f
5351 END IF
5352 deriv_att => xc_dset_get_derivative(deriv_set, &
5354 IF (ASSOCIATED(deriv_att)) THEN
5355 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_tau_a)
5356 ELSE
5357 n_rhob_tau_a => zero_f
5358 END IF
5359 deriv_att => xc_dset_get_derivative(deriv_set, &
5361 IF (ASSOCIATED(deriv_att)) THEN
5362 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_tau_b)
5363 ELSE
5364 n_rhob_tau_b => zero_f
5365 END IF
5366 deriv_att => xc_dset_get_derivative(deriv_set, &
5368 IF (ASSOCIATED(deriv_att)) THEN
5369 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa)
5370 ELSE
5371 n_gamma_aa_gamma_aa => zero_f
5372 END IF
5373 deriv_att => xc_dset_get_derivative(deriv_set, &
5375 IF (ASSOCIATED(deriv_att)) THEN
5376 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab)
5377 ELSE
5378 n_gamma_aa_gamma_ab => zero_f
5379 END IF
5380 deriv_att => xc_dset_get_derivative(deriv_set, &
5382 IF (ASSOCIATED(deriv_att)) THEN
5383 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_bb)
5384 ELSE
5385 n_gamma_aa_gamma_bb => zero_f
5386 END IF
5387 deriv_att => xc_dset_get_derivative(deriv_set, &
5389 IF (ASSOCIATED(deriv_att)) THEN
5390 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhoa)
5391 ELSE
5392 n_gamma_aa_laplace_rhoa => zero_f
5393 END IF
5394 deriv_att => xc_dset_get_derivative(deriv_set, &
5396 IF (ASSOCIATED(deriv_att)) THEN
5397 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhob)
5398 ELSE
5399 n_gamma_aa_laplace_rhob => zero_f
5400 END IF
5401 deriv_att => xc_dset_get_derivative(deriv_set, &
5403 IF (ASSOCIATED(deriv_att)) THEN
5404 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_tau_a)
5405 ELSE
5406 n_gamma_aa_tau_a => zero_f
5407 END IF
5408 deriv_att => xc_dset_get_derivative(deriv_set, &
5410 IF (ASSOCIATED(deriv_att)) THEN
5411 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_tau_b)
5412 ELSE
5413 n_gamma_aa_tau_b => zero_f
5414 END IF
5415 deriv_att => xc_dset_get_derivative(deriv_set, &
5417 IF (ASSOCIATED(deriv_att)) THEN
5418 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab)
5419 ELSE
5420 n_gamma_ab_gamma_ab => zero_f
5421 END IF
5422 deriv_att => xc_dset_get_derivative(deriv_set, &
5424 IF (ASSOCIATED(deriv_att)) THEN
5425 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_bb)
5426 ELSE
5427 n_gamma_ab_gamma_bb => zero_f
5428 END IF
5429 deriv_att => xc_dset_get_derivative(deriv_set, &
5431 IF (ASSOCIATED(deriv_att)) THEN
5432 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhoa)
5433 ELSE
5434 n_gamma_ab_laplace_rhoa => zero_f
5435 END IF
5436 deriv_att => xc_dset_get_derivative(deriv_set, &
5438 IF (ASSOCIATED(deriv_att)) THEN
5439 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhob)
5440 ELSE
5441 n_gamma_ab_laplace_rhob => zero_f
5442 END IF
5443 deriv_att => xc_dset_get_derivative(deriv_set, &
5445 IF (ASSOCIATED(deriv_att)) THEN
5446 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_tau_a)
5447 ELSE
5448 n_gamma_ab_tau_a => zero_f
5449 END IF
5450 deriv_att => xc_dset_get_derivative(deriv_set, &
5452 IF (ASSOCIATED(deriv_att)) THEN
5453 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_tau_b)
5454 ELSE
5455 n_gamma_ab_tau_b => zero_f
5456 END IF
5457 deriv_att => xc_dset_get_derivative(deriv_set, &
5459 IF (ASSOCIATED(deriv_att)) THEN
5460 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_gamma_bb)
5461 ELSE
5462 n_gamma_bb_gamma_bb => zero_f
5463 END IF
5464 deriv_att => xc_dset_get_derivative(deriv_set, &
5466 IF (ASSOCIATED(deriv_att)) THEN
5467 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhoa)
5468 ELSE
5469 n_gamma_bb_laplace_rhoa => zero_f
5470 END IF
5471 deriv_att => xc_dset_get_derivative(deriv_set, &
5473 IF (ASSOCIATED(deriv_att)) THEN
5474 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhob)
5475 ELSE
5476 n_gamma_bb_laplace_rhob => zero_f
5477 END IF
5478 deriv_att => xc_dset_get_derivative(deriv_set, &
5480 IF (ASSOCIATED(deriv_att)) THEN
5481 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_tau_a)
5482 ELSE
5483 n_gamma_bb_tau_a => zero_f
5484 END IF
5485 deriv_att => xc_dset_get_derivative(deriv_set, &
5487 IF (ASSOCIATED(deriv_att)) THEN
5488 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_tau_b)
5489 ELSE
5490 n_gamma_bb_tau_b => zero_f
5491 END IF
5492 deriv_att => xc_dset_get_derivative(deriv_set, &
5494 IF (ASSOCIATED(deriv_att)) THEN
5495 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhoa)
5496 ELSE
5497 n_laplace_rhoa_laplace_rhoa => zero_f
5498 END IF
5499 deriv_att => xc_dset_get_derivative(deriv_set, &
5501 IF (ASSOCIATED(deriv_att)) THEN
5502 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhob)
5503 ELSE
5504 n_laplace_rhoa_laplace_rhob => zero_f
5505 END IF
5506 deriv_att => xc_dset_get_derivative(deriv_set, &
5508 IF (ASSOCIATED(deriv_att)) THEN
5509 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_tau_a)
5510 ELSE
5511 n_laplace_rhoa_tau_a => zero_f
5512 END IF
5513 deriv_att => xc_dset_get_derivative(deriv_set, &
5515 IF (ASSOCIATED(deriv_att)) THEN
5516 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_tau_b)
5517 ELSE
5518 n_laplace_rhoa_tau_b => zero_f
5519 END IF
5520 deriv_att => xc_dset_get_derivative(deriv_set, &
5522 IF (ASSOCIATED(deriv_att)) THEN
5523 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_laplace_rhob)
5524 ELSE
5525 n_laplace_rhob_laplace_rhob => zero_f
5526 END IF
5527 deriv_att => xc_dset_get_derivative(deriv_set, &
5529 IF (ASSOCIATED(deriv_att)) THEN
5530 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_tau_a)
5531 ELSE
5532 n_laplace_rhob_tau_a => zero_f
5533 END IF
5534 deriv_att => xc_dset_get_derivative(deriv_set, &
5536 IF (ASSOCIATED(deriv_att)) THEN
5537 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_tau_b)
5538 ELSE
5539 n_laplace_rhob_tau_b => zero_f
5540 END IF
5541 deriv_att => xc_dset_get_derivative(deriv_set, &
5543 IF (ASSOCIATED(deriv_att)) THEN
5544 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_a_tau_a)
5545 ELSE
5546 n_tau_a_tau_a => zero_f
5547 END IF
5548 deriv_att => xc_dset_get_derivative(deriv_set, &
5550 IF (ASSOCIATED(deriv_att)) THEN
5551 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_a_tau_b)
5552 ELSE
5553 n_tau_a_tau_b => zero_f
5554 END IF
5555 deriv_att => xc_dset_get_derivative(deriv_set, &
5557 IF (ASSOCIATED(deriv_att)) THEN
5558 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_b_tau_b)
5559 ELSE
5560 n_tau_b_tau_b => zero_f
5561 END IF
5562 deriv_att => xc_dset_get_derivative(deriv_set, &
5564 IF (ASSOCIATED(deriv_att)) THEN
5565 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_rhoa)
5566 ELSE
5567 n_rhoa_rhoa_rhoa => zero_f
5568 END IF
5569 deriv_att => xc_dset_get_derivative(deriv_set, &
5571 IF (ASSOCIATED(deriv_att)) THEN
5572 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_rhob)
5573 ELSE
5574 n_rhoa_rhoa_rhob => zero_f
5575 END IF
5576 deriv_att => xc_dset_get_derivative(deriv_set, &
5578 IF (ASSOCIATED(deriv_att)) THEN
5579 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_gamma_aa)
5580 ELSE
5581 n_rhoa_rhoa_gamma_aa => zero_f
5582 END IF
5583 deriv_att => xc_dset_get_derivative(deriv_set, &
5585 IF (ASSOCIATED(deriv_att)) THEN
5586 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_gamma_ab)
5587 ELSE
5588 n_rhoa_rhoa_gamma_ab => zero_f
5589 END IF
5590 deriv_att => xc_dset_get_derivative(deriv_set, &
5592 IF (ASSOCIATED(deriv_att)) THEN
5593 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_gamma_bb)
5594 ELSE
5595 n_rhoa_rhoa_gamma_bb => zero_f
5596 END IF
5597 deriv_att => xc_dset_get_derivative(deriv_set, &
5599 IF (ASSOCIATED(deriv_att)) THEN
5600 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_laplace_rhoa)
5601 ELSE
5602 n_rhoa_rhoa_laplace_rhoa => zero_f
5603 END IF
5604 deriv_att => xc_dset_get_derivative(deriv_set, &
5606 IF (ASSOCIATED(deriv_att)) THEN
5607 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_laplace_rhob)
5608 ELSE
5609 n_rhoa_rhoa_laplace_rhob => zero_f
5610 END IF
5611 deriv_att => xc_dset_get_derivative(deriv_set, &
5613 IF (ASSOCIATED(deriv_att)) THEN
5614 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_tau_a)
5615 ELSE
5616 n_rhoa_rhoa_tau_a => zero_f
5617 END IF
5618 deriv_att => xc_dset_get_derivative(deriv_set, &
5620 IF (ASSOCIATED(deriv_att)) THEN
5621 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_tau_b)
5622 ELSE
5623 n_rhoa_rhoa_tau_b => zero_f
5624 END IF
5625 deriv_att => xc_dset_get_derivative(deriv_set, &
5627 IF (ASSOCIATED(deriv_att)) THEN
5628 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_rhob)
5629 ELSE
5630 n_rhoa_rhob_rhob => zero_f
5631 END IF
5632 deriv_att => xc_dset_get_derivative(deriv_set, &
5634 IF (ASSOCIATED(deriv_att)) THEN
5635 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_gamma_aa)
5636 ELSE
5637 n_rhoa_rhob_gamma_aa => zero_f
5638 END IF
5639 deriv_att => xc_dset_get_derivative(deriv_set, &
5641 IF (ASSOCIATED(deriv_att)) THEN
5642 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_gamma_ab)
5643 ELSE
5644 n_rhoa_rhob_gamma_ab => zero_f
5645 END IF
5646 deriv_att => xc_dset_get_derivative(deriv_set, &
5648 IF (ASSOCIATED(deriv_att)) THEN
5649 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_gamma_bb)
5650 ELSE
5651 n_rhoa_rhob_gamma_bb => zero_f
5652 END IF
5653 deriv_att => xc_dset_get_derivative(deriv_set, &
5655 IF (ASSOCIATED(deriv_att)) THEN
5656 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_laplace_rhoa)
5657 ELSE
5658 n_rhoa_rhob_laplace_rhoa => zero_f
5659 END IF
5660 deriv_att => xc_dset_get_derivative(deriv_set, &
5662 IF (ASSOCIATED(deriv_att)) THEN
5663 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_laplace_rhob)
5664 ELSE
5665 n_rhoa_rhob_laplace_rhob => zero_f
5666 END IF
5667 deriv_att => xc_dset_get_derivative(deriv_set, &
5669 IF (ASSOCIATED(deriv_att)) THEN
5670 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_tau_a)
5671 ELSE
5672 n_rhoa_rhob_tau_a => zero_f
5673 END IF
5674 deriv_att => xc_dset_get_derivative(deriv_set, &
5676 IF (ASSOCIATED(deriv_att)) THEN
5677 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_tau_b)
5678 ELSE
5679 n_rhoa_rhob_tau_b => zero_f
5680 END IF
5681 deriv_att => xc_dset_get_derivative(deriv_set, &
5683 IF (ASSOCIATED(deriv_att)) THEN
5684 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_gamma_aa)
5685 ELSE
5686 n_rhoa_gamma_aa_gamma_aa => zero_f
5687 END IF
5688 deriv_att => xc_dset_get_derivative(deriv_set, &
5690 IF (ASSOCIATED(deriv_att)) THEN
5691 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_gamma_ab)
5692 ELSE
5693 n_rhoa_gamma_aa_gamma_ab => zero_f
5694 END IF
5695 deriv_att => xc_dset_get_derivative(deriv_set, &
5697 IF (ASSOCIATED(deriv_att)) THEN
5698 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_gamma_bb)
5699 ELSE
5700 n_rhoa_gamma_aa_gamma_bb => zero_f
5701 END IF
5702 deriv_att => xc_dset_get_derivative(deriv_set, &
5704 IF (ASSOCIATED(deriv_att)) THEN
5705 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_laplace_rhoa)
5706 ELSE
5707 n_rhoa_gamma_aa_laplace_rhoa => zero_f
5708 END IF
5709 deriv_att => xc_dset_get_derivative(deriv_set, &
5711 IF (ASSOCIATED(deriv_att)) THEN
5712 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_laplace_rhob)
5713 ELSE
5714 n_rhoa_gamma_aa_laplace_rhob => zero_f
5715 END IF
5716 deriv_att => xc_dset_get_derivative(deriv_set, &
5718 IF (ASSOCIATED(deriv_att)) THEN
5719 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_tau_a)
5720 ELSE
5721 n_rhoa_gamma_aa_tau_a => zero_f
5722 END IF
5723 deriv_att => xc_dset_get_derivative(deriv_set, &
5725 IF (ASSOCIATED(deriv_att)) THEN
5726 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_tau_b)
5727 ELSE
5728 n_rhoa_gamma_aa_tau_b => zero_f
5729 END IF
5730 deriv_att => xc_dset_get_derivative(deriv_set, &
5732 IF (ASSOCIATED(deriv_att)) THEN
5733 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab_gamma_ab)
5734 ELSE
5735 n_rhoa_gamma_ab_gamma_ab => zero_f
5736 END IF
5737 deriv_att => xc_dset_get_derivative(deriv_set, &
5739 IF (ASSOCIATED(deriv_att)) THEN
5740 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab_gamma_bb)
5741 ELSE
5742 n_rhoa_gamma_ab_gamma_bb => zero_f
5743 END IF
5744 deriv_att => xc_dset_get_derivative(deriv_set, &
5746 IF (ASSOCIATED(deriv_att)) THEN
5747 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab_laplace_rhoa)
5748 ELSE
5749 n_rhoa_gamma_ab_laplace_rhoa => zero_f
5750 END IF
5751 deriv_att => xc_dset_get_derivative(deriv_set, &
5753 IF (ASSOCIATED(deriv_att)) THEN
5754 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab_laplace_rhob)
5755 ELSE
5756 n_rhoa_gamma_ab_laplace_rhob => zero_f
5757 END IF
5758 deriv_att => xc_dset_get_derivative(deriv_set, &
5760 IF (ASSOCIATED(deriv_att)) THEN
5761 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab_tau_a)
5762 ELSE
5763 n_rhoa_gamma_ab_tau_a => zero_f
5764 END IF
5765 deriv_att => xc_dset_get_derivative(deriv_set, &
5767 IF (ASSOCIATED(deriv_att)) THEN
5768 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab_tau_b)
5769 ELSE
5770 n_rhoa_gamma_ab_tau_b => zero_f
5771 END IF
5772 deriv_att => xc_dset_get_derivative(deriv_set, &
5774 IF (ASSOCIATED(deriv_att)) THEN
5775 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_bb_gamma_bb)
5776 ELSE
5777 n_rhoa_gamma_bb_gamma_bb => zero_f
5778 END IF
5779 deriv_att => xc_dset_get_derivative(deriv_set, &
5781 IF (ASSOCIATED(deriv_att)) THEN
5782 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_bb_laplace_rhoa)
5783 ELSE
5784 n_rhoa_gamma_bb_laplace_rhoa => zero_f
5785 END IF
5786 deriv_att => xc_dset_get_derivative(deriv_set, &
5788 IF (ASSOCIATED(deriv_att)) THEN
5789 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_bb_laplace_rhob)
5790 ELSE
5791 n_rhoa_gamma_bb_laplace_rhob => zero_f
5792 END IF
5793 deriv_att => xc_dset_get_derivative(deriv_set, &
5795 IF (ASSOCIATED(deriv_att)) THEN
5796 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_bb_tau_a)
5797 ELSE
5798 n_rhoa_gamma_bb_tau_a => zero_f
5799 END IF
5800 deriv_att => xc_dset_get_derivative(deriv_set, &
5802 IF (ASSOCIATED(deriv_att)) THEN
5803 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_bb_tau_b)
5804 ELSE
5805 n_rhoa_gamma_bb_tau_b => zero_f
5806 END IF
5807 deriv_att => xc_dset_get_derivative(deriv_set, &
5809 IF (ASSOCIATED(deriv_att)) THEN
5810 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhoa_laplace_rhoa)
5811 ELSE
5812 n_rhoa_laplace_rhoa_laplace_rhoa => zero_f
5813 END IF
5814 deriv_att => xc_dset_get_derivative(deriv_set, &
5816 IF (ASSOCIATED(deriv_att)) THEN
5817 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhoa_laplace_rhob)
5818 ELSE
5819 n_rhoa_laplace_rhoa_laplace_rhob => zero_f
5820 END IF
5821 deriv_att => xc_dset_get_derivative(deriv_set, &
5823 IF (ASSOCIATED(deriv_att)) THEN
5824 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhoa_tau_a)
5825 ELSE
5826 n_rhoa_laplace_rhoa_tau_a => zero_f
5827 END IF
5828 deriv_att => xc_dset_get_derivative(deriv_set, &
5830 IF (ASSOCIATED(deriv_att)) THEN
5831 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhoa_tau_b)
5832 ELSE
5833 n_rhoa_laplace_rhoa_tau_b => zero_f
5834 END IF
5835 deriv_att => xc_dset_get_derivative(deriv_set, &
5837 IF (ASSOCIATED(deriv_att)) THEN
5838 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhob_laplace_rhob)
5839 ELSE
5840 n_rhoa_laplace_rhob_laplace_rhob => zero_f
5841 END IF
5842 deriv_att => xc_dset_get_derivative(deriv_set, &
5844 IF (ASSOCIATED(deriv_att)) THEN
5845 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhob_tau_a)
5846 ELSE
5847 n_rhoa_laplace_rhob_tau_a => zero_f
5848 END IF
5849 deriv_att => xc_dset_get_derivative(deriv_set, &
5851 IF (ASSOCIATED(deriv_att)) THEN
5852 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhob_tau_b)
5853 ELSE
5854 n_rhoa_laplace_rhob_tau_b => zero_f
5855 END IF
5856 deriv_att => xc_dset_get_derivative(deriv_set, &
5858 IF (ASSOCIATED(deriv_att)) THEN
5859 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_tau_a_tau_a)
5860 ELSE
5861 n_rhoa_tau_a_tau_a => zero_f
5862 END IF
5863 deriv_att => xc_dset_get_derivative(deriv_set, &
5865 IF (ASSOCIATED(deriv_att)) THEN
5866 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_tau_a_tau_b)
5867 ELSE
5868 n_rhoa_tau_a_tau_b => zero_f
5869 END IF
5870 deriv_att => xc_dset_get_derivative(deriv_set, &
5872 IF (ASSOCIATED(deriv_att)) THEN
5873 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_tau_b_tau_b)
5874 ELSE
5875 n_rhoa_tau_b_tau_b => zero_f
5876 END IF
5877 deriv_att => xc_dset_get_derivative(deriv_set, &
5879 IF (ASSOCIATED(deriv_att)) THEN
5880 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_rhob)
5881 ELSE
5882 n_rhob_rhob_rhob => zero_f
5883 END IF
5884 deriv_att => xc_dset_get_derivative(deriv_set, &
5886 IF (ASSOCIATED(deriv_att)) THEN
5887 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_gamma_aa)
5888 ELSE
5889 n_rhob_rhob_gamma_aa => zero_f
5890 END IF
5891 deriv_att => xc_dset_get_derivative(deriv_set, &
5893 IF (ASSOCIATED(deriv_att)) THEN
5894 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_gamma_ab)
5895 ELSE
5896 n_rhob_rhob_gamma_ab => zero_f
5897 END IF
5898 deriv_att => xc_dset_get_derivative(deriv_set, &
5900 IF (ASSOCIATED(deriv_att)) THEN
5901 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_gamma_bb)
5902 ELSE
5903 n_rhob_rhob_gamma_bb => zero_f
5904 END IF
5905 deriv_att => xc_dset_get_derivative(deriv_set, &
5907 IF (ASSOCIATED(deriv_att)) THEN
5908 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_laplace_rhoa)
5909 ELSE
5910 n_rhob_rhob_laplace_rhoa => zero_f
5911 END IF
5912 deriv_att => xc_dset_get_derivative(deriv_set, &
5914 IF (ASSOCIATED(deriv_att)) THEN
5915 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_laplace_rhob)
5916 ELSE
5917 n_rhob_rhob_laplace_rhob => zero_f
5918 END IF
5919 deriv_att => xc_dset_get_derivative(deriv_set, &
5921 IF (ASSOCIATED(deriv_att)) THEN
5922 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_tau_a)
5923 ELSE
5924 n_rhob_rhob_tau_a => zero_f
5925 END IF
5926 deriv_att => xc_dset_get_derivative(deriv_set, &
5928 IF (ASSOCIATED(deriv_att)) THEN
5929 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_tau_b)
5930 ELSE
5931 n_rhob_rhob_tau_b => zero_f
5932 END IF
5933 deriv_att => xc_dset_get_derivative(deriv_set, &
5935 IF (ASSOCIATED(deriv_att)) THEN
5936 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_gamma_aa)
5937 ELSE
5938 n_rhob_gamma_aa_gamma_aa => zero_f
5939 END IF
5940 deriv_att => xc_dset_get_derivative(deriv_set, &
5942 IF (ASSOCIATED(deriv_att)) THEN
5943 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_gamma_ab)
5944 ELSE
5945 n_rhob_gamma_aa_gamma_ab => zero_f
5946 END IF
5947 deriv_att => xc_dset_get_derivative(deriv_set, &
5949 IF (ASSOCIATED(deriv_att)) THEN
5950 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_gamma_bb)
5951 ELSE
5952 n_rhob_gamma_aa_gamma_bb => zero_f
5953 END IF
5954 deriv_att => xc_dset_get_derivative(deriv_set, &
5956 IF (ASSOCIATED(deriv_att)) THEN
5957 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_laplace_rhoa)
5958 ELSE
5959 n_rhob_gamma_aa_laplace_rhoa => zero_f
5960 END IF
5961 deriv_att => xc_dset_get_derivative(deriv_set, &
5963 IF (ASSOCIATED(deriv_att)) THEN
5964 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_laplace_rhob)
5965 ELSE
5966 n_rhob_gamma_aa_laplace_rhob => zero_f
5967 END IF
5968 deriv_att => xc_dset_get_derivative(deriv_set, &
5970 IF (ASSOCIATED(deriv_att)) THEN
5971 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_tau_a)
5972 ELSE
5973 n_rhob_gamma_aa_tau_a => zero_f
5974 END IF
5975 deriv_att => xc_dset_get_derivative(deriv_set, &
5977 IF (ASSOCIATED(deriv_att)) THEN
5978 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_tau_b)
5979 ELSE
5980 n_rhob_gamma_aa_tau_b => zero_f
5981 END IF
5982 deriv_att => xc_dset_get_derivative(deriv_set, &
5984 IF (ASSOCIATED(deriv_att)) THEN
5985 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab_gamma_ab)
5986 ELSE
5987 n_rhob_gamma_ab_gamma_ab => zero_f
5988 END IF
5989 deriv_att => xc_dset_get_derivative(deriv_set, &
5991 IF (ASSOCIATED(deriv_att)) THEN
5992 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab_gamma_bb)
5993 ELSE
5994 n_rhob_gamma_ab_gamma_bb => zero_f
5995 END IF
5996 deriv_att => xc_dset_get_derivative(deriv_set, &
5998 IF (ASSOCIATED(deriv_att)) THEN
5999 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab_laplace_rhoa)
6000 ELSE
6001 n_rhob_gamma_ab_laplace_rhoa => zero_f
6002 END IF
6003 deriv_att => xc_dset_get_derivative(deriv_set, &
6005 IF (ASSOCIATED(deriv_att)) THEN
6006 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab_laplace_rhob)
6007 ELSE
6008 n_rhob_gamma_ab_laplace_rhob => zero_f
6009 END IF
6010 deriv_att => xc_dset_get_derivative(deriv_set, &
6012 IF (ASSOCIATED(deriv_att)) THEN
6013 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab_tau_a)
6014 ELSE
6015 n_rhob_gamma_ab_tau_a => zero_f
6016 END IF
6017 deriv_att => xc_dset_get_derivative(deriv_set, &
6019 IF (ASSOCIATED(deriv_att)) THEN
6020 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab_tau_b)
6021 ELSE
6022 n_rhob_gamma_ab_tau_b => zero_f
6023 END IF
6024 deriv_att => xc_dset_get_derivative(deriv_set, &
6026 IF (ASSOCIATED(deriv_att)) THEN
6027 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_bb_gamma_bb)
6028 ELSE
6029 n_rhob_gamma_bb_gamma_bb => zero_f
6030 END IF
6031 deriv_att => xc_dset_get_derivative(deriv_set, &
6033 IF (ASSOCIATED(deriv_att)) THEN
6034 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_bb_laplace_rhoa)
6035 ELSE
6036 n_rhob_gamma_bb_laplace_rhoa => zero_f
6037 END IF
6038 deriv_att => xc_dset_get_derivative(deriv_set, &
6040 IF (ASSOCIATED(deriv_att)) THEN
6041 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_bb_laplace_rhob)
6042 ELSE
6043 n_rhob_gamma_bb_laplace_rhob => zero_f
6044 END IF
6045 deriv_att => xc_dset_get_derivative(deriv_set, &
6047 IF (ASSOCIATED(deriv_att)) THEN
6048 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_bb_tau_a)
6049 ELSE
6050 n_rhob_gamma_bb_tau_a => zero_f
6051 END IF
6052 deriv_att => xc_dset_get_derivative(deriv_set, &
6054 IF (ASSOCIATED(deriv_att)) THEN
6055 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_bb_tau_b)
6056 ELSE
6057 n_rhob_gamma_bb_tau_b => zero_f
6058 END IF
6059 deriv_att => xc_dset_get_derivative(deriv_set, &
6061 IF (ASSOCIATED(deriv_att)) THEN
6062 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhoa_laplace_rhoa)
6063 ELSE
6064 n_rhob_laplace_rhoa_laplace_rhoa => zero_f
6065 END IF
6066 deriv_att => xc_dset_get_derivative(deriv_set, &
6068 IF (ASSOCIATED(deriv_att)) THEN
6069 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhoa_laplace_rhob)
6070 ELSE
6071 n_rhob_laplace_rhoa_laplace_rhob => zero_f
6072 END IF
6073 deriv_att => xc_dset_get_derivative(deriv_set, &
6075 IF (ASSOCIATED(deriv_att)) THEN
6076 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhoa_tau_a)
6077 ELSE
6078 n_rhob_laplace_rhoa_tau_a => zero_f
6079 END IF
6080 deriv_att => xc_dset_get_derivative(deriv_set, &
6082 IF (ASSOCIATED(deriv_att)) THEN
6083 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhoa_tau_b)
6084 ELSE
6085 n_rhob_laplace_rhoa_tau_b => zero_f
6086 END IF
6087 deriv_att => xc_dset_get_derivative(deriv_set, &
6089 IF (ASSOCIATED(deriv_att)) THEN
6090 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhob_laplace_rhob)
6091 ELSE
6092 n_rhob_laplace_rhob_laplace_rhob => zero_f
6093 END IF
6094 deriv_att => xc_dset_get_derivative(deriv_set, &
6096 IF (ASSOCIATED(deriv_att)) THEN
6097 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhob_tau_a)
6098 ELSE
6099 n_rhob_laplace_rhob_tau_a => zero_f
6100 END IF
6101 deriv_att => xc_dset_get_derivative(deriv_set, &
6103 IF (ASSOCIATED(deriv_att)) THEN
6104 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhob_tau_b)
6105 ELSE
6106 n_rhob_laplace_rhob_tau_b => zero_f
6107 END IF
6108 deriv_att => xc_dset_get_derivative(deriv_set, &
6110 IF (ASSOCIATED(deriv_att)) THEN
6111 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_tau_a_tau_a)
6112 ELSE
6113 n_rhob_tau_a_tau_a => zero_f
6114 END IF
6115 deriv_att => xc_dset_get_derivative(deriv_set, &
6117 IF (ASSOCIATED(deriv_att)) THEN
6118 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_tau_a_tau_b)
6119 ELSE
6120 n_rhob_tau_a_tau_b => zero_f
6121 END IF
6122 deriv_att => xc_dset_get_derivative(deriv_set, &
6124 IF (ASSOCIATED(deriv_att)) THEN
6125 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_tau_b_tau_b)
6126 ELSE
6127 n_rhob_tau_b_tau_b => zero_f
6128 END IF
6129 deriv_att => xc_dset_get_derivative(deriv_set, &
6131 IF (ASSOCIATED(deriv_att)) THEN
6132 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_gamma_aa)
6133 ELSE
6134 n_gamma_aa_gamma_aa_gamma_aa => zero_f
6135 END IF
6136 deriv_att => xc_dset_get_derivative(deriv_set, &
6138 IF (ASSOCIATED(deriv_att)) THEN
6139 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_gamma_ab)
6140 ELSE
6141 n_gamma_aa_gamma_aa_gamma_ab => zero_f
6142 END IF
6143 deriv_att => xc_dset_get_derivative(deriv_set, &
6145 IF (ASSOCIATED(deriv_att)) THEN
6146 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_gamma_bb)
6147 ELSE
6148 n_gamma_aa_gamma_aa_gamma_bb => zero_f
6149 END IF
6150 deriv_att => xc_dset_get_derivative(deriv_set, &
6152 IF (ASSOCIATED(deriv_att)) THEN
6153 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_laplace_rhoa)
6154 ELSE
6155 n_gamma_aa_gamma_aa_laplace_rhoa => zero_f
6156 END IF
6157 deriv_att => xc_dset_get_derivative(deriv_set, &
6159 IF (ASSOCIATED(deriv_att)) THEN
6160 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_laplace_rhob)
6161 ELSE
6162 n_gamma_aa_gamma_aa_laplace_rhob => zero_f
6163 END IF
6164 deriv_att => xc_dset_get_derivative(deriv_set, &
6166 IF (ASSOCIATED(deriv_att)) THEN
6167 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_tau_a)
6168 ELSE
6169 n_gamma_aa_gamma_aa_tau_a => zero_f
6170 END IF
6171 deriv_att => xc_dset_get_derivative(deriv_set, &
6173 IF (ASSOCIATED(deriv_att)) THEN
6174 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_tau_b)
6175 ELSE
6176 n_gamma_aa_gamma_aa_tau_b => zero_f
6177 END IF
6178 deriv_att => xc_dset_get_derivative(deriv_set, &
6180 IF (ASSOCIATED(deriv_att)) THEN
6181 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab_gamma_ab)
6182 ELSE
6183 n_gamma_aa_gamma_ab_gamma_ab => zero_f
6184 END IF
6185 deriv_att => xc_dset_get_derivative(deriv_set, &
6187 IF (ASSOCIATED(deriv_att)) THEN
6188 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab_gamma_bb)
6189 ELSE
6190 n_gamma_aa_gamma_ab_gamma_bb => zero_f
6191 END IF
6192 deriv_att => xc_dset_get_derivative(deriv_set, &
6194 IF (ASSOCIATED(deriv_att)) THEN
6195 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab_laplace_rhoa)
6196 ELSE
6197 n_gamma_aa_gamma_ab_laplace_rhoa => zero_f
6198 END IF
6199 deriv_att => xc_dset_get_derivative(deriv_set, &
6201 IF (ASSOCIATED(deriv_att)) THEN
6202 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab_laplace_rhob)
6203 ELSE
6204 n_gamma_aa_gamma_ab_laplace_rhob => zero_f
6205 END IF
6206 deriv_att => xc_dset_get_derivative(deriv_set, &
6208 IF (ASSOCIATED(deriv_att)) THEN
6209 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab_tau_a)
6210 ELSE
6211 n_gamma_aa_gamma_ab_tau_a => zero_f
6212 END IF
6213 deriv_att => xc_dset_get_derivative(deriv_set, &
6215 IF (ASSOCIATED(deriv_att)) THEN
6216 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab_tau_b)
6217 ELSE
6218 n_gamma_aa_gamma_ab_tau_b => zero_f
6219 END IF
6220 deriv_att => xc_dset_get_derivative(deriv_set, &
6222 IF (ASSOCIATED(deriv_att)) THEN
6223 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_bb_gamma_bb)
6224 ELSE
6225 n_gamma_aa_gamma_bb_gamma_bb => zero_f
6226 END IF
6227 deriv_att => xc_dset_get_derivative(deriv_set, &
6229 IF (ASSOCIATED(deriv_att)) THEN
6230 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_bb_laplace_rhoa)
6231 ELSE
6232 n_gamma_aa_gamma_bb_laplace_rhoa => zero_f
6233 END IF
6234 deriv_att => xc_dset_get_derivative(deriv_set, &
6236 IF (ASSOCIATED(deriv_att)) THEN
6237 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_bb_laplace_rhob)
6238 ELSE
6239 n_gamma_aa_gamma_bb_laplace_rhob => zero_f
6240 END IF
6241 deriv_att => xc_dset_get_derivative(deriv_set, &
6243 IF (ASSOCIATED(deriv_att)) THEN
6244 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_bb_tau_a)
6245 ELSE
6246 n_gamma_aa_gamma_bb_tau_a => zero_f
6247 END IF
6248 deriv_att => xc_dset_get_derivative(deriv_set, &
6250 IF (ASSOCIATED(deriv_att)) THEN
6251 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_bb_tau_b)
6252 ELSE
6253 n_gamma_aa_gamma_bb_tau_b => zero_f
6254 END IF
6255 deriv_att => xc_dset_get_derivative(deriv_set, &
6257 IF (ASSOCIATED(deriv_att)) THEN
6258 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhoa_laplace_rhoa)
6259 ELSE
6260 n_gamma_aa_laplace_rhoa_laplace_rhoa => zero_f
6261 END IF
6262 deriv_att => xc_dset_get_derivative(deriv_set, &
6264 IF (ASSOCIATED(deriv_att)) THEN
6265 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhoa_laplace_rhob)
6266 ELSE
6267 n_gamma_aa_laplace_rhoa_laplace_rhob => zero_f
6268 END IF
6269 deriv_att => xc_dset_get_derivative(deriv_set, &
6271 IF (ASSOCIATED(deriv_att)) THEN
6272 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhoa_tau_a)
6273 ELSE
6274 n_gamma_aa_laplace_rhoa_tau_a => zero_f
6275 END IF
6276 deriv_att => xc_dset_get_derivative(deriv_set, &
6278 IF (ASSOCIATED(deriv_att)) THEN
6279 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhoa_tau_b)
6280 ELSE
6281 n_gamma_aa_laplace_rhoa_tau_b => zero_f
6282 END IF
6283 deriv_att => xc_dset_get_derivative(deriv_set, &
6285 IF (ASSOCIATED(deriv_att)) THEN
6286 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhob_laplace_rhob)
6287 ELSE
6288 n_gamma_aa_laplace_rhob_laplace_rhob => zero_f
6289 END IF
6290 deriv_att => xc_dset_get_derivative(deriv_set, &
6292 IF (ASSOCIATED(deriv_att)) THEN
6293 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhob_tau_a)
6294 ELSE
6295 n_gamma_aa_laplace_rhob_tau_a => zero_f
6296 END IF
6297 deriv_att => xc_dset_get_derivative(deriv_set, &
6299 IF (ASSOCIATED(deriv_att)) THEN
6300 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhob_tau_b)
6301 ELSE
6302 n_gamma_aa_laplace_rhob_tau_b => zero_f
6303 END IF
6304 deriv_att => xc_dset_get_derivative(deriv_set, &
6306 IF (ASSOCIATED(deriv_att)) THEN
6307 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_tau_a_tau_a)
6308 ELSE
6309 n_gamma_aa_tau_a_tau_a => zero_f
6310 END IF
6311 deriv_att => xc_dset_get_derivative(deriv_set, &
6313 IF (ASSOCIATED(deriv_att)) THEN
6314 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_tau_a_tau_b)
6315 ELSE
6316 n_gamma_aa_tau_a_tau_b => zero_f
6317 END IF
6318 deriv_att => xc_dset_get_derivative(deriv_set, &
6320 IF (ASSOCIATED(deriv_att)) THEN
6321 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_tau_b_tau_b)
6322 ELSE
6323 n_gamma_aa_tau_b_tau_b => zero_f
6324 END IF
6325 deriv_att => xc_dset_get_derivative(deriv_set, &
6327 IF (ASSOCIATED(deriv_att)) THEN
6328 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab_gamma_ab)
6329 ELSE
6330 n_gamma_ab_gamma_ab_gamma_ab => zero_f
6331 END IF
6332 deriv_att => xc_dset_get_derivative(deriv_set, &
6334 IF (ASSOCIATED(deriv_att)) THEN
6335 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab_gamma_bb)
6336 ELSE
6337 n_gamma_ab_gamma_ab_gamma_bb => zero_f
6338 END IF
6339 deriv_att => xc_dset_get_derivative(deriv_set, &
6341 IF (ASSOCIATED(deriv_att)) THEN
6342 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab_laplace_rhoa)
6343 ELSE
6344 n_gamma_ab_gamma_ab_laplace_rhoa => zero_f
6345 END IF
6346 deriv_att => xc_dset_get_derivative(deriv_set, &
6348 IF (ASSOCIATED(deriv_att)) THEN
6349 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab_laplace_rhob)
6350 ELSE
6351 n_gamma_ab_gamma_ab_laplace_rhob => zero_f
6352 END IF
6353 deriv_att => xc_dset_get_derivative(deriv_set, &
6355 IF (ASSOCIATED(deriv_att)) THEN
6356 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab_tau_a)
6357 ELSE
6358 n_gamma_ab_gamma_ab_tau_a => zero_f
6359 END IF
6360 deriv_att => xc_dset_get_derivative(deriv_set, &
6362 IF (ASSOCIATED(deriv_att)) THEN
6363 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab_tau_b)
6364 ELSE
6365 n_gamma_ab_gamma_ab_tau_b => zero_f
6366 END IF
6367 deriv_att => xc_dset_get_derivative(deriv_set, &
6369 IF (ASSOCIATED(deriv_att)) THEN
6370 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_bb_gamma_bb)
6371 ELSE
6372 n_gamma_ab_gamma_bb_gamma_bb => zero_f
6373 END IF
6374 deriv_att => xc_dset_get_derivative(deriv_set, &
6376 IF (ASSOCIATED(deriv_att)) THEN
6377 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_bb_laplace_rhoa)
6378 ELSE
6379 n_gamma_ab_gamma_bb_laplace_rhoa => zero_f
6380 END IF
6381 deriv_att => xc_dset_get_derivative(deriv_set, &
6383 IF (ASSOCIATED(deriv_att)) THEN
6384 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_bb_laplace_rhob)
6385 ELSE
6386 n_gamma_ab_gamma_bb_laplace_rhob => zero_f
6387 END IF
6388 deriv_att => xc_dset_get_derivative(deriv_set, &
6390 IF (ASSOCIATED(deriv_att)) THEN
6391 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_bb_tau_a)
6392 ELSE
6393 n_gamma_ab_gamma_bb_tau_a => zero_f
6394 END IF
6395 deriv_att => xc_dset_get_derivative(deriv_set, &
6397 IF (ASSOCIATED(deriv_att)) THEN
6398 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_bb_tau_b)
6399 ELSE
6400 n_gamma_ab_gamma_bb_tau_b => zero_f
6401 END IF
6402 deriv_att => xc_dset_get_derivative(deriv_set, &
6404 IF (ASSOCIATED(deriv_att)) THEN
6405 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhoa_laplace_rhoa)
6406 ELSE
6407 n_gamma_ab_laplace_rhoa_laplace_rhoa => zero_f
6408 END IF
6409 deriv_att => xc_dset_get_derivative(deriv_set, &
6411 IF (ASSOCIATED(deriv_att)) THEN
6412 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhoa_laplace_rhob)
6413 ELSE
6414 n_gamma_ab_laplace_rhoa_laplace_rhob => zero_f
6415 END IF
6416 deriv_att => xc_dset_get_derivative(deriv_set, &
6418 IF (ASSOCIATED(deriv_att)) THEN
6419 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhoa_tau_a)
6420 ELSE
6421 n_gamma_ab_laplace_rhoa_tau_a => zero_f
6422 END IF
6423 deriv_att => xc_dset_get_derivative(deriv_set, &
6425 IF (ASSOCIATED(deriv_att)) THEN
6426 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhoa_tau_b)
6427 ELSE
6428 n_gamma_ab_laplace_rhoa_tau_b => zero_f
6429 END IF
6430 deriv_att => xc_dset_get_derivative(deriv_set, &
6432 IF (ASSOCIATED(deriv_att)) THEN
6433 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhob_laplace_rhob)
6434 ELSE
6435 n_gamma_ab_laplace_rhob_laplace_rhob => zero_f
6436 END IF
6437 deriv_att => xc_dset_get_derivative(deriv_set, &
6439 IF (ASSOCIATED(deriv_att)) THEN
6440 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhob_tau_a)
6441 ELSE
6442 n_gamma_ab_laplace_rhob_tau_a => zero_f
6443 END IF
6444 deriv_att => xc_dset_get_derivative(deriv_set, &
6446 IF (ASSOCIATED(deriv_att)) THEN
6447 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhob_tau_b)
6448 ELSE
6449 n_gamma_ab_laplace_rhob_tau_b => zero_f
6450 END IF
6451 deriv_att => xc_dset_get_derivative(deriv_set, &
6453 IF (ASSOCIATED(deriv_att)) THEN
6454 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_tau_a_tau_a)
6455 ELSE
6456 n_gamma_ab_tau_a_tau_a => zero_f
6457 END IF
6458 deriv_att => xc_dset_get_derivative(deriv_set, &
6460 IF (ASSOCIATED(deriv_att)) THEN
6461 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_tau_a_tau_b)
6462 ELSE
6463 n_gamma_ab_tau_a_tau_b => zero_f
6464 END IF
6465 deriv_att => xc_dset_get_derivative(deriv_set, &
6467 IF (ASSOCIATED(deriv_att)) THEN
6468 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_tau_b_tau_b)
6469 ELSE
6470 n_gamma_ab_tau_b_tau_b => zero_f
6471 END IF
6472 deriv_att => xc_dset_get_derivative(deriv_set, &
6474 IF (ASSOCIATED(deriv_att)) THEN
6475 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_gamma_bb_gamma_bb)
6476 ELSE
6477 n_gamma_bb_gamma_bb_gamma_bb => zero_f
6478 END IF
6479 deriv_att => xc_dset_get_derivative(deriv_set, &
6481 IF (ASSOCIATED(deriv_att)) THEN
6482 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_gamma_bb_laplace_rhoa)
6483 ELSE
6484 n_gamma_bb_gamma_bb_laplace_rhoa => zero_f
6485 END IF
6486 deriv_att => xc_dset_get_derivative(deriv_set, &
6488 IF (ASSOCIATED(deriv_att)) THEN
6489 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_gamma_bb_laplace_rhob)
6490 ELSE
6491 n_gamma_bb_gamma_bb_laplace_rhob => zero_f
6492 END IF
6493 deriv_att => xc_dset_get_derivative(deriv_set, &
6495 IF (ASSOCIATED(deriv_att)) THEN
6496 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_gamma_bb_tau_a)
6497 ELSE
6498 n_gamma_bb_gamma_bb_tau_a => zero_f
6499 END IF
6500 deriv_att => xc_dset_get_derivative(deriv_set, &
6502 IF (ASSOCIATED(deriv_att)) THEN
6503 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_gamma_bb_tau_b)
6504 ELSE
6505 n_gamma_bb_gamma_bb_tau_b => zero_f
6506 END IF
6507 deriv_att => xc_dset_get_derivative(deriv_set, &
6509 IF (ASSOCIATED(deriv_att)) THEN
6510 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhoa_laplace_rhoa)
6511 ELSE
6512 n_gamma_bb_laplace_rhoa_laplace_rhoa => zero_f
6513 END IF
6514 deriv_att => xc_dset_get_derivative(deriv_set, &
6516 IF (ASSOCIATED(deriv_att)) THEN
6517 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhoa_laplace_rhob)
6518 ELSE
6519 n_gamma_bb_laplace_rhoa_laplace_rhob => zero_f
6520 END IF
6521 deriv_att => xc_dset_get_derivative(deriv_set, &
6523 IF (ASSOCIATED(deriv_att)) THEN
6524 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhoa_tau_a)
6525 ELSE
6526 n_gamma_bb_laplace_rhoa_tau_a => zero_f
6527 END IF
6528 deriv_att => xc_dset_get_derivative(deriv_set, &
6530 IF (ASSOCIATED(deriv_att)) THEN
6531 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhoa_tau_b)
6532 ELSE
6533 n_gamma_bb_laplace_rhoa_tau_b => zero_f
6534 END IF
6535 deriv_att => xc_dset_get_derivative(deriv_set, &
6537 IF (ASSOCIATED(deriv_att)) THEN
6538 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhob_laplace_rhob)
6539 ELSE
6540 n_gamma_bb_laplace_rhob_laplace_rhob => zero_f
6541 END IF
6542 deriv_att => xc_dset_get_derivative(deriv_set, &
6544 IF (ASSOCIATED(deriv_att)) THEN
6545 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhob_tau_a)
6546 ELSE
6547 n_gamma_bb_laplace_rhob_tau_a => zero_f
6548 END IF
6549 deriv_att => xc_dset_get_derivative(deriv_set, &
6551 IF (ASSOCIATED(deriv_att)) THEN
6552 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhob_tau_b)
6553 ELSE
6554 n_gamma_bb_laplace_rhob_tau_b => zero_f
6555 END IF
6556 deriv_att => xc_dset_get_derivative(deriv_set, &
6558 IF (ASSOCIATED(deriv_att)) THEN
6559 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_tau_a_tau_a)
6560 ELSE
6561 n_gamma_bb_tau_a_tau_a => zero_f
6562 END IF
6563 deriv_att => xc_dset_get_derivative(deriv_set, &
6565 IF (ASSOCIATED(deriv_att)) THEN
6566 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_tau_a_tau_b)
6567 ELSE
6568 n_gamma_bb_tau_a_tau_b => zero_f
6569 END IF
6570 deriv_att => xc_dset_get_derivative(deriv_set, &
6572 IF (ASSOCIATED(deriv_att)) THEN
6573 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_tau_b_tau_b)
6574 ELSE
6575 n_gamma_bb_tau_b_tau_b => zero_f
6576 END IF
6577 deriv_att => xc_dset_get_derivative(deriv_set, &
6579 IF (ASSOCIATED(deriv_att)) THEN
6580 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhoa_laplace_rhoa)
6581 ELSE
6582 n_laplace_rhoa_laplace_rhoa_laplace_rhoa => zero_f
6583 END IF
6584 deriv_att => xc_dset_get_derivative(deriv_set, &
6586 IF (ASSOCIATED(deriv_att)) THEN
6587 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhoa_laplace_rhob)
6588 ELSE
6589 n_laplace_rhoa_laplace_rhoa_laplace_rhob => zero_f
6590 END IF
6591 deriv_att => xc_dset_get_derivative(deriv_set, &
6593 IF (ASSOCIATED(deriv_att)) THEN
6594 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhoa_tau_a)
6595 ELSE
6596 n_laplace_rhoa_laplace_rhoa_tau_a => zero_f
6597 END IF
6598 deriv_att => xc_dset_get_derivative(deriv_set, &
6600 IF (ASSOCIATED(deriv_att)) THEN
6601 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhoa_tau_b)
6602 ELSE
6603 n_laplace_rhoa_laplace_rhoa_tau_b => zero_f
6604 END IF
6605 deriv_att => xc_dset_get_derivative(deriv_set, &
6607 IF (ASSOCIATED(deriv_att)) THEN
6608 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhob_laplace_rhob)
6609 ELSE
6610 n_laplace_rhoa_laplace_rhob_laplace_rhob => zero_f
6611 END IF
6612 deriv_att => xc_dset_get_derivative(deriv_set, &
6614 IF (ASSOCIATED(deriv_att)) THEN
6615 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhob_tau_a)
6616 ELSE
6617 n_laplace_rhoa_laplace_rhob_tau_a => zero_f
6618 END IF
6619 deriv_att => xc_dset_get_derivative(deriv_set, &
6621 IF (ASSOCIATED(deriv_att)) THEN
6622 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhob_tau_b)
6623 ELSE
6624 n_laplace_rhoa_laplace_rhob_tau_b => zero_f
6625 END IF
6626 deriv_att => xc_dset_get_derivative(deriv_set, &
6628 IF (ASSOCIATED(deriv_att)) THEN
6629 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_tau_a_tau_a)
6630 ELSE
6631 n_laplace_rhoa_tau_a_tau_a => zero_f
6632 END IF
6633 deriv_att => xc_dset_get_derivative(deriv_set, &
6635 IF (ASSOCIATED(deriv_att)) THEN
6636 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_tau_a_tau_b)
6637 ELSE
6638 n_laplace_rhoa_tau_a_tau_b => zero_f
6639 END IF
6640 deriv_att => xc_dset_get_derivative(deriv_set, &
6642 IF (ASSOCIATED(deriv_att)) THEN
6643 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_tau_b_tau_b)
6644 ELSE
6645 n_laplace_rhoa_tau_b_tau_b => zero_f
6646 END IF
6647 deriv_att => xc_dset_get_derivative(deriv_set, &
6649 IF (ASSOCIATED(deriv_att)) THEN
6650 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_laplace_rhob_laplace_rhob)
6651 ELSE
6652 n_laplace_rhob_laplace_rhob_laplace_rhob => zero_f
6653 END IF
6654 deriv_att => xc_dset_get_derivative(deriv_set, &
6656 IF (ASSOCIATED(deriv_att)) THEN
6657 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_laplace_rhob_tau_a)
6658 ELSE
6659 n_laplace_rhob_laplace_rhob_tau_a => zero_f
6660 END IF
6661 deriv_att => xc_dset_get_derivative(deriv_set, &
6663 IF (ASSOCIATED(deriv_att)) THEN
6664 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_laplace_rhob_tau_b)
6665 ELSE
6666 n_laplace_rhob_laplace_rhob_tau_b => zero_f
6667 END IF
6668 deriv_att => xc_dset_get_derivative(deriv_set, &
6670 IF (ASSOCIATED(deriv_att)) THEN
6671 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_tau_a_tau_a)
6672 ELSE
6673 n_laplace_rhob_tau_a_tau_a => zero_f
6674 END IF
6675 deriv_att => xc_dset_get_derivative(deriv_set, &
6677 IF (ASSOCIATED(deriv_att)) THEN
6678 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_tau_a_tau_b)
6679 ELSE
6680 n_laplace_rhob_tau_a_tau_b => zero_f
6681 END IF
6682 deriv_att => xc_dset_get_derivative(deriv_set, &
6684 IF (ASSOCIATED(deriv_att)) THEN
6685 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_tau_b_tau_b)
6686 ELSE
6687 n_laplace_rhob_tau_b_tau_b => zero_f
6688 END IF
6689 deriv_att => xc_dset_get_derivative(deriv_set, &
6691 IF (ASSOCIATED(deriv_att)) THEN
6692 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_a_tau_a_tau_a)
6693 ELSE
6694 n_tau_a_tau_a_tau_a => zero_f
6695 END IF
6696 deriv_att => xc_dset_get_derivative(deriv_set, &
6698 IF (ASSOCIATED(deriv_att)) THEN
6699 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_a_tau_a_tau_b)
6700 ELSE
6701 n_tau_a_tau_a_tau_b => zero_f
6702 END IF
6703 deriv_att => xc_dset_get_derivative(deriv_set, &
6705 IF (ASSOCIATED(deriv_att)) THEN
6706 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_a_tau_b_tau_b)
6707 ELSE
6708 n_tau_a_tau_b_tau_b => zero_f
6709 END IF
6710 deriv_att => xc_dset_get_derivative(deriv_set, &
6712 IF (ASSOCIATED(deriv_att)) THEN
6713 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_b_tau_b_tau_b)
6714 ELSE
6715 n_tau_b_tau_b_tau_b => zero_f
6716 END IF
6717 IF (laplace_f) THEN
6718 ALLOCATE (v_laplace(nspins))
6719 DO ispin = 1, nspins
6720 CALL allocate_pw(v_laplace(ispin), pw_pool, bo)
6721 END DO
6722 END IF
6723
6724!$OMP PARALLEL DO DEFAULT(NONE) COLLAPSE(3) &
6725!$OMP PRIVATE(k, j, i) &
6726!$OMP PRIVATE(mp_rhoa, q_rhoa) &
6727!$OMP PRIVATE(mp_rhob, q_rhob) &
6728!$OMP PRIVATE(mp_gamma_aa, q_gamma_aa) &
6729!$OMP PRIVATE(mp_gamma_ab, q_gamma_ab) &
6730!$OMP PRIVATE(mp_gamma_bb, q_gamma_bb) &
6731!$OMP PRIVATE(mp_laplace_rhoa, q_laplace_rhoa) &
6732!$OMP PRIVATE(mp_laplace_rhob, q_laplace_rhob) &
6733!$OMP PRIVATE(mp_tau_a, q_tau_a) &
6734!$OMP PRIVATE(mp_tau_b, q_tau_b) &
6735!$OMP PRIVATE(mpp_gamma_aa, nB_gamma_aa) &
6736!$OMP PRIVATE(mpp_gamma_ab, nB_gamma_ab) &
6737!$OMP PRIVATE(mpp_gamma_bb, nB_gamma_bb) &
6738!$OMP SHARED(n_rhoa_rhoa) &
6739!$OMP SHARED(n_rhoa_rhob) &
6740!$OMP SHARED(n_rhoa_gamma_aa) &
6741!$OMP SHARED(n_rhoa_gamma_ab) &
6742!$OMP SHARED(n_rhoa_gamma_bb) &
6743!$OMP SHARED(n_rhoa_laplace_rhoa) &
6744!$OMP SHARED(n_rhoa_laplace_rhob) &
6745!$OMP SHARED(n_rhoa_tau_a) &
6746!$OMP SHARED(n_rhoa_tau_b) &
6747!$OMP SHARED(n_rhob_rhob) &
6748!$OMP SHARED(n_rhob_gamma_aa) &
6749!$OMP SHARED(n_rhob_gamma_ab) &
6750!$OMP SHARED(n_rhob_gamma_bb) &
6751!$OMP SHARED(n_rhob_laplace_rhoa) &
6752!$OMP SHARED(n_rhob_laplace_rhob) &
6753!$OMP SHARED(n_rhob_tau_a) &
6754!$OMP SHARED(n_rhob_tau_b) &
6755!$OMP SHARED(n_gamma_aa_gamma_aa) &
6756!$OMP SHARED(n_gamma_aa_gamma_ab) &
6757!$OMP SHARED(n_gamma_aa_gamma_bb) &
6758!$OMP SHARED(n_gamma_aa_laplace_rhoa) &
6759!$OMP SHARED(n_gamma_aa_laplace_rhob) &
6760!$OMP SHARED(n_gamma_aa_tau_a) &
6761!$OMP SHARED(n_gamma_aa_tau_b) &
6762!$OMP SHARED(n_gamma_ab_gamma_ab) &
6763!$OMP SHARED(n_gamma_ab_gamma_bb) &
6764!$OMP SHARED(n_gamma_ab_laplace_rhoa) &
6765!$OMP SHARED(n_gamma_ab_laplace_rhob) &
6766!$OMP SHARED(n_gamma_ab_tau_a) &
6767!$OMP SHARED(n_gamma_ab_tau_b) &
6768!$OMP SHARED(n_gamma_bb_gamma_bb) &
6769!$OMP SHARED(n_gamma_bb_laplace_rhoa) &
6770!$OMP SHARED(n_gamma_bb_laplace_rhob) &
6771!$OMP SHARED(n_gamma_bb_tau_a) &
6772!$OMP SHARED(n_gamma_bb_tau_b) &
6773!$OMP SHARED(n_laplace_rhoa_laplace_rhoa) &
6774!$OMP SHARED(n_laplace_rhoa_laplace_rhob) &
6775!$OMP SHARED(n_laplace_rhoa_tau_a) &
6776!$OMP SHARED(n_laplace_rhoa_tau_b) &
6777!$OMP SHARED(n_laplace_rhob_laplace_rhob) &
6778!$OMP SHARED(n_laplace_rhob_tau_a) &
6779!$OMP SHARED(n_laplace_rhob_tau_b) &
6780!$OMP SHARED(n_tau_a_tau_a) &
6781!$OMP SHARED(n_tau_a_tau_b) &
6782!$OMP SHARED(n_tau_b_tau_b) &
6783!$OMP SHARED(n_rhoa_rhoa_rhoa) &
6784!$OMP SHARED(n_rhoa_rhoa_rhob) &
6785!$OMP SHARED(n_rhoa_rhoa_gamma_aa) &
6786!$OMP SHARED(n_rhoa_rhoa_gamma_ab) &
6787!$OMP SHARED(n_rhoa_rhoa_gamma_bb) &
6788!$OMP SHARED(n_rhoa_rhoa_laplace_rhoa) &
6789!$OMP SHARED(n_rhoa_rhoa_laplace_rhob) &
6790!$OMP SHARED(n_rhoa_rhoa_tau_a) &
6791!$OMP SHARED(n_rhoa_rhoa_tau_b) &
6792!$OMP SHARED(n_rhoa_rhob_rhob) &
6793!$OMP SHARED(n_rhoa_rhob_gamma_aa) &
6794!$OMP SHARED(n_rhoa_rhob_gamma_ab) &
6795!$OMP SHARED(n_rhoa_rhob_gamma_bb) &
6796!$OMP SHARED(n_rhoa_rhob_laplace_rhoa) &
6797!$OMP SHARED(n_rhoa_rhob_laplace_rhob) &
6798!$OMP SHARED(n_rhoa_rhob_tau_a) &
6799!$OMP SHARED(n_rhoa_rhob_tau_b) &
6800!$OMP SHARED(n_rhoa_gamma_aa_gamma_aa) &
6801!$OMP SHARED(n_rhoa_gamma_aa_gamma_ab) &
6802!$OMP SHARED(n_rhoa_gamma_aa_gamma_bb) &
6803!$OMP SHARED(n_rhoa_gamma_aa_laplace_rhoa) &
6804!$OMP SHARED(n_rhoa_gamma_aa_laplace_rhob) &
6805!$OMP SHARED(n_rhoa_gamma_aa_tau_a) &
6806!$OMP SHARED(n_rhoa_gamma_aa_tau_b) &
6807!$OMP SHARED(n_rhoa_gamma_ab_gamma_ab) &
6808!$OMP SHARED(n_rhoa_gamma_ab_gamma_bb) &
6809!$OMP SHARED(n_rhoa_gamma_ab_laplace_rhoa) &
6810!$OMP SHARED(n_rhoa_gamma_ab_laplace_rhob) &
6811!$OMP SHARED(n_rhoa_gamma_ab_tau_a) &
6812!$OMP SHARED(n_rhoa_gamma_ab_tau_b) &
6813!$OMP SHARED(n_rhoa_gamma_bb_gamma_bb) &
6814!$OMP SHARED(n_rhoa_gamma_bb_laplace_rhoa) &
6815!$OMP SHARED(n_rhoa_gamma_bb_laplace_rhob) &
6816!$OMP SHARED(n_rhoa_gamma_bb_tau_a) &
6817!$OMP SHARED(n_rhoa_gamma_bb_tau_b) &
6818!$OMP SHARED(n_rhoa_laplace_rhoa_laplace_rhoa) &
6819!$OMP SHARED(n_rhoa_laplace_rhoa_laplace_rhob) &
6820!$OMP SHARED(n_rhoa_laplace_rhoa_tau_a) &
6821!$OMP SHARED(n_rhoa_laplace_rhoa_tau_b) &
6822!$OMP SHARED(n_rhoa_laplace_rhob_laplace_rhob) &
6823!$OMP SHARED(n_rhoa_laplace_rhob_tau_a) &
6824!$OMP SHARED(n_rhoa_laplace_rhob_tau_b) &
6825!$OMP SHARED(n_rhoa_tau_a_tau_a) &
6826!$OMP SHARED(n_rhoa_tau_a_tau_b) &
6827!$OMP SHARED(n_rhoa_tau_b_tau_b) &
6828!$OMP SHARED(n_rhob_rhob_rhob) &
6829!$OMP SHARED(n_rhob_rhob_gamma_aa) &
6830!$OMP SHARED(n_rhob_rhob_gamma_ab) &
6831!$OMP SHARED(n_rhob_rhob_gamma_bb) &
6832!$OMP SHARED(n_rhob_rhob_laplace_rhoa) &
6833!$OMP SHARED(n_rhob_rhob_laplace_rhob) &
6834!$OMP SHARED(n_rhob_rhob_tau_a) &
6835!$OMP SHARED(n_rhob_rhob_tau_b) &
6836!$OMP SHARED(n_rhob_gamma_aa_gamma_aa) &
6837!$OMP SHARED(n_rhob_gamma_aa_gamma_ab) &
6838!$OMP SHARED(n_rhob_gamma_aa_gamma_bb) &
6839!$OMP SHARED(n_rhob_gamma_aa_laplace_rhoa) &
6840!$OMP SHARED(n_rhob_gamma_aa_laplace_rhob) &
6841!$OMP SHARED(n_rhob_gamma_aa_tau_a) &
6842!$OMP SHARED(n_rhob_gamma_aa_tau_b) &
6843!$OMP SHARED(n_rhob_gamma_ab_gamma_ab) &
6844!$OMP SHARED(n_rhob_gamma_ab_gamma_bb) &
6845!$OMP SHARED(n_rhob_gamma_ab_laplace_rhoa) &
6846!$OMP SHARED(n_rhob_gamma_ab_laplace_rhob) &
6847!$OMP SHARED(n_rhob_gamma_ab_tau_a) &
6848!$OMP SHARED(n_rhob_gamma_ab_tau_b) &
6849!$OMP SHARED(n_rhob_gamma_bb_gamma_bb) &
6850!$OMP SHARED(n_rhob_gamma_bb_laplace_rhoa) &
6851!$OMP SHARED(n_rhob_gamma_bb_laplace_rhob) &
6852!$OMP SHARED(n_rhob_gamma_bb_tau_a) &
6853!$OMP SHARED(n_rhob_gamma_bb_tau_b) &
6854!$OMP SHARED(n_rhob_laplace_rhoa_laplace_rhoa) &
6855!$OMP SHARED(n_rhob_laplace_rhoa_laplace_rhob) &
6856!$OMP SHARED(n_rhob_laplace_rhoa_tau_a) &
6857!$OMP SHARED(n_rhob_laplace_rhoa_tau_b) &
6858!$OMP SHARED(n_rhob_laplace_rhob_laplace_rhob) &
6859!$OMP SHARED(n_rhob_laplace_rhob_tau_a) &
6860!$OMP SHARED(n_rhob_laplace_rhob_tau_b) &
6861!$OMP SHARED(n_rhob_tau_a_tau_a) &
6862!$OMP SHARED(n_rhob_tau_a_tau_b) &
6863!$OMP SHARED(n_rhob_tau_b_tau_b) &
6864!$OMP SHARED(n_gamma_aa_gamma_aa_gamma_aa) &
6865!$OMP SHARED(n_gamma_aa_gamma_aa_gamma_ab) &
6866!$OMP SHARED(n_gamma_aa_gamma_aa_gamma_bb) &
6867!$OMP SHARED(n_gamma_aa_gamma_aa_laplace_rhoa) &
6868!$OMP SHARED(n_gamma_aa_gamma_aa_laplace_rhob) &
6869!$OMP SHARED(n_gamma_aa_gamma_aa_tau_a) &
6870!$OMP SHARED(n_gamma_aa_gamma_aa_tau_b) &
6871!$OMP SHARED(n_gamma_aa_gamma_ab_gamma_ab) &
6872!$OMP SHARED(n_gamma_aa_gamma_ab_gamma_bb) &
6873!$OMP SHARED(n_gamma_aa_gamma_ab_laplace_rhoa) &
6874!$OMP SHARED(n_gamma_aa_gamma_ab_laplace_rhob) &
6875!$OMP SHARED(n_gamma_aa_gamma_ab_tau_a) &
6876!$OMP SHARED(n_gamma_aa_gamma_ab_tau_b) &
6877!$OMP SHARED(n_gamma_aa_gamma_bb_gamma_bb) &
6878!$OMP SHARED(n_gamma_aa_gamma_bb_laplace_rhoa) &
6879!$OMP SHARED(n_gamma_aa_gamma_bb_laplace_rhob) &
6880!$OMP SHARED(n_gamma_aa_gamma_bb_tau_a) &
6881!$OMP SHARED(n_gamma_aa_gamma_bb_tau_b) &
6882!$OMP SHARED(n_gamma_aa_laplace_rhoa_laplace_rhoa) &
6883!$OMP SHARED(n_gamma_aa_laplace_rhoa_laplace_rhob) &
6884!$OMP SHARED(n_gamma_aa_laplace_rhoa_tau_a) &
6885!$OMP SHARED(n_gamma_aa_laplace_rhoa_tau_b) &
6886!$OMP SHARED(n_gamma_aa_laplace_rhob_laplace_rhob) &
6887!$OMP SHARED(n_gamma_aa_laplace_rhob_tau_a) &
6888!$OMP SHARED(n_gamma_aa_laplace_rhob_tau_b) &
6889!$OMP SHARED(n_gamma_aa_tau_a_tau_a) &
6890!$OMP SHARED(n_gamma_aa_tau_a_tau_b) &
6891!$OMP SHARED(n_gamma_aa_tau_b_tau_b) &
6892!$OMP SHARED(n_gamma_ab_gamma_ab_gamma_ab) &
6893!$OMP SHARED(n_gamma_ab_gamma_ab_gamma_bb) &
6894!$OMP SHARED(n_gamma_ab_gamma_ab_laplace_rhoa) &
6895!$OMP SHARED(n_gamma_ab_gamma_ab_laplace_rhob) &
6896!$OMP SHARED(n_gamma_ab_gamma_ab_tau_a) &
6897!$OMP SHARED(n_gamma_ab_gamma_ab_tau_b) &
6898!$OMP SHARED(n_gamma_ab_gamma_bb_gamma_bb) &
6899!$OMP SHARED(n_gamma_ab_gamma_bb_laplace_rhoa) &
6900!$OMP SHARED(n_gamma_ab_gamma_bb_laplace_rhob) &
6901!$OMP SHARED(n_gamma_ab_gamma_bb_tau_a) &
6902!$OMP SHARED(n_gamma_ab_gamma_bb_tau_b) &
6903!$OMP SHARED(n_gamma_ab_laplace_rhoa_laplace_rhoa) &
6904!$OMP SHARED(n_gamma_ab_laplace_rhoa_laplace_rhob) &
6905!$OMP SHARED(n_gamma_ab_laplace_rhoa_tau_a) &
6906!$OMP SHARED(n_gamma_ab_laplace_rhoa_tau_b) &
6907!$OMP SHARED(n_gamma_ab_laplace_rhob_laplace_rhob) &
6908!$OMP SHARED(n_gamma_ab_laplace_rhob_tau_a) &
6909!$OMP SHARED(n_gamma_ab_laplace_rhob_tau_b) &
6910!$OMP SHARED(n_gamma_ab_tau_a_tau_a) &
6911!$OMP SHARED(n_gamma_ab_tau_a_tau_b) &
6912!$OMP SHARED(n_gamma_ab_tau_b_tau_b) &
6913!$OMP SHARED(n_gamma_bb_gamma_bb_gamma_bb) &
6914!$OMP SHARED(n_gamma_bb_gamma_bb_laplace_rhoa) &
6915!$OMP SHARED(n_gamma_bb_gamma_bb_laplace_rhob) &
6916!$OMP SHARED(n_gamma_bb_gamma_bb_tau_a) &
6917!$OMP SHARED(n_gamma_bb_gamma_bb_tau_b) &
6918!$OMP SHARED(n_gamma_bb_laplace_rhoa_laplace_rhoa) &
6919!$OMP SHARED(n_gamma_bb_laplace_rhoa_laplace_rhob) &
6920!$OMP SHARED(n_gamma_bb_laplace_rhoa_tau_a) &
6921!$OMP SHARED(n_gamma_bb_laplace_rhoa_tau_b) &
6922!$OMP SHARED(n_gamma_bb_laplace_rhob_laplace_rhob) &
6923!$OMP SHARED(n_gamma_bb_laplace_rhob_tau_a) &
6924!$OMP SHARED(n_gamma_bb_laplace_rhob_tau_b) &
6925!$OMP SHARED(n_gamma_bb_tau_a_tau_a) &
6926!$OMP SHARED(n_gamma_bb_tau_a_tau_b) &
6927!$OMP SHARED(n_gamma_bb_tau_b_tau_b) &
6928!$OMP SHARED(n_laplace_rhoa_laplace_rhoa_laplace_rhoa) &
6929!$OMP SHARED(n_laplace_rhoa_laplace_rhoa_laplace_rhob) &
6930!$OMP SHARED(n_laplace_rhoa_laplace_rhoa_tau_a) &
6931!$OMP SHARED(n_laplace_rhoa_laplace_rhoa_tau_b) &
6932!$OMP SHARED(n_laplace_rhoa_laplace_rhob_laplace_rhob) &
6933!$OMP SHARED(n_laplace_rhoa_laplace_rhob_tau_a) &
6934!$OMP SHARED(n_laplace_rhoa_laplace_rhob_tau_b) &
6935!$OMP SHARED(n_laplace_rhoa_tau_a_tau_a) &
6936!$OMP SHARED(n_laplace_rhoa_tau_a_tau_b) &
6937!$OMP SHARED(n_laplace_rhoa_tau_b_tau_b) &
6938!$OMP SHARED(n_laplace_rhob_laplace_rhob_laplace_rhob) &
6939!$OMP SHARED(n_laplace_rhob_laplace_rhob_tau_a) &
6940!$OMP SHARED(n_laplace_rhob_laplace_rhob_tau_b) &
6941!$OMP SHARED(n_laplace_rhob_tau_a_tau_a) &
6942!$OMP SHARED(n_laplace_rhob_tau_a_tau_b) &
6943!$OMP SHARED(n_laplace_rhob_tau_b_tau_b) &
6944!$OMP SHARED(n_tau_a_tau_a_tau_a) &
6945!$OMP SHARED(n_tau_a_tau_a_tau_b) &
6946!$OMP SHARED(n_tau_a_tau_b_tau_b) &
6947!$OMP SHARED(n_tau_b_tau_b_tau_b) &
6948!$OMP SHARED(bo,rho1a,rho1b,gaa1,gab1,gbb1,gaa11,gab11,gbb11, &
6949!$OMP tau_f,tau1a,tau1b,laplace_f,laplace1a,laplace1b, &
6950!$OMP v_xc,v_xc_tau,v_laplace,v_drho_r,drhoa,drhob,drho1a,drho1b)
6951 DO k = bo(1, 3), bo(2, 3)
6952 DO j = bo(1, 2), bo(2, 2)
6953 DO i = bo(1, 1), bo(2, 1)
6954 mp_rhoa = rho1a(i, j, k)
6955 mp_rhob = rho1b(i, j, k)
6956 mp_gamma_aa = 2.0_dp*gaa1(i, j, k)
6957 mp_gamma_ab = gab1(i, j, k)
6958 mp_gamma_bb = 2.0_dp*gbb1(i, j, k)
6959 mpp_gamma_aa = 2.0_dp*gaa11(i, j, k)
6960 mpp_gamma_ab = 2.0_dp*gab11(i, j, k)
6961 mpp_gamma_bb = 2.0_dp*gbb11(i, j, k)
6962 mp_tau_a = 0.0_dp
6963 mp_tau_b = 0.0_dp
6964 IF (tau_f) mp_tau_a = tau1a(i, j, k)
6965 IF (tau_f) mp_tau_b = tau1b(i, j, k)
6966 mp_laplace_rhoa = 0.0_dp
6967 mp_laplace_rhob = 0.0_dp
6968 IF (laplace_f) mp_laplace_rhoa = laplace1a(i, j, k)
6969 IF (laplace_f) mp_laplace_rhob = laplace1b(i, j, k)
6970
6971 q_rhoa = 0.0_dp
6972 q_rhoa = q_rhoa + 1.0_dp* &
6973 n_rhoa_rhoa_rhoa(i, j, k)*mp_rhoa*mp_rhoa
6974 q_rhoa = q_rhoa + 2.0_dp* &
6975 n_rhoa_rhoa_rhob(i, j, k)*mp_rhoa*mp_rhob
6976 q_rhoa = q_rhoa + 2.0_dp* &
6977 n_rhoa_rhoa_gamma_aa(i, j, k)*mp_rhoa*mp_gamma_aa
6978 q_rhoa = q_rhoa + 2.0_dp* &
6979 n_rhoa_rhoa_gamma_ab(i, j, k)*mp_rhoa*mp_gamma_ab
6980 q_rhoa = q_rhoa + 2.0_dp* &
6981 n_rhoa_rhoa_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_bb
6982 q_rhoa = q_rhoa + 2.0_dp* &
6983 n_rhoa_rhoa_laplace_rhoa(i, j, k)*mp_rhoa*mp_laplace_rhoa
6984 q_rhoa = q_rhoa + 2.0_dp* &
6985 n_rhoa_rhoa_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
6986 q_rhoa = q_rhoa + 2.0_dp* &
6987 n_rhoa_rhoa_tau_a(i, j, k)*mp_rhoa*mp_tau_a
6988 q_rhoa = q_rhoa + 2.0_dp* &
6989 n_rhoa_rhoa_tau_b(i, j, k)*mp_rhoa*mp_tau_b
6990 q_rhoa = q_rhoa + 1.0_dp* &
6991 n_rhoa_rhob_rhob(i, j, k)*mp_rhob*mp_rhob
6992 q_rhoa = q_rhoa + 2.0_dp* &
6993 n_rhoa_rhob_gamma_aa(i, j, k)*mp_rhob*mp_gamma_aa
6994 q_rhoa = q_rhoa + 2.0_dp* &
6995 n_rhoa_rhob_gamma_ab(i, j, k)*mp_rhob*mp_gamma_ab
6996 q_rhoa = q_rhoa + 2.0_dp* &
6997 n_rhoa_rhob_gamma_bb(i, j, k)*mp_rhob*mp_gamma_bb
6998 q_rhoa = q_rhoa + 2.0_dp* &
6999 n_rhoa_rhob_laplace_rhoa(i, j, k)*mp_rhob*mp_laplace_rhoa
7000 q_rhoa = q_rhoa + 2.0_dp* &
7001 n_rhoa_rhob_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7002 q_rhoa = q_rhoa + 2.0_dp* &
7003 n_rhoa_rhob_tau_a(i, j, k)*mp_rhob*mp_tau_a
7004 q_rhoa = q_rhoa + 2.0_dp* &
7005 n_rhoa_rhob_tau_b(i, j, k)*mp_rhob*mp_tau_b
7006 q_rhoa = q_rhoa + 1.0_dp* &
7007 n_rhoa_gamma_aa_gamma_aa(i, j, k)*mp_gamma_aa*mp_gamma_aa
7008 q_rhoa = q_rhoa + 2.0_dp* &
7009 n_rhoa_gamma_aa_gamma_ab(i, j, k)*mp_gamma_aa*mp_gamma_ab
7010 q_rhoa = q_rhoa + 2.0_dp* &
7011 n_rhoa_gamma_aa_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_bb
7012 q_rhoa = q_rhoa + 2.0_dp* &
7013 n_rhoa_gamma_aa_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7014 q_rhoa = q_rhoa + 2.0_dp* &
7015 n_rhoa_gamma_aa_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7016 q_rhoa = q_rhoa + 2.0_dp* &
7017 n_rhoa_gamma_aa_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7018 q_rhoa = q_rhoa + 2.0_dp* &
7019 n_rhoa_gamma_aa_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7020 q_rhoa = q_rhoa + 1.0_dp* &
7021 n_rhoa_gamma_ab_gamma_ab(i, j, k)*mp_gamma_ab*mp_gamma_ab
7022 q_rhoa = q_rhoa + 2.0_dp* &
7023 n_rhoa_gamma_ab_gamma_bb(i, j, k)*mp_gamma_ab*mp_gamma_bb
7024 q_rhoa = q_rhoa + 2.0_dp* &
7025 n_rhoa_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7026 q_rhoa = q_rhoa + 2.0_dp* &
7027 n_rhoa_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7028 q_rhoa = q_rhoa + 2.0_dp* &
7029 n_rhoa_gamma_ab_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7030 q_rhoa = q_rhoa + 2.0_dp* &
7031 n_rhoa_gamma_ab_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7032 q_rhoa = q_rhoa + 1.0_dp* &
7033 n_rhoa_gamma_bb_gamma_bb(i, j, k)*mp_gamma_bb*mp_gamma_bb
7034 q_rhoa = q_rhoa + 2.0_dp* &
7035 n_rhoa_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7036 q_rhoa = q_rhoa + 2.0_dp* &
7037 n_rhoa_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7038 q_rhoa = q_rhoa + 2.0_dp* &
7039 n_rhoa_gamma_bb_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7040 q_rhoa = q_rhoa + 2.0_dp* &
7041 n_rhoa_gamma_bb_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7042 q_rhoa = q_rhoa + 1.0_dp* &
7043 n_rhoa_laplace_rhoa_laplace_rhoa(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7044 q_rhoa = q_rhoa + 2.0_dp* &
7045 n_rhoa_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7046 q_rhoa = q_rhoa + 2.0_dp* &
7047 n_rhoa_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7048 q_rhoa = q_rhoa + 2.0_dp* &
7049 n_rhoa_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7050 q_rhoa = q_rhoa + 1.0_dp* &
7051 n_rhoa_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7052 q_rhoa = q_rhoa + 2.0_dp* &
7053 n_rhoa_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7054 q_rhoa = q_rhoa + 2.0_dp* &
7055 n_rhoa_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7056 q_rhoa = q_rhoa + 1.0_dp* &
7057 n_rhoa_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7058 q_rhoa = q_rhoa + 2.0_dp* &
7059 n_rhoa_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7060 q_rhoa = q_rhoa + 1.0_dp* &
7061 n_rhoa_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7062 q_rhoa = q_rhoa + n_rhoa_gamma_aa(i, j, k)*mpp_gamma_aa
7063 q_rhoa = q_rhoa + n_rhoa_gamma_ab(i, j, k)*mpp_gamma_ab
7064 q_rhoa = q_rhoa + n_rhoa_gamma_bb(i, j, k)*mpp_gamma_bb
7065 q_rhob = 0.0_dp
7066 q_rhob = q_rhob + 1.0_dp* &
7067 n_rhoa_rhoa_rhob(i, j, k)*mp_rhoa*mp_rhoa
7068 q_rhob = q_rhob + 2.0_dp* &
7069 n_rhoa_rhob_rhob(i, j, k)*mp_rhoa*mp_rhob
7070 q_rhob = q_rhob + 2.0_dp* &
7071 n_rhoa_rhob_gamma_aa(i, j, k)*mp_rhoa*mp_gamma_aa
7072 q_rhob = q_rhob + 2.0_dp* &
7073 n_rhoa_rhob_gamma_ab(i, j, k)*mp_rhoa*mp_gamma_ab
7074 q_rhob = q_rhob + 2.0_dp* &
7075 n_rhoa_rhob_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_bb
7076 q_rhob = q_rhob + 2.0_dp* &
7077 n_rhoa_rhob_laplace_rhoa(i, j, k)*mp_rhoa*mp_laplace_rhoa
7078 q_rhob = q_rhob + 2.0_dp* &
7079 n_rhoa_rhob_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
7080 q_rhob = q_rhob + 2.0_dp* &
7081 n_rhoa_rhob_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7082 q_rhob = q_rhob + 2.0_dp* &
7083 n_rhoa_rhob_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7084 q_rhob = q_rhob + 1.0_dp* &
7085 n_rhob_rhob_rhob(i, j, k)*mp_rhob*mp_rhob
7086 q_rhob = q_rhob + 2.0_dp* &
7087 n_rhob_rhob_gamma_aa(i, j, k)*mp_rhob*mp_gamma_aa
7088 q_rhob = q_rhob + 2.0_dp* &
7089 n_rhob_rhob_gamma_ab(i, j, k)*mp_rhob*mp_gamma_ab
7090 q_rhob = q_rhob + 2.0_dp* &
7091 n_rhob_rhob_gamma_bb(i, j, k)*mp_rhob*mp_gamma_bb
7092 q_rhob = q_rhob + 2.0_dp* &
7093 n_rhob_rhob_laplace_rhoa(i, j, k)*mp_rhob*mp_laplace_rhoa
7094 q_rhob = q_rhob + 2.0_dp* &
7095 n_rhob_rhob_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7096 q_rhob = q_rhob + 2.0_dp* &
7097 n_rhob_rhob_tau_a(i, j, k)*mp_rhob*mp_tau_a
7098 q_rhob = q_rhob + 2.0_dp* &
7099 n_rhob_rhob_tau_b(i, j, k)*mp_rhob*mp_tau_b
7100 q_rhob = q_rhob + 1.0_dp* &
7101 n_rhob_gamma_aa_gamma_aa(i, j, k)*mp_gamma_aa*mp_gamma_aa
7102 q_rhob = q_rhob + 2.0_dp* &
7103 n_rhob_gamma_aa_gamma_ab(i, j, k)*mp_gamma_aa*mp_gamma_ab
7104 q_rhob = q_rhob + 2.0_dp* &
7105 n_rhob_gamma_aa_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_bb
7106 q_rhob = q_rhob + 2.0_dp* &
7107 n_rhob_gamma_aa_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7108 q_rhob = q_rhob + 2.0_dp* &
7109 n_rhob_gamma_aa_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7110 q_rhob = q_rhob + 2.0_dp* &
7111 n_rhob_gamma_aa_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7112 q_rhob = q_rhob + 2.0_dp* &
7113 n_rhob_gamma_aa_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7114 q_rhob = q_rhob + 1.0_dp* &
7115 n_rhob_gamma_ab_gamma_ab(i, j, k)*mp_gamma_ab*mp_gamma_ab
7116 q_rhob = q_rhob + 2.0_dp* &
7117 n_rhob_gamma_ab_gamma_bb(i, j, k)*mp_gamma_ab*mp_gamma_bb
7118 q_rhob = q_rhob + 2.0_dp* &
7119 n_rhob_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7120 q_rhob = q_rhob + 2.0_dp* &
7121 n_rhob_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7122 q_rhob = q_rhob + 2.0_dp* &
7123 n_rhob_gamma_ab_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7124 q_rhob = q_rhob + 2.0_dp* &
7125 n_rhob_gamma_ab_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7126 q_rhob = q_rhob + 1.0_dp* &
7127 n_rhob_gamma_bb_gamma_bb(i, j, k)*mp_gamma_bb*mp_gamma_bb
7128 q_rhob = q_rhob + 2.0_dp* &
7129 n_rhob_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7130 q_rhob = q_rhob + 2.0_dp* &
7131 n_rhob_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7132 q_rhob = q_rhob + 2.0_dp* &
7133 n_rhob_gamma_bb_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7134 q_rhob = q_rhob + 2.0_dp* &
7135 n_rhob_gamma_bb_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7136 q_rhob = q_rhob + 1.0_dp* &
7137 n_rhob_laplace_rhoa_laplace_rhoa(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7138 q_rhob = q_rhob + 2.0_dp* &
7139 n_rhob_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7140 q_rhob = q_rhob + 2.0_dp* &
7141 n_rhob_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7142 q_rhob = q_rhob + 2.0_dp* &
7143 n_rhob_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7144 q_rhob = q_rhob + 1.0_dp* &
7145 n_rhob_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7146 q_rhob = q_rhob + 2.0_dp* &
7147 n_rhob_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7148 q_rhob = q_rhob + 2.0_dp* &
7149 n_rhob_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7150 q_rhob = q_rhob + 1.0_dp* &
7151 n_rhob_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7152 q_rhob = q_rhob + 2.0_dp* &
7153 n_rhob_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7154 q_rhob = q_rhob + 1.0_dp* &
7155 n_rhob_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7156 q_rhob = q_rhob + n_rhob_gamma_aa(i, j, k)*mpp_gamma_aa
7157 q_rhob = q_rhob + n_rhob_gamma_ab(i, j, k)*mpp_gamma_ab
7158 q_rhob = q_rhob + n_rhob_gamma_bb(i, j, k)*mpp_gamma_bb
7159 q_gamma_aa = 0.0_dp
7160 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7161 n_rhoa_rhoa_gamma_aa(i, j, k)*mp_rhoa*mp_rhoa
7162 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7163 n_rhoa_rhob_gamma_aa(i, j, k)*mp_rhoa*mp_rhob
7164 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7165 n_rhoa_gamma_aa_gamma_aa(i, j, k)*mp_rhoa*mp_gamma_aa
7166 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7167 n_rhoa_gamma_aa_gamma_ab(i, j, k)*mp_rhoa*mp_gamma_ab
7168 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7169 n_rhoa_gamma_aa_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_bb
7170 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7171 n_rhoa_gamma_aa_laplace_rhoa(i, j, k)*mp_rhoa*mp_laplace_rhoa
7172 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7173 n_rhoa_gamma_aa_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
7174 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7175 n_rhoa_gamma_aa_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7176 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7177 n_rhoa_gamma_aa_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7178 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7179 n_rhob_rhob_gamma_aa(i, j, k)*mp_rhob*mp_rhob
7180 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7181 n_rhob_gamma_aa_gamma_aa(i, j, k)*mp_rhob*mp_gamma_aa
7182 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7183 n_rhob_gamma_aa_gamma_ab(i, j, k)*mp_rhob*mp_gamma_ab
7184 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7185 n_rhob_gamma_aa_gamma_bb(i, j, k)*mp_rhob*mp_gamma_bb
7186 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7187 n_rhob_gamma_aa_laplace_rhoa(i, j, k)*mp_rhob*mp_laplace_rhoa
7188 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7189 n_rhob_gamma_aa_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7190 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7191 n_rhob_gamma_aa_tau_a(i, j, k)*mp_rhob*mp_tau_a
7192 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7193 n_rhob_gamma_aa_tau_b(i, j, k)*mp_rhob*mp_tau_b
7194 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7195 n_gamma_aa_gamma_aa_gamma_aa(i, j, k)*mp_gamma_aa*mp_gamma_aa
7196 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7197 n_gamma_aa_gamma_aa_gamma_ab(i, j, k)*mp_gamma_aa*mp_gamma_ab
7198 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7199 n_gamma_aa_gamma_aa_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_bb
7200 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7201 n_gamma_aa_gamma_aa_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7202 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7203 n_gamma_aa_gamma_aa_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7204 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7205 n_gamma_aa_gamma_aa_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7206 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7207 n_gamma_aa_gamma_aa_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7208 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7209 n_gamma_aa_gamma_ab_gamma_ab(i, j, k)*mp_gamma_ab*mp_gamma_ab
7210 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7211 n_gamma_aa_gamma_ab_gamma_bb(i, j, k)*mp_gamma_ab*mp_gamma_bb
7212 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7213 n_gamma_aa_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7214 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7215 n_gamma_aa_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7216 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7217 n_gamma_aa_gamma_ab_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7218 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7219 n_gamma_aa_gamma_ab_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7220 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7221 n_gamma_aa_gamma_bb_gamma_bb(i, j, k)*mp_gamma_bb*mp_gamma_bb
7222 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7223 n_gamma_aa_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7224 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7225 n_gamma_aa_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7226 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7227 n_gamma_aa_gamma_bb_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7228 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7229 n_gamma_aa_gamma_bb_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7230 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7231 n_gamma_aa_laplace_rhoa_laplace_rhoa(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7232 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7233 n_gamma_aa_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7234 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7235 n_gamma_aa_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7236 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7237 n_gamma_aa_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7238 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7239 n_gamma_aa_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7240 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7241 n_gamma_aa_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7242 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7243 n_gamma_aa_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7244 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7245 n_gamma_aa_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7246 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7247 n_gamma_aa_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7248 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7249 n_gamma_aa_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7250 q_gamma_aa = q_gamma_aa + n_gamma_aa_gamma_aa(i, j, k)*mpp_gamma_aa
7251 q_gamma_aa = q_gamma_aa + n_gamma_aa_gamma_ab(i, j, k)*mpp_gamma_ab
7252 q_gamma_aa = q_gamma_aa + n_gamma_aa_gamma_bb(i, j, k)*mpp_gamma_bb
7253 q_gamma_ab = 0.0_dp
7254 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7255 n_rhoa_rhoa_gamma_ab(i, j, k)*mp_rhoa*mp_rhoa
7256 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7257 n_rhoa_rhob_gamma_ab(i, j, k)*mp_rhoa*mp_rhob
7258 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7259 n_rhoa_gamma_aa_gamma_ab(i, j, k)*mp_rhoa*mp_gamma_aa
7260 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7261 n_rhoa_gamma_ab_gamma_ab(i, j, k)*mp_rhoa*mp_gamma_ab
7262 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7263 n_rhoa_gamma_ab_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_bb
7264 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7265 n_rhoa_gamma_ab_laplace_rhoa(i, j, k)*mp_rhoa*mp_laplace_rhoa
7266 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7267 n_rhoa_gamma_ab_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
7268 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7269 n_rhoa_gamma_ab_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7270 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7271 n_rhoa_gamma_ab_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7272 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7273 n_rhob_rhob_gamma_ab(i, j, k)*mp_rhob*mp_rhob
7274 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7275 n_rhob_gamma_aa_gamma_ab(i, j, k)*mp_rhob*mp_gamma_aa
7276 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7277 n_rhob_gamma_ab_gamma_ab(i, j, k)*mp_rhob*mp_gamma_ab
7278 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7279 n_rhob_gamma_ab_gamma_bb(i, j, k)*mp_rhob*mp_gamma_bb
7280 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7281 n_rhob_gamma_ab_laplace_rhoa(i, j, k)*mp_rhob*mp_laplace_rhoa
7282 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7283 n_rhob_gamma_ab_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7284 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7285 n_rhob_gamma_ab_tau_a(i, j, k)*mp_rhob*mp_tau_a
7286 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7287 n_rhob_gamma_ab_tau_b(i, j, k)*mp_rhob*mp_tau_b
7288 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7289 n_gamma_aa_gamma_aa_gamma_ab(i, j, k)*mp_gamma_aa*mp_gamma_aa
7290 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7291 n_gamma_aa_gamma_ab_gamma_ab(i, j, k)*mp_gamma_aa*mp_gamma_ab
7292 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7293 n_gamma_aa_gamma_ab_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_bb
7294 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7295 n_gamma_aa_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7296 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7297 n_gamma_aa_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7298 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7299 n_gamma_aa_gamma_ab_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7300 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7301 n_gamma_aa_gamma_ab_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7302 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7303 n_gamma_ab_gamma_ab_gamma_ab(i, j, k)*mp_gamma_ab*mp_gamma_ab
7304 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7305 n_gamma_ab_gamma_ab_gamma_bb(i, j, k)*mp_gamma_ab*mp_gamma_bb
7306 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7307 n_gamma_ab_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7308 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7309 n_gamma_ab_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7310 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7311 n_gamma_ab_gamma_ab_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7312 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7313 n_gamma_ab_gamma_ab_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7314 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7315 n_gamma_ab_gamma_bb_gamma_bb(i, j, k)*mp_gamma_bb*mp_gamma_bb
7316 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7317 n_gamma_ab_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7318 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7319 n_gamma_ab_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7320 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7321 n_gamma_ab_gamma_bb_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7322 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7323 n_gamma_ab_gamma_bb_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7324 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7325 n_gamma_ab_laplace_rhoa_laplace_rhoa(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7326 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7327 n_gamma_ab_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7328 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7329 n_gamma_ab_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7330 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7331 n_gamma_ab_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7332 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7333 n_gamma_ab_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7334 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7335 n_gamma_ab_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7336 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7337 n_gamma_ab_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7338 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7339 n_gamma_ab_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7340 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7341 n_gamma_ab_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7342 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7343 n_gamma_ab_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7344 q_gamma_ab = q_gamma_ab + n_gamma_aa_gamma_ab(i, j, k)*mpp_gamma_aa
7345 q_gamma_ab = q_gamma_ab + n_gamma_ab_gamma_ab(i, j, k)*mpp_gamma_ab
7346 q_gamma_ab = q_gamma_ab + n_gamma_ab_gamma_bb(i, j, k)*mpp_gamma_bb
7347 q_gamma_bb = 0.0_dp
7348 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7349 n_rhoa_rhoa_gamma_bb(i, j, k)*mp_rhoa*mp_rhoa
7350 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7351 n_rhoa_rhob_gamma_bb(i, j, k)*mp_rhoa*mp_rhob
7352 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7353 n_rhoa_gamma_aa_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_aa
7354 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7355 n_rhoa_gamma_ab_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_ab
7356 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7357 n_rhoa_gamma_bb_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_bb
7358 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7359 n_rhoa_gamma_bb_laplace_rhoa(i, j, k)*mp_rhoa*mp_laplace_rhoa
7360 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7361 n_rhoa_gamma_bb_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
7362 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7363 n_rhoa_gamma_bb_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7364 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7365 n_rhoa_gamma_bb_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7366 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7367 n_rhob_rhob_gamma_bb(i, j, k)*mp_rhob*mp_rhob
7368 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7369 n_rhob_gamma_aa_gamma_bb(i, j, k)*mp_rhob*mp_gamma_aa
7370 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7371 n_rhob_gamma_ab_gamma_bb(i, j, k)*mp_rhob*mp_gamma_ab
7372 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7373 n_rhob_gamma_bb_gamma_bb(i, j, k)*mp_rhob*mp_gamma_bb
7374 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7375 n_rhob_gamma_bb_laplace_rhoa(i, j, k)*mp_rhob*mp_laplace_rhoa
7376 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7377 n_rhob_gamma_bb_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7378 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7379 n_rhob_gamma_bb_tau_a(i, j, k)*mp_rhob*mp_tau_a
7380 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7381 n_rhob_gamma_bb_tau_b(i, j, k)*mp_rhob*mp_tau_b
7382 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7383 n_gamma_aa_gamma_aa_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_aa
7384 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7385 n_gamma_aa_gamma_ab_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_ab
7386 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7387 n_gamma_aa_gamma_bb_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_bb
7388 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7389 n_gamma_aa_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7390 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7391 n_gamma_aa_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7392 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7393 n_gamma_aa_gamma_bb_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7394 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7395 n_gamma_aa_gamma_bb_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7396 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7397 n_gamma_ab_gamma_ab_gamma_bb(i, j, k)*mp_gamma_ab*mp_gamma_ab
7398 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7399 n_gamma_ab_gamma_bb_gamma_bb(i, j, k)*mp_gamma_ab*mp_gamma_bb
7400 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7401 n_gamma_ab_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7402 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7403 n_gamma_ab_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7404 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7405 n_gamma_ab_gamma_bb_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7406 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7407 n_gamma_ab_gamma_bb_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7408 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7409 n_gamma_bb_gamma_bb_gamma_bb(i, j, k)*mp_gamma_bb*mp_gamma_bb
7410 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7411 n_gamma_bb_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7412 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7413 n_gamma_bb_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7414 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7415 n_gamma_bb_gamma_bb_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7416 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7417 n_gamma_bb_gamma_bb_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7418 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7419 n_gamma_bb_laplace_rhoa_laplace_rhoa(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7420 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7421 n_gamma_bb_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7422 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7423 n_gamma_bb_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7424 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7425 n_gamma_bb_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7426 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7427 n_gamma_bb_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7428 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7429 n_gamma_bb_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7430 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7431 n_gamma_bb_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7432 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7433 n_gamma_bb_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7434 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7435 n_gamma_bb_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7436 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7437 n_gamma_bb_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7438 q_gamma_bb = q_gamma_bb + n_gamma_aa_gamma_bb(i, j, k)*mpp_gamma_aa
7439 q_gamma_bb = q_gamma_bb + n_gamma_ab_gamma_bb(i, j, k)*mpp_gamma_ab
7440 q_gamma_bb = q_gamma_bb + n_gamma_bb_gamma_bb(i, j, k)*mpp_gamma_bb
7441 q_laplace_rhoa = 0.0_dp
7442 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7443 n_rhoa_rhoa_laplace_rhoa(i, j, k)*mp_rhoa*mp_rhoa
7444 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7445 n_rhoa_rhob_laplace_rhoa(i, j, k)*mp_rhoa*mp_rhob
7446 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7447 n_rhoa_gamma_aa_laplace_rhoa(i, j, k)*mp_rhoa*mp_gamma_aa
7448 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7449 n_rhoa_gamma_ab_laplace_rhoa(i, j, k)*mp_rhoa*mp_gamma_ab
7450 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7451 n_rhoa_gamma_bb_laplace_rhoa(i, j, k)*mp_rhoa*mp_gamma_bb
7452 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7453 n_rhoa_laplace_rhoa_laplace_rhoa(i, j, k)*mp_rhoa*mp_laplace_rhoa
7454 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7455 n_rhoa_laplace_rhoa_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
7456 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7457 n_rhoa_laplace_rhoa_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7458 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7459 n_rhoa_laplace_rhoa_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7460 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7461 n_rhob_rhob_laplace_rhoa(i, j, k)*mp_rhob*mp_rhob
7462 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7463 n_rhob_gamma_aa_laplace_rhoa(i, j, k)*mp_rhob*mp_gamma_aa
7464 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7465 n_rhob_gamma_ab_laplace_rhoa(i, j, k)*mp_rhob*mp_gamma_ab
7466 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7467 n_rhob_gamma_bb_laplace_rhoa(i, j, k)*mp_rhob*mp_gamma_bb
7468 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7469 n_rhob_laplace_rhoa_laplace_rhoa(i, j, k)*mp_rhob*mp_laplace_rhoa
7470 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7471 n_rhob_laplace_rhoa_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7472 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7473 n_rhob_laplace_rhoa_tau_a(i, j, k)*mp_rhob*mp_tau_a
7474 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7475 n_rhob_laplace_rhoa_tau_b(i, j, k)*mp_rhob*mp_tau_b
7476 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7477 n_gamma_aa_gamma_aa_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_gamma_aa
7478 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7479 n_gamma_aa_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_gamma_ab
7480 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7481 n_gamma_aa_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_gamma_bb
7482 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7483 n_gamma_aa_laplace_rhoa_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7484 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7485 n_gamma_aa_laplace_rhoa_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7486 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7487 n_gamma_aa_laplace_rhoa_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7488 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7489 n_gamma_aa_laplace_rhoa_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7490 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7491 n_gamma_ab_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_gamma_ab
7492 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7493 n_gamma_ab_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_gamma_bb
7494 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7495 n_gamma_ab_laplace_rhoa_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7496 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7497 n_gamma_ab_laplace_rhoa_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7498 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7499 n_gamma_ab_laplace_rhoa_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7500 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7501 n_gamma_ab_laplace_rhoa_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7502 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7503 n_gamma_bb_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_gamma_bb
7504 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7505 n_gamma_bb_laplace_rhoa_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7506 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7507 n_gamma_bb_laplace_rhoa_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7508 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7509 n_gamma_bb_laplace_rhoa_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7510 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7511 n_gamma_bb_laplace_rhoa_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7512 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7513 n_laplace_rhoa_laplace_rhoa_laplace_rhoa(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7514 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7515 n_laplace_rhoa_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7516 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7517 n_laplace_rhoa_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7518 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7519 n_laplace_rhoa_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7520 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7521 n_laplace_rhoa_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7522 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7523 n_laplace_rhoa_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7524 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7525 n_laplace_rhoa_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7526 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7527 n_laplace_rhoa_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7528 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7529 n_laplace_rhoa_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7530 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7531 n_laplace_rhoa_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7532 q_laplace_rhoa = q_laplace_rhoa + n_gamma_aa_laplace_rhoa(i, j, k)*mpp_gamma_aa
7533 q_laplace_rhoa = q_laplace_rhoa + n_gamma_ab_laplace_rhoa(i, j, k)*mpp_gamma_ab
7534 q_laplace_rhoa = q_laplace_rhoa + n_gamma_bb_laplace_rhoa(i, j, k)*mpp_gamma_bb
7535 q_laplace_rhob = 0.0_dp
7536 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7537 n_rhoa_rhoa_laplace_rhob(i, j, k)*mp_rhoa*mp_rhoa
7538 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7539 n_rhoa_rhob_laplace_rhob(i, j, k)*mp_rhoa*mp_rhob
7540 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7541 n_rhoa_gamma_aa_laplace_rhob(i, j, k)*mp_rhoa*mp_gamma_aa
7542 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7543 n_rhoa_gamma_ab_laplace_rhob(i, j, k)*mp_rhoa*mp_gamma_ab
7544 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7545 n_rhoa_gamma_bb_laplace_rhob(i, j, k)*mp_rhoa*mp_gamma_bb
7546 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7547 n_rhoa_laplace_rhoa_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhoa
7548 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7549 n_rhoa_laplace_rhob_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
7550 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7551 n_rhoa_laplace_rhob_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7552 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7553 n_rhoa_laplace_rhob_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7554 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7555 n_rhob_rhob_laplace_rhob(i, j, k)*mp_rhob*mp_rhob
7556 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7557 n_rhob_gamma_aa_laplace_rhob(i, j, k)*mp_rhob*mp_gamma_aa
7558 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7559 n_rhob_gamma_ab_laplace_rhob(i, j, k)*mp_rhob*mp_gamma_ab
7560 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7561 n_rhob_gamma_bb_laplace_rhob(i, j, k)*mp_rhob*mp_gamma_bb
7562 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7563 n_rhob_laplace_rhoa_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhoa
7564 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7565 n_rhob_laplace_rhob_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7566 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7567 n_rhob_laplace_rhob_tau_a(i, j, k)*mp_rhob*mp_tau_a
7568 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7569 n_rhob_laplace_rhob_tau_b(i, j, k)*mp_rhob*mp_tau_b
7570 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7571 n_gamma_aa_gamma_aa_laplace_rhob(i, j, k)*mp_gamma_aa*mp_gamma_aa
7572 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7573 n_gamma_aa_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_aa*mp_gamma_ab
7574 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7575 n_gamma_aa_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_aa*mp_gamma_bb
7576 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7577 n_gamma_aa_laplace_rhoa_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7578 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7579 n_gamma_aa_laplace_rhob_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7580 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7581 n_gamma_aa_laplace_rhob_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7582 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7583 n_gamma_aa_laplace_rhob_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7584 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7585 n_gamma_ab_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_ab*mp_gamma_ab
7586 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7587 n_gamma_ab_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_ab*mp_gamma_bb
7588 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7589 n_gamma_ab_laplace_rhoa_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7590 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7591 n_gamma_ab_laplace_rhob_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7592 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7593 n_gamma_ab_laplace_rhob_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7594 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7595 n_gamma_ab_laplace_rhob_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7596 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7597 n_gamma_bb_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_bb*mp_gamma_bb
7598 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7599 n_gamma_bb_laplace_rhoa_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7600 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7601 n_gamma_bb_laplace_rhob_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7602 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7603 n_gamma_bb_laplace_rhob_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7604 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7605 n_gamma_bb_laplace_rhob_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7606 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7607 n_laplace_rhoa_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7608 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7609 n_laplace_rhoa_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7610 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7611 n_laplace_rhoa_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7612 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7613 n_laplace_rhoa_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7614 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7615 n_laplace_rhob_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7616 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7617 n_laplace_rhob_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7618 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7619 n_laplace_rhob_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7620 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7621 n_laplace_rhob_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7622 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7623 n_laplace_rhob_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7624 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7625 n_laplace_rhob_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7626 q_laplace_rhob = q_laplace_rhob + n_gamma_aa_laplace_rhob(i, j, k)*mpp_gamma_aa
7627 q_laplace_rhob = q_laplace_rhob + n_gamma_ab_laplace_rhob(i, j, k)*mpp_gamma_ab
7628 q_laplace_rhob = q_laplace_rhob + n_gamma_bb_laplace_rhob(i, j, k)*mpp_gamma_bb
7629 q_tau_a = 0.0_dp
7630 q_tau_a = q_tau_a + 1.0_dp* &
7631 n_rhoa_rhoa_tau_a(i, j, k)*mp_rhoa*mp_rhoa
7632 q_tau_a = q_tau_a + 2.0_dp* &
7633 n_rhoa_rhob_tau_a(i, j, k)*mp_rhoa*mp_rhob
7634 q_tau_a = q_tau_a + 2.0_dp* &
7635 n_rhoa_gamma_aa_tau_a(i, j, k)*mp_rhoa*mp_gamma_aa
7636 q_tau_a = q_tau_a + 2.0_dp* &
7637 n_rhoa_gamma_ab_tau_a(i, j, k)*mp_rhoa*mp_gamma_ab
7638 q_tau_a = q_tau_a + 2.0_dp* &
7639 n_rhoa_gamma_bb_tau_a(i, j, k)*mp_rhoa*mp_gamma_bb
7640 q_tau_a = q_tau_a + 2.0_dp* &
7641 n_rhoa_laplace_rhoa_tau_a(i, j, k)*mp_rhoa*mp_laplace_rhoa
7642 q_tau_a = q_tau_a + 2.0_dp* &
7643 n_rhoa_laplace_rhob_tau_a(i, j, k)*mp_rhoa*mp_laplace_rhob
7644 q_tau_a = q_tau_a + 2.0_dp* &
7645 n_rhoa_tau_a_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7646 q_tau_a = q_tau_a + 2.0_dp* &
7647 n_rhoa_tau_a_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7648 q_tau_a = q_tau_a + 1.0_dp* &
7649 n_rhob_rhob_tau_a(i, j, k)*mp_rhob*mp_rhob
7650 q_tau_a = q_tau_a + 2.0_dp* &
7651 n_rhob_gamma_aa_tau_a(i, j, k)*mp_rhob*mp_gamma_aa
7652 q_tau_a = q_tau_a + 2.0_dp* &
7653 n_rhob_gamma_ab_tau_a(i, j, k)*mp_rhob*mp_gamma_ab
7654 q_tau_a = q_tau_a + 2.0_dp* &
7655 n_rhob_gamma_bb_tau_a(i, j, k)*mp_rhob*mp_gamma_bb
7656 q_tau_a = q_tau_a + 2.0_dp* &
7657 n_rhob_laplace_rhoa_tau_a(i, j, k)*mp_rhob*mp_laplace_rhoa
7658 q_tau_a = q_tau_a + 2.0_dp* &
7659 n_rhob_laplace_rhob_tau_a(i, j, k)*mp_rhob*mp_laplace_rhob
7660 q_tau_a = q_tau_a + 2.0_dp* &
7661 n_rhob_tau_a_tau_a(i, j, k)*mp_rhob*mp_tau_a
7662 q_tau_a = q_tau_a + 2.0_dp* &
7663 n_rhob_tau_a_tau_b(i, j, k)*mp_rhob*mp_tau_b
7664 q_tau_a = q_tau_a + 1.0_dp* &
7665 n_gamma_aa_gamma_aa_tau_a(i, j, k)*mp_gamma_aa*mp_gamma_aa
7666 q_tau_a = q_tau_a + 2.0_dp* &
7667 n_gamma_aa_gamma_ab_tau_a(i, j, k)*mp_gamma_aa*mp_gamma_ab
7668 q_tau_a = q_tau_a + 2.0_dp* &
7669 n_gamma_aa_gamma_bb_tau_a(i, j, k)*mp_gamma_aa*mp_gamma_bb
7670 q_tau_a = q_tau_a + 2.0_dp* &
7671 n_gamma_aa_laplace_rhoa_tau_a(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7672 q_tau_a = q_tau_a + 2.0_dp* &
7673 n_gamma_aa_laplace_rhob_tau_a(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7674 q_tau_a = q_tau_a + 2.0_dp* &
7675 n_gamma_aa_tau_a_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7676 q_tau_a = q_tau_a + 2.0_dp* &
7677 n_gamma_aa_tau_a_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7678 q_tau_a = q_tau_a + 1.0_dp* &
7679 n_gamma_ab_gamma_ab_tau_a(i, j, k)*mp_gamma_ab*mp_gamma_ab
7680 q_tau_a = q_tau_a + 2.0_dp* &
7681 n_gamma_ab_gamma_bb_tau_a(i, j, k)*mp_gamma_ab*mp_gamma_bb
7682 q_tau_a = q_tau_a + 2.0_dp* &
7683 n_gamma_ab_laplace_rhoa_tau_a(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7684 q_tau_a = q_tau_a + 2.0_dp* &
7685 n_gamma_ab_laplace_rhob_tau_a(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7686 q_tau_a = q_tau_a + 2.0_dp* &
7687 n_gamma_ab_tau_a_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7688 q_tau_a = q_tau_a + 2.0_dp* &
7689 n_gamma_ab_tau_a_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7690 q_tau_a = q_tau_a + 1.0_dp* &
7691 n_gamma_bb_gamma_bb_tau_a(i, j, k)*mp_gamma_bb*mp_gamma_bb
7692 q_tau_a = q_tau_a + 2.0_dp* &
7693 n_gamma_bb_laplace_rhoa_tau_a(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7694 q_tau_a = q_tau_a + 2.0_dp* &
7695 n_gamma_bb_laplace_rhob_tau_a(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7696 q_tau_a = q_tau_a + 2.0_dp* &
7697 n_gamma_bb_tau_a_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7698 q_tau_a = q_tau_a + 2.0_dp* &
7699 n_gamma_bb_tau_a_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7700 q_tau_a = q_tau_a + 1.0_dp* &
7701 n_laplace_rhoa_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7702 q_tau_a = q_tau_a + 2.0_dp* &
7703 n_laplace_rhoa_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7704 q_tau_a = q_tau_a + 2.0_dp* &
7705 n_laplace_rhoa_tau_a_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7706 q_tau_a = q_tau_a + 2.0_dp* &
7707 n_laplace_rhoa_tau_a_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7708 q_tau_a = q_tau_a + 1.0_dp* &
7709 n_laplace_rhob_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7710 q_tau_a = q_tau_a + 2.0_dp* &
7711 n_laplace_rhob_tau_a_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7712 q_tau_a = q_tau_a + 2.0_dp* &
7713 n_laplace_rhob_tau_a_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7714 q_tau_a = q_tau_a + 1.0_dp* &
7715 n_tau_a_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7716 q_tau_a = q_tau_a + 2.0_dp* &
7717 n_tau_a_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7718 q_tau_a = q_tau_a + 1.0_dp* &
7719 n_tau_a_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7720 q_tau_a = q_tau_a + n_gamma_aa_tau_a(i, j, k)*mpp_gamma_aa
7721 q_tau_a = q_tau_a + n_gamma_ab_tau_a(i, j, k)*mpp_gamma_ab
7722 q_tau_a = q_tau_a + n_gamma_bb_tau_a(i, j, k)*mpp_gamma_bb
7723 q_tau_b = 0.0_dp
7724 q_tau_b = q_tau_b + 1.0_dp* &
7725 n_rhoa_rhoa_tau_b(i, j, k)*mp_rhoa*mp_rhoa
7726 q_tau_b = q_tau_b + 2.0_dp* &
7727 n_rhoa_rhob_tau_b(i, j, k)*mp_rhoa*mp_rhob
7728 q_tau_b = q_tau_b + 2.0_dp* &
7729 n_rhoa_gamma_aa_tau_b(i, j, k)*mp_rhoa*mp_gamma_aa
7730 q_tau_b = q_tau_b + 2.0_dp* &
7731 n_rhoa_gamma_ab_tau_b(i, j, k)*mp_rhoa*mp_gamma_ab
7732 q_tau_b = q_tau_b + 2.0_dp* &
7733 n_rhoa_gamma_bb_tau_b(i, j, k)*mp_rhoa*mp_gamma_bb
7734 q_tau_b = q_tau_b + 2.0_dp* &
7735 n_rhoa_laplace_rhoa_tau_b(i, j, k)*mp_rhoa*mp_laplace_rhoa
7736 q_tau_b = q_tau_b + 2.0_dp* &
7737 n_rhoa_laplace_rhob_tau_b(i, j, k)*mp_rhoa*mp_laplace_rhob
7738 q_tau_b = q_tau_b + 2.0_dp* &
7739 n_rhoa_tau_a_tau_b(i, j, k)*mp_rhoa*mp_tau_a
7740 q_tau_b = q_tau_b + 2.0_dp* &
7741 n_rhoa_tau_b_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7742 q_tau_b = q_tau_b + 1.0_dp* &
7743 n_rhob_rhob_tau_b(i, j, k)*mp_rhob*mp_rhob
7744 q_tau_b = q_tau_b + 2.0_dp* &
7745 n_rhob_gamma_aa_tau_b(i, j, k)*mp_rhob*mp_gamma_aa
7746 q_tau_b = q_tau_b + 2.0_dp* &
7747 n_rhob_gamma_ab_tau_b(i, j, k)*mp_rhob*mp_gamma_ab
7748 q_tau_b = q_tau_b + 2.0_dp* &
7749 n_rhob_gamma_bb_tau_b(i, j, k)*mp_rhob*mp_gamma_bb
7750 q_tau_b = q_tau_b + 2.0_dp* &
7751 n_rhob_laplace_rhoa_tau_b(i, j, k)*mp_rhob*mp_laplace_rhoa
7752 q_tau_b = q_tau_b + 2.0_dp* &
7753 n_rhob_laplace_rhob_tau_b(i, j, k)*mp_rhob*mp_laplace_rhob
7754 q_tau_b = q_tau_b + 2.0_dp* &
7755 n_rhob_tau_a_tau_b(i, j, k)*mp_rhob*mp_tau_a
7756 q_tau_b = q_tau_b + 2.0_dp* &
7757 n_rhob_tau_b_tau_b(i, j, k)*mp_rhob*mp_tau_b
7758 q_tau_b = q_tau_b + 1.0_dp* &
7759 n_gamma_aa_gamma_aa_tau_b(i, j, k)*mp_gamma_aa*mp_gamma_aa
7760 q_tau_b = q_tau_b + 2.0_dp* &
7761 n_gamma_aa_gamma_ab_tau_b(i, j, k)*mp_gamma_aa*mp_gamma_ab
7762 q_tau_b = q_tau_b + 2.0_dp* &
7763 n_gamma_aa_gamma_bb_tau_b(i, j, k)*mp_gamma_aa*mp_gamma_bb
7764 q_tau_b = q_tau_b + 2.0_dp* &
7765 n_gamma_aa_laplace_rhoa_tau_b(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7766 q_tau_b = q_tau_b + 2.0_dp* &
7767 n_gamma_aa_laplace_rhob_tau_b(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7768 q_tau_b = q_tau_b + 2.0_dp* &
7769 n_gamma_aa_tau_a_tau_b(i, j, k)*mp_gamma_aa*mp_tau_a
7770 q_tau_b = q_tau_b + 2.0_dp* &
7771 n_gamma_aa_tau_b_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7772 q_tau_b = q_tau_b + 1.0_dp* &
7773 n_gamma_ab_gamma_ab_tau_b(i, j, k)*mp_gamma_ab*mp_gamma_ab
7774 q_tau_b = q_tau_b + 2.0_dp* &
7775 n_gamma_ab_gamma_bb_tau_b(i, j, k)*mp_gamma_ab*mp_gamma_bb
7776 q_tau_b = q_tau_b + 2.0_dp* &
7777 n_gamma_ab_laplace_rhoa_tau_b(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7778 q_tau_b = q_tau_b + 2.0_dp* &
7779 n_gamma_ab_laplace_rhob_tau_b(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7780 q_tau_b = q_tau_b + 2.0_dp* &
7781 n_gamma_ab_tau_a_tau_b(i, j, k)*mp_gamma_ab*mp_tau_a
7782 q_tau_b = q_tau_b + 2.0_dp* &
7783 n_gamma_ab_tau_b_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7784 q_tau_b = q_tau_b + 1.0_dp* &
7785 n_gamma_bb_gamma_bb_tau_b(i, j, k)*mp_gamma_bb*mp_gamma_bb
7786 q_tau_b = q_tau_b + 2.0_dp* &
7787 n_gamma_bb_laplace_rhoa_tau_b(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7788 q_tau_b = q_tau_b + 2.0_dp* &
7789 n_gamma_bb_laplace_rhob_tau_b(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7790 q_tau_b = q_tau_b + 2.0_dp* &
7791 n_gamma_bb_tau_a_tau_b(i, j, k)*mp_gamma_bb*mp_tau_a
7792 q_tau_b = q_tau_b + 2.0_dp* &
7793 n_gamma_bb_tau_b_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7794 q_tau_b = q_tau_b + 1.0_dp* &
7795 n_laplace_rhoa_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7796 q_tau_b = q_tau_b + 2.0_dp* &
7797 n_laplace_rhoa_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7798 q_tau_b = q_tau_b + 2.0_dp* &
7799 n_laplace_rhoa_tau_a_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_a
7800 q_tau_b = q_tau_b + 2.0_dp* &
7801 n_laplace_rhoa_tau_b_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7802 q_tau_b = q_tau_b + 1.0_dp* &
7803 n_laplace_rhob_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7804 q_tau_b = q_tau_b + 2.0_dp* &
7805 n_laplace_rhob_tau_a_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_a
7806 q_tau_b = q_tau_b + 2.0_dp* &
7807 n_laplace_rhob_tau_b_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7808 q_tau_b = q_tau_b + 1.0_dp* &
7809 n_tau_a_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_a
7810 q_tau_b = q_tau_b + 2.0_dp* &
7811 n_tau_a_tau_b_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7812 q_tau_b = q_tau_b + 1.0_dp* &
7813 n_tau_b_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7814 q_tau_b = q_tau_b + n_gamma_aa_tau_b(i, j, k)*mpp_gamma_aa
7815 q_tau_b = q_tau_b + n_gamma_ab_tau_b(i, j, k)*mpp_gamma_ab
7816 q_tau_b = q_tau_b + n_gamma_bb_tau_b(i, j, k)*mpp_gamma_bb
7817 nb_gamma_aa = 0.0_dp
7818 nb_gamma_aa = nb_gamma_aa + n_rhoa_gamma_aa(i, j, k)*mp_rhoa
7819 nb_gamma_aa = nb_gamma_aa + n_rhob_gamma_aa(i, j, k)*mp_rhob
7820 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_gamma_aa(i, j, k)*mp_gamma_aa
7821 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_gamma_ab(i, j, k)*mp_gamma_ab
7822 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_gamma_bb(i, j, k)*mp_gamma_bb
7823 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_laplace_rhoa(i, j, k)*mp_laplace_rhoa
7824 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_laplace_rhob(i, j, k)*mp_laplace_rhob
7825 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_tau_a(i, j, k)*mp_tau_a
7826 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_tau_b(i, j, k)*mp_tau_b
7827 nb_gamma_ab = 0.0_dp
7828 nb_gamma_ab = nb_gamma_ab + n_rhoa_gamma_ab(i, j, k)*mp_rhoa
7829 nb_gamma_ab = nb_gamma_ab + n_rhob_gamma_ab(i, j, k)*mp_rhob
7830 nb_gamma_ab = nb_gamma_ab + n_gamma_aa_gamma_ab(i, j, k)*mp_gamma_aa
7831 nb_gamma_ab = nb_gamma_ab + n_gamma_ab_gamma_ab(i, j, k)*mp_gamma_ab
7832 nb_gamma_ab = nb_gamma_ab + n_gamma_ab_gamma_bb(i, j, k)*mp_gamma_bb
7833 nb_gamma_ab = nb_gamma_ab + n_gamma_ab_laplace_rhoa(i, j, k)*mp_laplace_rhoa
7834 nb_gamma_ab = nb_gamma_ab + n_gamma_ab_laplace_rhob(i, j, k)*mp_laplace_rhob
7835 nb_gamma_ab = nb_gamma_ab + n_gamma_ab_tau_a(i, j, k)*mp_tau_a
7836 nb_gamma_ab = nb_gamma_ab + n_gamma_ab_tau_b(i, j, k)*mp_tau_b
7837 nb_gamma_bb = 0.0_dp
7838 nb_gamma_bb = nb_gamma_bb + n_rhoa_gamma_bb(i, j, k)*mp_rhoa
7839 nb_gamma_bb = nb_gamma_bb + n_rhob_gamma_bb(i, j, k)*mp_rhob
7840 nb_gamma_bb = nb_gamma_bb + n_gamma_aa_gamma_bb(i, j, k)*mp_gamma_aa
7841 nb_gamma_bb = nb_gamma_bb + n_gamma_ab_gamma_bb(i, j, k)*mp_gamma_ab
7842 nb_gamma_bb = nb_gamma_bb + n_gamma_bb_gamma_bb(i, j, k)*mp_gamma_bb
7843 nb_gamma_bb = nb_gamma_bb + n_gamma_bb_laplace_rhoa(i, j, k)*mp_laplace_rhoa
7844 nb_gamma_bb = nb_gamma_bb + n_gamma_bb_laplace_rhob(i, j, k)*mp_laplace_rhob
7845 nb_gamma_bb = nb_gamma_bb + n_gamma_bb_tau_a(i, j, k)*mp_tau_a
7846 nb_gamma_bb = nb_gamma_bb + n_gamma_bb_tau_b(i, j, k)*mp_tau_b
7847
7848 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + q_rhoa
7849 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + q_rhob
7850 IF (tau_f) THEN
7851 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + q_tau_a
7852 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + q_tau_b
7853 END IF
7854 IF (laplace_f) THEN
7855 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + q_laplace_rhoa
7856 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + q_laplace_rhob
7857 END IF
7858
7859 ! xc_pw_divergence ADDS div(field), and g_xc = u - div(v)
7860 v_drho_r(1, 1)%array(i, j, k) = &
7861 -(2.0_dp*drhoa(1)%array(i, j, k)*q_gamma_aa &
7862 + drhob(1)%array(i, j, k)*q_gamma_ab &
7863 + 2.0_dp*(2.0_dp*drho1a(1)%array(i, j, k)*nb_gamma_aa &
7864 + drho1b(1)%array(i, j, k)*nb_gamma_ab))
7865 v_drho_r(1, 2)%array(i, j, k) = &
7866 -(2.0_dp*drhob(1)%array(i, j, k)*q_gamma_bb &
7867 + drhoa(1)%array(i, j, k)*q_gamma_ab &
7868 + 2.0_dp*(2.0_dp*drho1b(1)%array(i, j, k)*nb_gamma_bb &
7869 + drho1a(1)%array(i, j, k)*nb_gamma_ab))
7870 v_drho_r(2, 1)%array(i, j, k) = &
7871 -(2.0_dp*drhoa(2)%array(i, j, k)*q_gamma_aa &
7872 + drhob(2)%array(i, j, k)*q_gamma_ab &
7873 + 2.0_dp*(2.0_dp*drho1a(2)%array(i, j, k)*nb_gamma_aa &
7874 + drho1b(2)%array(i, j, k)*nb_gamma_ab))
7875 v_drho_r(2, 2)%array(i, j, k) = &
7876 -(2.0_dp*drhob(2)%array(i, j, k)*q_gamma_bb &
7877 + drhoa(2)%array(i, j, k)*q_gamma_ab &
7878 + 2.0_dp*(2.0_dp*drho1b(2)%array(i, j, k)*nb_gamma_bb &
7879 + drho1a(2)%array(i, j, k)*nb_gamma_ab))
7880 v_drho_r(3, 1)%array(i, j, k) = &
7881 -(2.0_dp*drhoa(3)%array(i, j, k)*q_gamma_aa &
7882 + drhob(3)%array(i, j, k)*q_gamma_ab &
7883 + 2.0_dp*(2.0_dp*drho1a(3)%array(i, j, k)*nb_gamma_aa &
7884 + drho1b(3)%array(i, j, k)*nb_gamma_ab))
7885 v_drho_r(3, 2)%array(i, j, k) = &
7886 -(2.0_dp*drhob(3)%array(i, j, k)*q_gamma_bb &
7887 + drhoa(3)%array(i, j, k)*q_gamma_ab &
7888 + 2.0_dp*(2.0_dp*drho1b(3)%array(i, j, k)*nb_gamma_bb &
7889 + drho1a(3)%array(i, j, k)*nb_gamma_ab))
7890 END DO
7891 END DO
7892 END DO
7893
7894 IF (my_gapw) THEN
7895 ! vxg carries +V; the plane-wave field above is -V
7896 DO idir = 1, 3
7897 vxg(idir, :, :, 1) = -v_drho_r(idir, 1)%array(:, :, 1)
7898 END DO
7899 ELSE
7900 IF (my_gapw) THEN
7901 DO idir = 1, 3
7902 vxg(idir, :, :, 1) = -v_drho_r(idir, 1)%array(:, :, 1)
7903 END DO
7904 ELSE
7905 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 1), tmp_g, vxc_g, v_xc(1))
7906 END IF
7907 END IF
7908 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 2), tmp_g, vxc_g, v_xc(2))
7909 IF (laplace_f) THEN
7910 DO ispin = 1, nspins
7911 CALL xc_pw_laplace(v_laplace(ispin), pw_pool, xc_deriv_method_id)
7912 CALL pw_axpy(v_laplace(ispin), v_xc(ispin))
7913 CALL deallocate_pw(v_laplace(ispin), pw_pool)
7914 END DO
7915 DEALLOCATE (v_laplace)
7916 END IF
7917 DEALLOCATE (zero_f)
7918
7919 ELSE
7920
7921 IF (.NOT. gradient_f) THEN
7922 ! LDA: only the pure-density third derivatives contribute
7923 deriv_att => xc_dset_get_derivative(deriv_set, &
7925 cpassert(ASSOCIATED(deriv_att))
7926 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_rhoa)
7927 deriv_att => xc_dset_get_derivative(deriv_set, &
7929 cpassert(ASSOCIATED(deriv_att))
7930 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_rhob)
7931 deriv_att => xc_dset_get_derivative(deriv_set, &
7933 cpassert(ASSOCIATED(deriv_att))
7934 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhob_rhob)
7935 deriv_att => xc_dset_get_derivative(deriv_set, &
7937 cpassert(ASSOCIATED(deriv_att))
7938 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_rhob_rhob)
7939!$OMP PARALLEL DO PRIVATE(k,j,i,p_rhoa,p_rhob,u_a,u_b) DEFAULT(NONE) COLLAPSE(3) &
7940!$OMP SHARED(g_rhoa_rhoa_rhoa) &
7941!$OMP SHARED(g_rhoa_rhoa_rhob) &
7942!$OMP SHARED(g_rhoa_rhob_rhob) &
7943!$OMP SHARED(g_rhob_rhob_rhob) &
7944!$OMP SHARED(bo,rho1a,rho1b,v_xc)
7945 DO k = bo(1, 3), bo(2, 3)
7946 DO j = bo(1, 2), bo(2, 2)
7947 DO i = bo(1, 1), bo(2, 1)
7948 p_rhoa = rho1a(i, j, k)
7949 p_rhob = rho1b(i, j, k)
7950 u_a = 0.0_dp
7951 u_a = u_a + g_rhoa_rhoa_rhoa(i, j, k)*p_rhoa*p_rhoa
7952 u_a = u_a + g_rhoa_rhoa_rhob(i, j, k)*p_rhoa*p_rhob
7953 u_a = u_a + g_rhoa_rhoa_rhob(i, j, k)*p_rhob*p_rhoa
7954 u_a = u_a + g_rhoa_rhob_rhob(i, j, k)*p_rhob*p_rhob
7955 u_b = 0.0_dp
7956 u_b = u_b + g_rhoa_rhoa_rhob(i, j, k)*p_rhoa*p_rhoa
7957 u_b = u_b + g_rhoa_rhob_rhob(i, j, k)*p_rhoa*p_rhob
7958 u_b = u_b + g_rhoa_rhob_rhob(i, j, k)*p_rhob*p_rhoa
7959 u_b = u_b + g_rhob_rhob_rhob(i, j, k)*p_rhob*p_rhob
7960 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + u_a
7961 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + u_b
7962 END DO
7963 END DO
7964 END DO
7965
7966 ELSE
7967
7968 NULLIFY (g_rhoa_rhoa)
7969 deriv_att => xc_dset_get_derivative(deriv_set, &
7971 IF (ASSOCIATED(deriv_att)) THEN
7972 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa)
7973 ELSE
7974 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
7975 END IF
7976 NULLIFY (g_rhoa_rhob)
7977 deriv_att => xc_dset_get_derivative(deriv_set, &
7979 IF (ASSOCIATED(deriv_att)) THEN
7980 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhob)
7981 ELSE
7982 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
7983 END IF
7984 NULLIFY (g_rhoa_gamma_aa)
7985 deriv_att => xc_dset_get_derivative(deriv_set, &
7987 IF (ASSOCIATED(deriv_att)) THEN
7988 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_aa)
7989 ELSE
7990 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
7991 END IF
7992 NULLIFY (g_rhoa_gamma_ab)
7993 deriv_att => xc_dset_get_derivative(deriv_set, &
7995 IF (ASSOCIATED(deriv_att)) THEN
7996 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_ab)
7997 ELSE
7998 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
7999 END IF
8000 NULLIFY (g_rhoa_gamma_bb)
8001 deriv_att => xc_dset_get_derivative(deriv_set, &
8003 IF (ASSOCIATED(deriv_att)) THEN
8004 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_bb)
8005 ELSE
8006 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8007 END IF
8008 NULLIFY (g_rhob_rhob)
8009 deriv_att => xc_dset_get_derivative(deriv_set, &
8011 IF (ASSOCIATED(deriv_att)) THEN
8012 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_rhob)
8013 ELSE
8014 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8015 END IF
8016 NULLIFY (g_rhob_gamma_aa)
8017 deriv_att => xc_dset_get_derivative(deriv_set, &
8019 IF (ASSOCIATED(deriv_att)) THEN
8020 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_aa)
8021 ELSE
8022 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8023 END IF
8024 NULLIFY (g_rhob_gamma_ab)
8025 deriv_att => xc_dset_get_derivative(deriv_set, &
8027 IF (ASSOCIATED(deriv_att)) THEN
8028 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_ab)
8029 ELSE
8030 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8031 END IF
8032 NULLIFY (g_rhob_gamma_bb)
8033 deriv_att => xc_dset_get_derivative(deriv_set, &
8035 IF (ASSOCIATED(deriv_att)) THEN
8036 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_bb)
8037 ELSE
8038 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8039 END IF
8040 NULLIFY (g_gamma_aa_gamma_aa)
8041 deriv_att => xc_dset_get_derivative(deriv_set, &
8043 IF (ASSOCIATED(deriv_att)) THEN
8044 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_aa)
8045 ELSE
8046 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8047 END IF
8048 NULLIFY (g_gamma_aa_gamma_ab)
8049 deriv_att => xc_dset_get_derivative(deriv_set, &
8051 IF (ASSOCIATED(deriv_att)) THEN
8052 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_ab)
8053 ELSE
8054 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8055 END IF
8056 NULLIFY (g_gamma_aa_gamma_bb)
8057 deriv_att => xc_dset_get_derivative(deriv_set, &
8059 IF (ASSOCIATED(deriv_att)) THEN
8060 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_bb)
8061 ELSE
8062 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8063 END IF
8064 NULLIFY (g_gamma_ab_gamma_ab)
8065 deriv_att => xc_dset_get_derivative(deriv_set, &
8067 IF (ASSOCIATED(deriv_att)) THEN
8068 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_ab_gamma_ab)
8069 ELSE
8070 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8071 END IF
8072 NULLIFY (g_gamma_ab_gamma_bb)
8073 deriv_att => xc_dset_get_derivative(deriv_set, &
8075 IF (ASSOCIATED(deriv_att)) THEN
8076 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_ab_gamma_bb)
8077 ELSE
8078 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8079 END IF
8080 NULLIFY (g_gamma_bb_gamma_bb)
8081 deriv_att => xc_dset_get_derivative(deriv_set, &
8083 IF (ASSOCIATED(deriv_att)) THEN
8084 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_bb_gamma_bb)
8085 ELSE
8086 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8087 END IF
8088 NULLIFY (g_rhoa_rhoa_rhoa)
8089 deriv_att => xc_dset_get_derivative(deriv_set, &
8091 IF (ASSOCIATED(deriv_att)) THEN
8092 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_rhoa)
8093 ELSE
8094 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8095 END IF
8096 NULLIFY (g_rhoa_rhoa_rhob)
8097 deriv_att => xc_dset_get_derivative(deriv_set, &
8099 IF (ASSOCIATED(deriv_att)) THEN
8100 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_rhob)
8101 ELSE
8102 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8103 END IF
8104 NULLIFY (g_rhoa_rhoa_gamma_aa)
8105 deriv_att => xc_dset_get_derivative(deriv_set, &
8107 IF (ASSOCIATED(deriv_att)) THEN
8108 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_gamma_aa)
8109 ELSE
8110 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8111 END IF
8112 NULLIFY (g_rhoa_rhoa_gamma_ab)
8113 deriv_att => xc_dset_get_derivative(deriv_set, &
8115 IF (ASSOCIATED(deriv_att)) THEN
8116 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_gamma_ab)
8117 ELSE
8118 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8119 END IF
8120 NULLIFY (g_rhoa_rhoa_gamma_bb)
8121 deriv_att => xc_dset_get_derivative(deriv_set, &
8123 IF (ASSOCIATED(deriv_att)) THEN
8124 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_gamma_bb)
8125 ELSE
8126 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8127 END IF
8128 NULLIFY (g_rhoa_rhob_rhob)
8129 deriv_att => xc_dset_get_derivative(deriv_set, &
8131 IF (ASSOCIATED(deriv_att)) THEN
8132 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhob_rhob)
8133 ELSE
8134 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8135 END IF
8136 NULLIFY (g_rhoa_rhob_gamma_aa)
8137 deriv_att => xc_dset_get_derivative(deriv_set, &
8139 IF (ASSOCIATED(deriv_att)) THEN
8140 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhob_gamma_aa)
8141 ELSE
8142 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8143 END IF
8144 NULLIFY (g_rhoa_rhob_gamma_ab)
8145 deriv_att => xc_dset_get_derivative(deriv_set, &
8147 IF (ASSOCIATED(deriv_att)) THEN
8148 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhob_gamma_ab)
8149 ELSE
8150 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8151 END IF
8152 NULLIFY (g_rhoa_rhob_gamma_bb)
8153 deriv_att => xc_dset_get_derivative(deriv_set, &
8155 IF (ASSOCIATED(deriv_att)) THEN
8156 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhob_gamma_bb)
8157 ELSE
8158 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8159 END IF
8160 NULLIFY (g_rhoa_gamma_aa_gamma_aa)
8161 deriv_att => xc_dset_get_derivative(deriv_set, &
8163 IF (ASSOCIATED(deriv_att)) THEN
8164 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_aa_gamma_aa)
8165 ELSE
8166 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8167 END IF
8168 NULLIFY (g_rhoa_gamma_aa_gamma_ab)
8169 deriv_att => xc_dset_get_derivative(deriv_set, &
8171 IF (ASSOCIATED(deriv_att)) THEN
8172 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_aa_gamma_ab)
8173 ELSE
8174 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8175 END IF
8176 NULLIFY (g_rhoa_gamma_aa_gamma_bb)
8177 deriv_att => xc_dset_get_derivative(deriv_set, &
8179 IF (ASSOCIATED(deriv_att)) THEN
8180 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_aa_gamma_bb)
8181 ELSE
8182 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8183 END IF
8184 NULLIFY (g_rhoa_gamma_ab_gamma_ab)
8185 deriv_att => xc_dset_get_derivative(deriv_set, &
8187 IF (ASSOCIATED(deriv_att)) THEN
8188 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_ab_gamma_ab)
8189 ELSE
8190 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8191 END IF
8192 NULLIFY (g_rhoa_gamma_ab_gamma_bb)
8193 deriv_att => xc_dset_get_derivative(deriv_set, &
8195 IF (ASSOCIATED(deriv_att)) THEN
8196 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_ab_gamma_bb)
8197 ELSE
8198 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8199 END IF
8200 NULLIFY (g_rhoa_gamma_bb_gamma_bb)
8201 deriv_att => xc_dset_get_derivative(deriv_set, &
8203 IF (ASSOCIATED(deriv_att)) THEN
8204 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_bb_gamma_bb)
8205 ELSE
8206 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8207 END IF
8208 NULLIFY (g_rhob_rhob_rhob)
8209 deriv_att => xc_dset_get_derivative(deriv_set, &
8211 IF (ASSOCIATED(deriv_att)) THEN
8212 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_rhob_rhob)
8213 ELSE
8214 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8215 END IF
8216 NULLIFY (g_rhob_rhob_gamma_aa)
8217 deriv_att => xc_dset_get_derivative(deriv_set, &
8219 IF (ASSOCIATED(deriv_att)) THEN
8220 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_rhob_gamma_aa)
8221 ELSE
8222 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8223 END IF
8224 NULLIFY (g_rhob_rhob_gamma_ab)
8225 deriv_att => xc_dset_get_derivative(deriv_set, &
8227 IF (ASSOCIATED(deriv_att)) THEN
8228 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_rhob_gamma_ab)
8229 ELSE
8230 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8231 END IF
8232 NULLIFY (g_rhob_rhob_gamma_bb)
8233 deriv_att => xc_dset_get_derivative(deriv_set, &
8235 IF (ASSOCIATED(deriv_att)) THEN
8236 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_rhob_gamma_bb)
8237 ELSE
8238 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8239 END IF
8240 NULLIFY (g_rhob_gamma_aa_gamma_aa)
8241 deriv_att => xc_dset_get_derivative(deriv_set, &
8243 IF (ASSOCIATED(deriv_att)) THEN
8244 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_aa_gamma_aa)
8245 ELSE
8246 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8247 END IF
8248 NULLIFY (g_rhob_gamma_aa_gamma_ab)
8249 deriv_att => xc_dset_get_derivative(deriv_set, &
8251 IF (ASSOCIATED(deriv_att)) THEN
8252 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_aa_gamma_ab)
8253 ELSE
8254 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8255 END IF
8256 NULLIFY (g_rhob_gamma_aa_gamma_bb)
8257 deriv_att => xc_dset_get_derivative(deriv_set, &
8259 IF (ASSOCIATED(deriv_att)) THEN
8260 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_aa_gamma_bb)
8261 ELSE
8262 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8263 END IF
8264 NULLIFY (g_rhob_gamma_ab_gamma_ab)
8265 deriv_att => xc_dset_get_derivative(deriv_set, &
8267 IF (ASSOCIATED(deriv_att)) THEN
8268 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_ab_gamma_ab)
8269 ELSE
8270 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8271 END IF
8272 NULLIFY (g_rhob_gamma_ab_gamma_bb)
8273 deriv_att => xc_dset_get_derivative(deriv_set, &
8275 IF (ASSOCIATED(deriv_att)) THEN
8276 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_ab_gamma_bb)
8277 ELSE
8278 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8279 END IF
8280 NULLIFY (g_rhob_gamma_bb_gamma_bb)
8281 deriv_att => xc_dset_get_derivative(deriv_set, &
8283 IF (ASSOCIATED(deriv_att)) THEN
8284 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_bb_gamma_bb)
8285 ELSE
8286 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8287 END IF
8288 NULLIFY (g_gamma_aa_gamma_aa_gamma_aa)
8289 deriv_att => xc_dset_get_derivative(deriv_set, &
8291 IF (ASSOCIATED(deriv_att)) THEN
8292 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_aa_gamma_aa)
8293 ELSE
8294 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8295 END IF
8296 NULLIFY (g_gamma_aa_gamma_aa_gamma_ab)
8297 deriv_att => xc_dset_get_derivative(deriv_set, &
8299 IF (ASSOCIATED(deriv_att)) THEN
8300 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_aa_gamma_ab)
8301 ELSE
8302 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8303 END IF
8304 NULLIFY (g_gamma_aa_gamma_aa_gamma_bb)
8305 deriv_att => xc_dset_get_derivative(deriv_set, &
8307 IF (ASSOCIATED(deriv_att)) THEN
8308 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_aa_gamma_bb)
8309 ELSE
8310 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8311 END IF
8312 NULLIFY (g_gamma_aa_gamma_ab_gamma_ab)
8313 deriv_att => xc_dset_get_derivative(deriv_set, &
8315 IF (ASSOCIATED(deriv_att)) THEN
8316 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_ab_gamma_ab)
8317 ELSE
8318 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8319 END IF
8320 NULLIFY (g_gamma_aa_gamma_ab_gamma_bb)
8321 deriv_att => xc_dset_get_derivative(deriv_set, &
8323 IF (ASSOCIATED(deriv_att)) THEN
8324 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_ab_gamma_bb)
8325 ELSE
8326 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8327 END IF
8328 NULLIFY (g_gamma_aa_gamma_bb_gamma_bb)
8329 deriv_att => xc_dset_get_derivative(deriv_set, &
8331 IF (ASSOCIATED(deriv_att)) THEN
8332 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_bb_gamma_bb)
8333 ELSE
8334 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8335 END IF
8336 NULLIFY (g_gamma_ab_gamma_ab_gamma_ab)
8337 deriv_att => xc_dset_get_derivative(deriv_set, &
8339 IF (ASSOCIATED(deriv_att)) THEN
8340 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_ab_gamma_ab_gamma_ab)
8341 ELSE
8342 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8343 END IF
8344 NULLIFY (g_gamma_ab_gamma_ab_gamma_bb)
8345 deriv_att => xc_dset_get_derivative(deriv_set, &
8347 IF (ASSOCIATED(deriv_att)) THEN
8348 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_ab_gamma_ab_gamma_bb)
8349 ELSE
8350 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8351 END IF
8352 NULLIFY (g_gamma_ab_gamma_bb_gamma_bb)
8353 deriv_att => xc_dset_get_derivative(deriv_set, &
8355 IF (ASSOCIATED(deriv_att)) THEN
8356 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_ab_gamma_bb_gamma_bb)
8357 ELSE
8358 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8359 END IF
8360 NULLIFY (g_gamma_bb_gamma_bb_gamma_bb)
8361 deriv_att => xc_dset_get_derivative(deriv_set, &
8363 IF (ASSOCIATED(deriv_att)) THEN
8364 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_bb_gamma_bb_gamma_bb)
8365 ELSE
8366 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8367 END IF
8368
8369 ! perturbed reduced gradients: first order (gK1) and second (gK11)
8370 CALL prepare_dr1dr(gaa1, drhoa, drho1a)
8371 CALL prepare_dr1dr(gbb1, drhob, drho1b)
8372 CALL prepare_dr1dr(gab1, drhoa, drho1b)
8373 CALL prepare_dr1dr(gaa11, drho1a, drho1a)
8374 CALL prepare_dr1dr(gbb11, drho1b, drho1b)
8375 CALL prepare_dr1dr(gab11, drho1a, drho1b)
8376 block
8377 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: tmp_ba
8378 CALL prepare_dr1dr(tmp_ba, drhob, drho1a)
8379 gab1(:, :, :) = gab1(:, :, :) + tmp_ba(:, :, :)
8380 END block
8381
8382!$OMP PARALLEL DO PRIVATE(k,j,i,p_rhoa,p_rhob,p_gamma_aa,p_gamma_ab,p_gamma_bb, &
8383!$OMP pp_gamma_aa,pp_gamma_ab,pp_gamma_bb,u_a,u_b, &
8384!$OMP A_gamma_aa,A_gamma_ab,A_gamma_bb, &
8385!$OMP B_gamma_aa,B_gamma_ab,B_gamma_bb) DEFAULT(NONE) COLLAPSE(3) &
8386!$OMP SHARED(g_rhoa_rhoa) &
8387!$OMP SHARED(g_rhoa_rhob) &
8388!$OMP SHARED(g_rhoa_gamma_aa) &
8389!$OMP SHARED(g_rhoa_gamma_ab) &
8390!$OMP SHARED(g_rhoa_gamma_bb) &
8391!$OMP SHARED(g_rhob_rhob) &
8392!$OMP SHARED(g_rhob_gamma_aa) &
8393!$OMP SHARED(g_rhob_gamma_ab) &
8394!$OMP SHARED(g_rhob_gamma_bb) &
8395!$OMP SHARED(g_gamma_aa_gamma_aa) &
8396!$OMP SHARED(g_gamma_aa_gamma_ab) &
8397!$OMP SHARED(g_gamma_aa_gamma_bb) &
8398!$OMP SHARED(g_gamma_ab_gamma_ab) &
8399!$OMP SHARED(g_gamma_ab_gamma_bb) &
8400!$OMP SHARED(g_gamma_bb_gamma_bb) &
8401!$OMP SHARED(g_rhoa_rhoa_rhoa) &
8402!$OMP SHARED(g_rhoa_rhoa_rhob) &
8403!$OMP SHARED(g_rhoa_rhoa_gamma_aa) &
8404!$OMP SHARED(g_rhoa_rhoa_gamma_ab) &
8405!$OMP SHARED(g_rhoa_rhoa_gamma_bb) &
8406!$OMP SHARED(g_rhoa_rhob_rhob) &
8407!$OMP SHARED(g_rhoa_rhob_gamma_aa) &
8408!$OMP SHARED(g_rhoa_rhob_gamma_ab) &
8409!$OMP SHARED(g_rhoa_rhob_gamma_bb) &
8410!$OMP SHARED(g_rhoa_gamma_aa_gamma_aa) &
8411!$OMP SHARED(g_rhoa_gamma_aa_gamma_ab) &
8412!$OMP SHARED(g_rhoa_gamma_aa_gamma_bb) &
8413!$OMP SHARED(g_rhoa_gamma_ab_gamma_ab) &
8414!$OMP SHARED(g_rhoa_gamma_ab_gamma_bb) &
8415!$OMP SHARED(g_rhoa_gamma_bb_gamma_bb) &
8416!$OMP SHARED(g_rhob_rhob_rhob) &
8417!$OMP SHARED(g_rhob_rhob_gamma_aa) &
8418!$OMP SHARED(g_rhob_rhob_gamma_ab) &
8419!$OMP SHARED(g_rhob_rhob_gamma_bb) &
8420!$OMP SHARED(g_rhob_gamma_aa_gamma_aa) &
8421!$OMP SHARED(g_rhob_gamma_aa_gamma_ab) &
8422!$OMP SHARED(g_rhob_gamma_aa_gamma_bb) &
8423!$OMP SHARED(g_rhob_gamma_ab_gamma_ab) &
8424!$OMP SHARED(g_rhob_gamma_ab_gamma_bb) &
8425!$OMP SHARED(g_rhob_gamma_bb_gamma_bb) &
8426!$OMP SHARED(g_gamma_aa_gamma_aa_gamma_aa) &
8427!$OMP SHARED(g_gamma_aa_gamma_aa_gamma_ab) &
8428!$OMP SHARED(g_gamma_aa_gamma_aa_gamma_bb) &
8429!$OMP SHARED(g_gamma_aa_gamma_ab_gamma_ab) &
8430!$OMP SHARED(g_gamma_aa_gamma_ab_gamma_bb) &
8431!$OMP SHARED(g_gamma_aa_gamma_bb_gamma_bb) &
8432!$OMP SHARED(g_gamma_ab_gamma_ab_gamma_ab) &
8433!$OMP SHARED(g_gamma_ab_gamma_ab_gamma_bb) &
8434!$OMP SHARED(g_gamma_ab_gamma_bb_gamma_bb) &
8435!$OMP SHARED(g_gamma_bb_gamma_bb_gamma_bb) &
8436!$OMP SHARED(bo,rho1a,rho1b,gaa1,gab1,gbb1,gaa11,gab11,gbb11, &
8437!$OMP v_xc,v_drho_r,drhoa,drhob,drho1a,drho1b)
8438 DO k = bo(1, 3), bo(2, 3)
8439 DO j = bo(1, 2), bo(2, 2)
8440 DO i = bo(1, 1), bo(2, 1)
8441 p_rhoa = rho1a(i, j, k)
8442 p_rhob = rho1b(i, j, k)
8443 p_gamma_aa = 2.0_dp*gaa1(i, j, k)
8444 p_gamma_ab = gab1(i, j, k)
8445 p_gamma_bb = 2.0_dp*gbb1(i, j, k)
8446 pp_gamma_aa = 2.0_dp*gaa11(i, j, k)
8447 pp_gamma_ab = 2.0_dp*gab11(i, j, k)
8448 pp_gamma_bb = 2.0_dp*gbb11(i, j, k)
8449
8450 u_a = 0.0_dp
8451 u_a = u_a + g_rhoa_rhoa_rhoa(i, j, k)*p_rhoa*p_rhoa
8452 u_a = u_a + g_rhoa_rhoa_rhob(i, j, k)*p_rhoa*p_rhob
8453 u_a = u_a + g_rhoa_rhoa_gamma_aa(i, j, k)*p_rhoa*p_gamma_aa
8454 u_a = u_a + g_rhoa_rhoa_gamma_ab(i, j, k)*p_rhoa*p_gamma_ab
8455 u_a = u_a + g_rhoa_rhoa_gamma_bb(i, j, k)*p_rhoa*p_gamma_bb
8456 u_a = u_a + g_rhoa_rhoa_rhob(i, j, k)*p_rhob*p_rhoa
8457 u_a = u_a + g_rhoa_rhob_rhob(i, j, k)*p_rhob*p_rhob
8458 u_a = u_a + g_rhoa_rhob_gamma_aa(i, j, k)*p_rhob*p_gamma_aa
8459 u_a = u_a + g_rhoa_rhob_gamma_ab(i, j, k)*p_rhob*p_gamma_ab
8460 u_a = u_a + g_rhoa_rhob_gamma_bb(i, j, k)*p_rhob*p_gamma_bb
8461 u_a = u_a + g_rhoa_rhoa_gamma_aa(i, j, k)*p_gamma_aa*p_rhoa
8462 u_a = u_a + g_rhoa_rhob_gamma_aa(i, j, k)*p_gamma_aa*p_rhob
8463 u_a = u_a + g_rhoa_gamma_aa_gamma_aa(i, j, k)*p_gamma_aa*p_gamma_aa
8464 u_a = u_a + g_rhoa_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa*p_gamma_ab
8465 u_a = u_a + g_rhoa_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_bb
8466 u_a = u_a + g_rhoa_rhoa_gamma_ab(i, j, k)*p_gamma_ab*p_rhoa
8467 u_a = u_a + g_rhoa_rhob_gamma_ab(i, j, k)*p_gamma_ab*p_rhob
8468 u_a = u_a + g_rhoa_gamma_aa_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_aa
8469 u_a = u_a + g_rhoa_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_ab
8470 u_a = u_a + g_rhoa_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_bb
8471 u_a = u_a + g_rhoa_rhoa_gamma_bb(i, j, k)*p_gamma_bb*p_rhoa
8472 u_a = u_a + g_rhoa_rhob_gamma_bb(i, j, k)*p_gamma_bb*p_rhob
8473 u_a = u_a + g_rhoa_gamma_aa_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_aa
8474 u_a = u_a + g_rhoa_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_ab
8475 u_a = u_a + g_rhoa_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_bb
8476 u_a = u_a + g_rhoa_gamma_aa(i, j, k)*pp_gamma_aa
8477 u_a = u_a + g_rhoa_gamma_ab(i, j, k)*pp_gamma_ab
8478 u_a = u_a + g_rhoa_gamma_bb(i, j, k)*pp_gamma_bb
8479 u_b = 0.0_dp
8480 u_b = u_b + g_rhoa_rhoa_rhob(i, j, k)*p_rhoa*p_rhoa
8481 u_b = u_b + g_rhoa_rhob_rhob(i, j, k)*p_rhoa*p_rhob
8482 u_b = u_b + g_rhoa_rhob_gamma_aa(i, j, k)*p_rhoa*p_gamma_aa
8483 u_b = u_b + g_rhoa_rhob_gamma_ab(i, j, k)*p_rhoa*p_gamma_ab
8484 u_b = u_b + g_rhoa_rhob_gamma_bb(i, j, k)*p_rhoa*p_gamma_bb
8485 u_b = u_b + g_rhoa_rhob_rhob(i, j, k)*p_rhob*p_rhoa
8486 u_b = u_b + g_rhob_rhob_rhob(i, j, k)*p_rhob*p_rhob
8487 u_b = u_b + g_rhob_rhob_gamma_aa(i, j, k)*p_rhob*p_gamma_aa
8488 u_b = u_b + g_rhob_rhob_gamma_ab(i, j, k)*p_rhob*p_gamma_ab
8489 u_b = u_b + g_rhob_rhob_gamma_bb(i, j, k)*p_rhob*p_gamma_bb
8490 u_b = u_b + g_rhoa_rhob_gamma_aa(i, j, k)*p_gamma_aa*p_rhoa
8491 u_b = u_b + g_rhob_rhob_gamma_aa(i, j, k)*p_gamma_aa*p_rhob
8492 u_b = u_b + g_rhob_gamma_aa_gamma_aa(i, j, k)*p_gamma_aa*p_gamma_aa
8493 u_b = u_b + g_rhob_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa*p_gamma_ab
8494 u_b = u_b + g_rhob_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_bb
8495 u_b = u_b + g_rhoa_rhob_gamma_ab(i, j, k)*p_gamma_ab*p_rhoa
8496 u_b = u_b + g_rhob_rhob_gamma_ab(i, j, k)*p_gamma_ab*p_rhob
8497 u_b = u_b + g_rhob_gamma_aa_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_aa
8498 u_b = u_b + g_rhob_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_ab
8499 u_b = u_b + g_rhob_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_bb
8500 u_b = u_b + g_rhoa_rhob_gamma_bb(i, j, k)*p_gamma_bb*p_rhoa
8501 u_b = u_b + g_rhob_rhob_gamma_bb(i, j, k)*p_gamma_bb*p_rhob
8502 u_b = u_b + g_rhob_gamma_aa_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_aa
8503 u_b = u_b + g_rhob_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_ab
8504 u_b = u_b + g_rhob_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_bb
8505 u_b = u_b + g_rhob_gamma_aa(i, j, k)*pp_gamma_aa
8506 u_b = u_b + g_rhob_gamma_ab(i, j, k)*pp_gamma_ab
8507 u_b = u_b + g_rhob_gamma_bb(i, j, k)*pp_gamma_bb
8508 a_gamma_aa = 0.0_dp
8509 a_gamma_aa = a_gamma_aa + g_rhoa_rhoa_gamma_aa(i, j, k)*p_rhoa*p_rhoa
8510 a_gamma_aa = a_gamma_aa + g_rhoa_rhob_gamma_aa(i, j, k)*p_rhoa*p_rhob
8511 a_gamma_aa = a_gamma_aa + g_rhoa_gamma_aa_gamma_aa(i, j, k)*p_rhoa*p_gamma_aa
8512 a_gamma_aa = a_gamma_aa + g_rhoa_gamma_aa_gamma_ab(i, j, k)*p_rhoa*p_gamma_ab
8513 a_gamma_aa = a_gamma_aa + g_rhoa_gamma_aa_gamma_bb(i, j, k)*p_rhoa*p_gamma_bb
8514 a_gamma_aa = a_gamma_aa + g_rhoa_rhob_gamma_aa(i, j, k)*p_rhob*p_rhoa
8515 a_gamma_aa = a_gamma_aa + g_rhob_rhob_gamma_aa(i, j, k)*p_rhob*p_rhob
8516 a_gamma_aa = a_gamma_aa + g_rhob_gamma_aa_gamma_aa(i, j, k)*p_rhob*p_gamma_aa
8517 a_gamma_aa = a_gamma_aa + g_rhob_gamma_aa_gamma_ab(i, j, k)*p_rhob*p_gamma_ab
8518 a_gamma_aa = a_gamma_aa + g_rhob_gamma_aa_gamma_bb(i, j, k)*p_rhob*p_gamma_bb
8519 a_gamma_aa = a_gamma_aa + g_rhoa_gamma_aa_gamma_aa(i, j, k)*p_gamma_aa*p_rhoa
8520 a_gamma_aa = a_gamma_aa + g_rhob_gamma_aa_gamma_aa(i, j, k)*p_gamma_aa*p_rhob
8521 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_aa_gamma_aa(i, j, k)*p_gamma_aa*p_gamma_aa
8522 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa*p_gamma_ab
8523 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_bb
8524 a_gamma_aa = a_gamma_aa + g_rhoa_gamma_aa_gamma_ab(i, j, k)*p_gamma_ab*p_rhoa
8525 a_gamma_aa = a_gamma_aa + g_rhob_gamma_aa_gamma_ab(i, j, k)*p_gamma_ab*p_rhob
8526 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_aa_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_aa
8527 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_ab
8528 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_bb
8529 a_gamma_aa = a_gamma_aa + g_rhoa_gamma_aa_gamma_bb(i, j, k)*p_gamma_bb*p_rhoa
8530 a_gamma_aa = a_gamma_aa + g_rhob_gamma_aa_gamma_bb(i, j, k)*p_gamma_bb*p_rhob
8531 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_aa_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_aa
8532 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_ab
8533 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_bb
8534 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_aa(i, j, k)*pp_gamma_aa
8535 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_ab(i, j, k)*pp_gamma_ab
8536 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_bb(i, j, k)*pp_gamma_bb
8537 a_gamma_ab = 0.0_dp
8538 a_gamma_ab = a_gamma_ab + g_rhoa_rhoa_gamma_ab(i, j, k)*p_rhoa*p_rhoa
8539 a_gamma_ab = a_gamma_ab + g_rhoa_rhob_gamma_ab(i, j, k)*p_rhoa*p_rhob
8540 a_gamma_ab = a_gamma_ab + g_rhoa_gamma_aa_gamma_ab(i, j, k)*p_rhoa*p_gamma_aa
8541 a_gamma_ab = a_gamma_ab + g_rhoa_gamma_ab_gamma_ab(i, j, k)*p_rhoa*p_gamma_ab
8542 a_gamma_ab = a_gamma_ab + g_rhoa_gamma_ab_gamma_bb(i, j, k)*p_rhoa*p_gamma_bb
8543 a_gamma_ab = a_gamma_ab + g_rhoa_rhob_gamma_ab(i, j, k)*p_rhob*p_rhoa
8544 a_gamma_ab = a_gamma_ab + g_rhob_rhob_gamma_ab(i, j, k)*p_rhob*p_rhob
8545 a_gamma_ab = a_gamma_ab + g_rhob_gamma_aa_gamma_ab(i, j, k)*p_rhob*p_gamma_aa
8546 a_gamma_ab = a_gamma_ab + g_rhob_gamma_ab_gamma_ab(i, j, k)*p_rhob*p_gamma_ab
8547 a_gamma_ab = a_gamma_ab + g_rhob_gamma_ab_gamma_bb(i, j, k)*p_rhob*p_gamma_bb
8548 a_gamma_ab = a_gamma_ab + g_rhoa_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa*p_rhoa
8549 a_gamma_ab = a_gamma_ab + g_rhob_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa*p_rhob
8550 a_gamma_ab = a_gamma_ab + g_gamma_aa_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa*p_gamma_aa
8551 a_gamma_ab = a_gamma_ab + g_gamma_aa_gamma_ab_gamma_ab(i, j, k)*p_gamma_aa*p_gamma_ab
8552 a_gamma_ab = a_gamma_ab + g_gamma_aa_gamma_ab_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_bb
8553 a_gamma_ab = a_gamma_ab + g_rhoa_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_rhoa
8554 a_gamma_ab = a_gamma_ab + g_rhob_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_rhob
8555 a_gamma_ab = a_gamma_ab + g_gamma_aa_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_aa
8556 a_gamma_ab = a_gamma_ab + g_gamma_ab_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_ab
8557 a_gamma_ab = a_gamma_ab + g_gamma_ab_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_bb
8558 a_gamma_ab = a_gamma_ab + g_rhoa_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_rhoa
8559 a_gamma_ab = a_gamma_ab + g_rhob_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_rhob
8560 a_gamma_ab = a_gamma_ab + g_gamma_aa_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_aa
8561 a_gamma_ab = a_gamma_ab + g_gamma_ab_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_ab
8562 a_gamma_ab = a_gamma_ab + g_gamma_ab_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_bb
8563 a_gamma_ab = a_gamma_ab + g_gamma_aa_gamma_ab(i, j, k)*pp_gamma_aa
8564 a_gamma_ab = a_gamma_ab + g_gamma_ab_gamma_ab(i, j, k)*pp_gamma_ab
8565 a_gamma_ab = a_gamma_ab + g_gamma_ab_gamma_bb(i, j, k)*pp_gamma_bb
8566 a_gamma_bb = 0.0_dp
8567 a_gamma_bb = a_gamma_bb + g_rhoa_rhoa_gamma_bb(i, j, k)*p_rhoa*p_rhoa
8568 a_gamma_bb = a_gamma_bb + g_rhoa_rhob_gamma_bb(i, j, k)*p_rhoa*p_rhob
8569 a_gamma_bb = a_gamma_bb + g_rhoa_gamma_aa_gamma_bb(i, j, k)*p_rhoa*p_gamma_aa
8570 a_gamma_bb = a_gamma_bb + g_rhoa_gamma_ab_gamma_bb(i, j, k)*p_rhoa*p_gamma_ab
8571 a_gamma_bb = a_gamma_bb + g_rhoa_gamma_bb_gamma_bb(i, j, k)*p_rhoa*p_gamma_bb
8572 a_gamma_bb = a_gamma_bb + g_rhoa_rhob_gamma_bb(i, j, k)*p_rhob*p_rhoa
8573 a_gamma_bb = a_gamma_bb + g_rhob_rhob_gamma_bb(i, j, k)*p_rhob*p_rhob
8574 a_gamma_bb = a_gamma_bb + g_rhob_gamma_aa_gamma_bb(i, j, k)*p_rhob*p_gamma_aa
8575 a_gamma_bb = a_gamma_bb + g_rhob_gamma_ab_gamma_bb(i, j, k)*p_rhob*p_gamma_ab
8576 a_gamma_bb = a_gamma_bb + g_rhob_gamma_bb_gamma_bb(i, j, k)*p_rhob*p_gamma_bb
8577 a_gamma_bb = a_gamma_bb + g_rhoa_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa*p_rhoa
8578 a_gamma_bb = a_gamma_bb + g_rhob_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa*p_rhob
8579 a_gamma_bb = a_gamma_bb + g_gamma_aa_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_aa
8580 a_gamma_bb = a_gamma_bb + g_gamma_aa_gamma_ab_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_ab
8581 a_gamma_bb = a_gamma_bb + g_gamma_aa_gamma_bb_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_bb
8582 a_gamma_bb = a_gamma_bb + g_rhoa_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_rhoa
8583 a_gamma_bb = a_gamma_bb + g_rhob_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_rhob
8584 a_gamma_bb = a_gamma_bb + g_gamma_aa_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_aa
8585 a_gamma_bb = a_gamma_bb + g_gamma_ab_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_ab
8586 a_gamma_bb = a_gamma_bb + g_gamma_ab_gamma_bb_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_bb
8587 a_gamma_bb = a_gamma_bb + g_rhoa_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_rhoa
8588 a_gamma_bb = a_gamma_bb + g_rhob_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_rhob
8589 a_gamma_bb = a_gamma_bb + g_gamma_aa_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_aa
8590 a_gamma_bb = a_gamma_bb + g_gamma_ab_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_ab
8591 a_gamma_bb = a_gamma_bb + g_gamma_bb_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_bb
8592 a_gamma_bb = a_gamma_bb + g_gamma_aa_gamma_bb(i, j, k)*pp_gamma_aa
8593 a_gamma_bb = a_gamma_bb + g_gamma_ab_gamma_bb(i, j, k)*pp_gamma_ab
8594 a_gamma_bb = a_gamma_bb + g_gamma_bb_gamma_bb(i, j, k)*pp_gamma_bb
8595 b_gamma_aa = 0.0_dp
8596 b_gamma_aa = b_gamma_aa + g_rhoa_gamma_aa(i, j, k)*p_rhoa
8597 b_gamma_aa = b_gamma_aa + g_rhob_gamma_aa(i, j, k)*p_rhob
8598 b_gamma_aa = b_gamma_aa + g_gamma_aa_gamma_aa(i, j, k)*p_gamma_aa
8599 b_gamma_aa = b_gamma_aa + g_gamma_aa_gamma_ab(i, j, k)*p_gamma_ab
8600 b_gamma_aa = b_gamma_aa + g_gamma_aa_gamma_bb(i, j, k)*p_gamma_bb
8601 b_gamma_ab = 0.0_dp
8602 b_gamma_ab = b_gamma_ab + g_rhoa_gamma_ab(i, j, k)*p_rhoa
8603 b_gamma_ab = b_gamma_ab + g_rhob_gamma_ab(i, j, k)*p_rhob
8604 b_gamma_ab = b_gamma_ab + g_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa
8605 b_gamma_ab = b_gamma_ab + g_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab
8606 b_gamma_ab = b_gamma_ab + g_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb
8607 b_gamma_bb = 0.0_dp
8608 b_gamma_bb = b_gamma_bb + g_rhoa_gamma_bb(i, j, k)*p_rhoa
8609 b_gamma_bb = b_gamma_bb + g_rhob_gamma_bb(i, j, k)*p_rhob
8610 b_gamma_bb = b_gamma_bb + g_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa
8611 b_gamma_bb = b_gamma_bb + g_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab
8612 b_gamma_bb = b_gamma_bb + g_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb
8613
8614 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + u_a
8615 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + u_b
8616
8617 ! xc_pw_divergence ADDS div(field); g_xc = u - div(v)
8618 v_drho_r(1, 1)%array(i, j, k) = &
8619 -(2.0_dp*drhoa(1)%array(i, j, k)*a_gamma_aa &
8620 + drhob(1)%array(i, j, k)*a_gamma_ab &
8621 + 2.0_dp*(2.0_dp*drho1a(1)%array(i, j, k)*b_gamma_aa &
8622 + drho1b(1)%array(i, j, k)*b_gamma_ab))
8623 v_drho_r(1, 2)%array(i, j, k) = &
8624 -(2.0_dp*drhob(1)%array(i, j, k)*a_gamma_bb &
8625 + drhoa(1)%array(i, j, k)*a_gamma_ab &
8626 + 2.0_dp*(2.0_dp*drho1b(1)%array(i, j, k)*b_gamma_bb &
8627 + drho1a(1)%array(i, j, k)*b_gamma_ab))
8628 v_drho_r(2, 1)%array(i, j, k) = &
8629 -(2.0_dp*drhoa(2)%array(i, j, k)*a_gamma_aa &
8630 + drhob(2)%array(i, j, k)*a_gamma_ab &
8631 + 2.0_dp*(2.0_dp*drho1a(2)%array(i, j, k)*b_gamma_aa &
8632 + drho1b(2)%array(i, j, k)*b_gamma_ab))
8633 v_drho_r(2, 2)%array(i, j, k) = &
8634 -(2.0_dp*drhob(2)%array(i, j, k)*a_gamma_bb &
8635 + drhoa(2)%array(i, j, k)*a_gamma_ab &
8636 + 2.0_dp*(2.0_dp*drho1b(2)%array(i, j, k)*b_gamma_bb &
8637 + drho1a(2)%array(i, j, k)*b_gamma_ab))
8638 v_drho_r(3, 1)%array(i, j, k) = &
8639 -(2.0_dp*drhoa(3)%array(i, j, k)*a_gamma_aa &
8640 + drhob(3)%array(i, j, k)*a_gamma_ab &
8641 + 2.0_dp*(2.0_dp*drho1a(3)%array(i, j, k)*b_gamma_aa &
8642 + drho1b(3)%array(i, j, k)*b_gamma_ab))
8643 v_drho_r(3, 2)%array(i, j, k) = &
8644 -(2.0_dp*drhob(3)%array(i, j, k)*a_gamma_bb &
8645 + drhoa(3)%array(i, j, k)*a_gamma_ab &
8646 + 2.0_dp*(2.0_dp*drho1b(3)%array(i, j, k)*b_gamma_bb &
8647 + drho1a(3)%array(i, j, k)*b_gamma_ab))
8648 END DO
8649 END DO
8650 END DO
8651
8652 IF (my_gapw) THEN
8653 DO ispin = 1, nspins
8654 DO idir = 1, 3
8655 vxg(idir, :, :, ispin) = -v_drho_r(idir, ispin)%array(:, :, 1)
8656 END DO
8657 END DO
8658 ELSE
8659 IF (my_gapw) THEN
8660 ! vxg carries +V; the plane-wave field above is -V
8661 DO idir = 1, 3
8662 vxg(idir, :, :, 1) = -v_drho_r(idir, 1)%array(:, :, 1)
8663 END DO
8664 ELSE
8665 IF (my_gapw) THEN
8666 DO idir = 1, 3
8667 vxg(idir, :, :, 1) = -v_drho_r(idir, 1)%array(:, :, 1)
8668 END DO
8669 ELSE
8670 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 1), tmp_g, vxc_g, v_xc(1))
8671 END IF
8672 END IF
8673 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 2), tmp_g, vxc_g, v_xc(2))
8674 END IF
8675 END IF
8676 END IF
8677
8678 ELSE
8679
8680 ! vxc contributions
8681 ! vxca = (vxc^{\alpha}-vxc^{\beta})*rho1/|rhoa-rhob|^2
8682 ! vxcb =-(vxc^{\alpha}-vxc^{\beta})*rho1/|rhoa-rhob|^2
8683 ! Alpha LDA contribution
8684 ! | d e_xc d e_xc | rho1a
8685 ! vxca = rho1a*|-------- - --------|*---------------
8686 ! | drhoa drhob | |rhoa - rhob|^2
8687 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa])
8688 IF (ASSOCIATED(deriv_att)) THEN
8689 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8690 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob])
8691 IF (ASSOCIATED(deriv_att)) THEN
8692 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8693!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8694!$OMP SHARED(bo,v_xc,deriv_data,deriv_data2,rho1a,rhoa,rhob,S_THRESH2) COLLAPSE(3)
8695 DO k = bo(1, 3), bo(2, 3)
8696 DO j = bo(1, 2), bo(2, 2)
8697 DO i = bo(1, 1), bo(2, 1)
8698 s = rhoa(i, j, k) - rhob(i, j, k)
8699 s = -sign(max(s**2, s_thresh2), s)
8700 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
8701 (deriv_data(i, j, k) - deriv_data2(i, j, k))*rho1a(i, j, k)**2/s
8702 END DO
8703 END DO
8704 END DO
8705!$OMP END PARALLEL DO
8706 END IF
8707 END IF
8708 ! GGA contributions to the spin-flip xcKernel
8709 ! Alpha GGA contributions
8710 ! | d e_xc d e_xc | rho1a
8711 ! vxca += + |----------*dra1dra - ----------*drb1drb|*---------------
8712 ! | d|drhoa| d|drhob| | |rhoa - rhob|^2
8713 IF (.NOT. alda0) THEN
8714 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa])
8715 IF (ASSOCIATED(deriv_att)) THEN
8716 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8717 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob])
8718 IF (ASSOCIATED(deriv_att)) THEN
8719 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8720!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8721!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,v_xc,rho1a,rhoa,rhob,S_THRESH2) COLLAPSE(3)
8722 DO k = bo(1, 3), bo(2, 3)
8723 DO j = bo(1, 2), bo(2, 2)
8724 DO i = bo(1, 1), bo(2, 1)
8725 s = rhoa(i, j, k) - rhob(i, j, k)
8726 s = -sign(max(s**2, s_thresh2), s)
8727 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
8728 (deriv_data(i, j, k)*dra1dra(i, j, k) - deriv_data2(i, j, k)*drb1drb(i, j, k)) &
8729 *rho1a(i, j, k)/s
8730 END DO
8731 END DO
8732 END DO
8733!$OMP END PARALLEL DO
8734 END IF
8735 END IF
8736 END IF
8737 ! Beta contribution = - alpha
8738!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8739!$OMP SHARED(bo,v_xc) COLLAPSE(3)
8740 DO k = bo(1, 3), bo(2, 3)
8741 DO j = bo(1, 2), bo(2, 2)
8742 DO i = bo(1, 1), bo(2, 1)
8743 v_xc(2)%array(i, j, k) = -v_xc(1)%array(i, j, k)
8744 END DO
8745 END DO
8746 END DO
8747!$OMP END PARALLEL DO
8748 ! fxc contributions
8749 ! vxca = rho1*(fxc^{\alpha\alpha}-fxc^{\alpha\beta})*rho1/|rhoa-rhob|
8750 ! vxcb = rho1*(fxc^{\beta\alpha}-fxc^{\beta\beta})*rho1/|rhoa-rhob|
8751 ! Alpha LDA contribution
8752 ! | d^2 e_xc d^2 e_xc | rho1a
8753 ! vxca += rho1a*|------------- - -------------|*-------------
8754 ! | drhoa drhoa drhoa drhob | |rhoa - rhob|
8755 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_rhob])
8756 IF (ASSOCIATED(deriv_att)) THEN
8757 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8758 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_rhoa])
8759 IF (ASSOCIATED(deriv_att)) THEN
8760 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8761!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8762!$OMP SHARED(bo,deriv_data,deriv_data2,rho1a,v_xc,rhoa,rhob,S_THRESH) COLLAPSE(3)
8763 DO k = bo(1, 3), bo(2, 3)
8764 DO j = bo(1, 2), bo(2, 2)
8765 DO i = bo(1, 1), bo(2, 1)
8766 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
8767 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
8768 rho1a(i, j, k)**2*(deriv_data(i, j, k) - deriv_data2(i, j, k))/s
8769 END DO
8770 END DO
8771 END DO
8772!$OMP END PARALLEL DO
8773 END IF
8774 END IF
8775 ! Beta LDA contribution
8776 ! | d^2 e_xc d^2 e_xc | rho1a
8777 ! vxcb += rho1a*|------------- - -------------|*-------------
8778 ! | drhob drhoa drhob drhob | |rhoa - rhob|
8779 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_rhob])
8780 IF (ASSOCIATED(deriv_att)) THEN
8781 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8782 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_rhoa])
8783 IF (ASSOCIATED(deriv_att)) THEN
8784 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8785!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8786!$OMP SHARED(bo,deriv_data,deriv_data2,rho1a,v_xc,rhoa,rhob,S_THRESH) COLLAPSE(3)
8787 DO k = bo(1, 3), bo(2, 3)
8788 DO j = bo(1, 2), bo(2, 2)
8789 DO i = bo(1, 1), bo(2, 1)
8790 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
8791 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
8792 rho1a(i, j, k)**2*(deriv_data(i, j, k) - deriv_data2(i, j, k))/s
8793 END DO
8794 END DO
8795 END DO
8796!$OMP END PARALLEL DO
8797 END IF
8798 END IF
8799 ! Alpha GGA contribution
8800 IF (.NOT. alda0) THEN
8801 ! rho1a | d^2 e_xc d^2 e_xc |
8802 ! vxca += + -------------*|----------------*dra1dra - ----------------*drb1drb|
8803 ! |rhoa - rhob| | drhoa d|drhoa| drhoa d|drhob| |
8804 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drhob])
8805 IF (ASSOCIATED(deriv_att)) THEN
8806 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8807 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drhoa])
8808 IF (ASSOCIATED(deriv_att)) THEN
8809 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8810!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8811!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,rho1a,v_xc,rhoa,rhob,S_THRESH) COLLAPSE(3)
8812 DO k = bo(1, 3), bo(2, 3)
8813 DO j = bo(1, 2), bo(2, 2)
8814 DO i = bo(1, 1), bo(2, 1)
8815 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
8816 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
8817 (deriv_data(i, j, k)*dra1dra(i, j, k) - deriv_data2(i, j, k)*drb1drb(i, j, k))* &
8818 rho1a(i, j, k)/s
8819 END DO
8820 END DO
8821 END DO
8822!$OMP END PARALLEL DO
8823 END IF
8824 END IF
8825 ! Beta GGA contribution
8826 ! rho1a | d^2 e_xc d^2 e_xc |
8827 ! vxcb += + -------------*|----------------*dra1dra - ----------------*drb1drb|
8828 ! |rhoa - rhob| | drhob d|drhoa| drhob d|drhob| |
8829 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_norm_drhob])
8830 IF (ASSOCIATED(deriv_att)) THEN
8831 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8832 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_norm_drhoa])
8833 IF (ASSOCIATED(deriv_att)) THEN
8834 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8835!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8836!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,rho1a,v_xc,rhoa,rhob,S_THRESH) COLLAPSE(3)
8837 DO k = bo(1, 3), bo(2, 3)
8838 DO j = bo(1, 2), bo(2, 2)
8839 DO i = bo(1, 1), bo(2, 1)
8840 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
8841 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
8842 (deriv_data(i, j, k)*dra1dra(i, j, k) - deriv_data2(i, j, k)*drb1drb(i, j, k))* &
8843 rho1a(i, j, k)/s
8844 END DO
8845 END DO
8846 END DO
8847!$OMP END PARALLEL DO
8848 END IF
8849 END IF
8850 !
8851 !
8852 ! Calculate the vector for the partial integration term of GGA functionals
8853 ! First contribution alpha
8854 ! | d^2 e_xc d^2 e_xc |
8855 ! v_drhoa(1) += -|---------------- - ----------------|*rho1a
8856 ! | d|drhoa| drhoa d|drhoa| drhob |
8857 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_rhob])
8858 IF (ASSOCIATED(deriv_att)) THEN
8859 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8860 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_rhoa])
8861 IF (ASSOCIATED(deriv_att)) THEN
8862 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8863!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
8864!$OMP SHARED(bo,deriv_data,deriv_data2,rho1a,v_drhoa) COLLAPSE(3)
8865 DO k = bo(1, 3), bo(2, 3)
8866 DO j = bo(1, 2), bo(2, 2)
8867 DO i = bo(1, 1), bo(2, 1)
8868 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
8869 (deriv_data(i, j, k) - deriv_data2(i, j, k))*rho1a(i, j, k)
8870 END DO
8871 END DO
8872 END DO
8873!$OMP END PARALLEL DO
8874 END IF
8875 END IF
8876 ! First contribution beta
8877 ! | d^2 e_xc d^2 e_xc |
8878 ! v_drhob(2) += +|---------------- - ----------------|*rho1a
8879 ! | d|drhob| drhob d|drhob| drhoa |
8880 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_rhoa])
8881 IF (ASSOCIATED(deriv_att)) THEN
8882 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8883 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_rhob])
8884 IF (ASSOCIATED(deriv_att)) THEN
8885 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8886!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
8887!$OMP SHARED(bo,deriv_data,deriv_data2,rho1a,v_drhob) COLLAPSE(3)
8888 DO k = bo(1, 3), bo(2, 3)
8889 DO j = bo(1, 2), bo(2, 2)
8890 DO i = bo(1, 1), bo(2, 1)
8891 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) + &
8892 (deriv_data(i, j, k) - deriv_data2(i, j, k))*rho1a(i, j, k)
8893 END DO
8894 END DO
8895 END DO
8896!$OMP END PARALLEL DO
8897 END IF
8898 END IF
8899 ! First contribution spinless
8900 ! | d^2 e_xc d^2 e_xc |
8901 ! v_drho(1) += -|--------------- - ---------------|*rho1a
8902 ! | d|drho| drhoa d|drho| drhob |
8903 !
8904 ! | d^2 e_xc d^2 e_xc |
8905 ! v_drho(2) += -|--------------- - ---------------|*rho1a
8906 ! | d|drho| drhoa d|drho| drhob |
8907 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rhoa])
8908 IF (ASSOCIATED(deriv_att)) THEN
8909 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8910 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rhob])
8911 IF (ASSOCIATED(deriv_att)) THEN
8912 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8913!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
8914!$OMP SHARED(bo,deriv_data,deriv_data2,rho1a,v_drho) COLLAPSE(3)
8915 DO k = bo(1, 3), bo(2, 3)
8916 DO j = bo(1, 2), bo(2, 2)
8917 DO i = bo(1, 1), bo(2, 1)
8918 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
8919 (deriv_data(i, j, k) - deriv_data2(i, j, k))*rho1a(i, j, k)
8920 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
8921 (deriv_data(i, j, k) - deriv_data2(i, j, k))*rho1a(i, j, k)
8922 END DO
8923 END DO
8924 END DO
8925!$OMP END PARALLEL DO
8926 END IF
8927 END IF
8928 ! Second contribution
8929 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drhob])
8930 IF (ASSOCIATED(deriv_att)) THEN
8931 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8932 ! d^2 e_xc d^2 e_xc
8933 ! v_drhoa(1) += - -------------------*dra1dra + ------------------*drb1drb
8934 ! d|drhoa| d|drhoa| d|drhoa| d|drhob|
8935 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drhoa])
8936 IF (ASSOCIATED(deriv_att)) THEN
8937 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8938!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
8939!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,v_drhoa) COLLAPSE(3)
8940 DO k = bo(1, 3), bo(2, 3)
8941 DO j = bo(1, 2), bo(2, 2)
8942 DO i = bo(1, 1), bo(2, 1)
8943 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
8944 deriv_data(i, j, k)*dra1dra(i, j, k) + deriv_data2(i, j, k)*drb1drb(i, j, k)
8945 END DO
8946 END DO
8947 END DO
8948!$OMP END PARALLEL DO
8949 END IF
8950 ! d^2 e_xc d^2 e_xc
8951 ! v_drhob(2) += - -------------------*dra1dra + -------------------*drb1drb
8952 ! d|drhoa| d|drhob| d|drhob| d|drhob|
8953 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_norm_drhob])
8954 IF (ASSOCIATED(deriv_att)) THEN
8955 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8956!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
8957!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,v_drhob) COLLAPSE(3)
8958 DO k = bo(1, 3), bo(2, 3)
8959 DO j = bo(1, 2), bo(2, 2)
8960 DO i = bo(1, 1), bo(2, 1)
8961 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
8962 deriv_data(i, j, k)*dra1dra(i, j, k) + deriv_data2(i, j, k)*drb1drb(i, j, k)
8963 END DO
8964 END DO
8965 END DO
8966!$OMP END PARALLEL DO
8967 END IF
8968 END IF
8969 ! d^2 e_xc d^2 e_xc
8970 ! v_drho(1) += - ------------------*dra1dra + ------------------*drb1drb
8971 ! d|drho| d|drhoa| d|drho| d|drhob|
8972 !
8973 ! d^2 e_xc d^2 e_xc
8974 ! v_drho(2) += - ------------------*dra1dra + ------------------*drb1drb
8975 ! d|drho| d|drhoa| d|drho| d|drhob|
8976 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drhob])
8977 IF (ASSOCIATED(deriv_att)) THEN
8978 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8979 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drhoa])
8980 IF (ASSOCIATED(deriv_att)) THEN
8981 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8982!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
8983!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,v_drho) COLLAPSE(3)
8984 DO k = bo(1, 3), bo(2, 3)
8985 DO j = bo(1, 2), bo(2, 2)
8986 DO i = bo(1, 1), bo(2, 1)
8987 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
8988 deriv_data(i, j, k)*dra1dra(i, j, k) + &
8989 deriv_data2(i, j, k)*drb1drb(i, j, k)
8990 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
8991 deriv_data(i, j, k)*dra1dra(i, j, k) + &
8992 deriv_data2(i, j, k)*drb1drb(i, j, k)
8993 END DO
8994 END DO
8995 END DO
8996!$OMP END PARALLEL DO
8997 END IF
8998 END IF
8999 !
9000
9001 ! Last GGA contribution
9002 ! Alpha contribution
9003 ! d e_xc
9004 ! v_drhoa(1) += + ----------*dra1dra
9005 ! d|drhoa|
9006 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa])
9007 IF (ASSOCIATED(deriv_att)) THEN
9008 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
9009 CALL xc_derivative_get(deriv_att, deriv_data=e_drhoa)
9010
9011!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dra1dra,gradient_cut,norm_drhoa,v_drhoa,deriv_data)
9012 v_drhoa(1)%array(:, :, :) = v_drhoa(1)%array(:, :, :) + &
9013 deriv_data(:, :, :)*dra1dra(:, :, :)/max(gradient_cut, norm_drhoa(:, :, :))**2
9014!$OMP END PARALLEL WORKSHARE
9015 END IF
9016 ! Beta contribution
9017 ! d e_xc
9018 ! v_drhob(2) += - ----------*drb1drb
9019 ! d|drhob|
9020 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob])
9021 IF (ASSOCIATED(deriv_att)) THEN
9022 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
9023 CALL xc_derivative_get(deriv_att, deriv_data=e_drhob)
9024
9025!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drb1drb,gradient_cut,norm_drhob,v_drhob,deriv_data)
9026 v_drhob(2)%array(:, :, :) = v_drhob(2)%array(:, :, :) - &
9027 deriv_data(:, :, :)*drb1drb(:, :, :)/max(gradient_cut, norm_drhob(:, :, :))**2
9028!$OMP END PARALLEL WORKSHARE
9029 END IF
9030 END IF ! If ALDA0
9031 END IF
9032
9033 ELSE
9034
9035 ! Analytic third derivative for closed-shell
9036 cpabort("Exchange-correlation's analytic third derivative not implemented")
9037
9038 END IF
9039
9040 IF (gradient_f) THEN
9041 ! This partial integration is written for the spin-flip kernel only;
9042 ! the gamma-form branch above does its own divergence. The cleanup
9043 ! below, however, has to run for both.
9044 IF (.NOT. alda0 .AND. do_spinflip) THEN
9045
9046 ! partial integration
9047 DO idir = 1, 3
9048
9049 ! GGA contributions to the spin-flip xc-Kernel
9050 !
9051 ! v_drhoa(1)*drhoa(:)*rhoa1 v_drhob(1)*drhob(:)*rhoa1 v_drho(1)*drho(:)*rhoa1
9052 ! v_drho_r(:,1) = --------------------------- + --------------------------- + -------------------------
9053 ! |rhoa - rhob| |rhoa - rhob| |rhoa - rhob|
9054 !
9055 ! v_drhoa(2)*drhoa(:)*rhoa1 v_drhob(2)*drhob(:)*rhoa1 v_drho(2)*drho(:)*rhoa1
9056 ! v_drho_r(:,2) = --------------------------- + --------------------------- + -------------------------
9057 ! |rhoa - rhob| |rhoa - rhob| |rhoa - rhob|
9058 IF (do_spinflip) THEN
9059!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
9060!$OMP SHARED(bo,v_drho_r,v_drho,v_drhoa,v_drhob,rhoa,rhob,drho,drhoa,drhob,rho1a,idir,S_THRESH) COLLAPSE(3)
9061 DO k = bo(1, 3), bo(2, 3)
9062 DO j = bo(1, 2), bo(2, 2)
9063 DO i = bo(1, 1), bo(2, 1)
9064 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
9065 DO ispin = 1, 2
9066 v_drho_r(idir, ispin)%array(i, j, k) = v_drho_r(idir, ispin)%array(i, j, k) + &
9067 v_drhoa(ispin)%array(i, j, k)*drhoa(idir)%array(i, j, k)*rho1a(i, j, k)/s + &
9068 v_drhob(ispin)%array(i, j, k)*drhob(idir)%array(i, j, k)*rho1a(i, j, k)/s + &
9069 v_drho(ispin)%array(i, j, k)*drho(idir)%array(i, j, k)*rho1a(i, j, k)/s
9070 END DO
9071 END DO
9072 END DO
9073 END DO
9074!$OMP END PARALLEL DO
9075 END IF
9076 ! Last GGA contribution
9077 ! Alpha contribution
9078 ! rho1a d e_xc
9079 ! v_drho_r(:,1) += - -------------*----------*drho1a(:)
9080 ! |rhoa - rhob| d|drhoa|
9081 IF (ASSOCIATED(e_drhoa)) THEN
9082!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
9083!$OMP SHARED(bo,e_drhoa,v_drho_r,drho1a,rho1a,rhoa,rhob,S_THRESH,idir) COLLAPSE(3)
9084 DO k = bo(1, 3), bo(2, 3)
9085 DO j = bo(1, 2), bo(2, 2)
9086 DO i = bo(1, 1), bo(2, 1)
9087 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
9088 v_drho_r(idir, 1)%array(i, j, k) = v_drho_r(idir, 1)%array(i, j, k) - &
9089 e_drhoa(i, j, k)*drho1a(idir)%array(i, j, k)*rho1a(i, j, k)/s
9090 END DO
9091 END DO
9092 END DO
9093!$OMP END PARALLEL DO
9094 END IF
9095 ! Beta contribution
9096 ! rho1a d e_xc
9097 ! v_drho_r(:,2) += + -------------*----------*drho1a(:)
9098 ! |rhoa - rhob| d|drhob|
9099 IF (ASSOCIATED(e_drhob)) THEN
9100!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
9101!$OMP SHARED(bo,e_drhob,v_drho_r,drho1a,rho1a,rhoa,rhob,S_THRESH,idir) COLLAPSE(3)
9102 DO k = bo(1, 3), bo(2, 3)
9103 DO j = bo(1, 2), bo(2, 2)
9104 DO i = bo(1, 1), bo(2, 1)
9105 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
9106 v_drho_r(idir, 2)%array(i, j, k) = v_drho_r(idir, 2)%array(i, j, k) + &
9107 e_drhob(i, j, k)*drho1a(idir)%array(i, j, k)*rho1a(i, j, k)/s
9108 END DO
9109 END DO
9110 END DO
9111!$OMP END PARALLEL DO
9112 END IF
9113 END DO
9114
9115 ! partial integration: v_xc = v_xc - \nabla \cdot vdrho_r
9116 DO ispin = 1, nspins
9117 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, ispin), tmp_g, vxc_g, v_xc(ispin))
9118 END DO ! ispin
9119 END IF ! ALDA0
9120
9121 DO idir = 1, 3
9122 DEALLOCATE (drho(idir)%array)
9123 DEALLOCATE (drho1(idir)%array)
9124 END DO
9125
9126 DO ispin = 1, nspins
9127 CALL deallocate_pw(v_drhoa(ispin), pw_pool)
9128 CALL deallocate_pw(v_drhob(ispin), pw_pool)
9129 END DO
9130
9131 DEALLOCATE (v_drhoa, v_drhob)
9132
9133 END IF ! gradient_f
9134
9135 ELSE
9136
9137 !-----------------!
9138 ! restricted case !
9139 !-----------------!
9140 !
9141 ! Third functional derivative contracted twice with the response density,
9142 ! in the reduced-gradient variables gamma = |grad rho|^2 (LibXC's sigma):
9143 !
9144 ! g_xc = u - div(v)
9145 ! u = e_rrr rho1^2 + 2 e_rrg rho1 g1 + e_rgg g1^2 + e_rg g11
9146 ! A = e_rrg rho1^2 + 2 e_rgg rho1 g1 + e_ggg g1^2 + e_gg g11
9147 ! B = e_rg rho1 + e_gg g1
9148 ! v = 2 grad rho A + 4 grad rho1 B
9149 !
9150 ! with g1 = 2 grad rho . grad rho1 and g11 = 2 |grad rho1|^2. Working in
9151 ! gamma rather than in |grad rho| is what makes this terminate: gamma is
9152 ! quadratic in grad rho, so its third variation vanishes identically and
9153 ! no inverse powers of |grad rho| appear anywhere.
9154
9155 CALL xc_rho_set_get(rho1_set, rho=rho1)
9156
9157 NULLIFY (e_rrr, e_rrg, e_rgg, e_ggg, e_rg, e_gg)
9158 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_rho, deriv_rho])
9159 IF (ASSOCIATED(deriv_att)) CALL xc_derivative_get(deriv_att, deriv_data=e_rrr)
9160
9161 IF (gradient_f) THEN
9162 CALL xc_rho_set_get(rho_set, drho=drho)
9163 CALL xc_rho_set_get(rho1_set, drho=drho1)
9164 CALL prepare_dr1dr(dr1dr, drho, drho1)
9165 CALL prepare_dr1dr(dr1dr1, drho1, drho1)
9166
9167 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_rho, deriv_gamma])
9168 IF (ASSOCIATED(deriv_att)) CALL xc_derivative_get(deriv_att, deriv_data=e_rrg)
9169 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_gamma, deriv_gamma])
9170 IF (ASSOCIATED(deriv_att)) CALL xc_derivative_get(deriv_att, deriv_data=e_rgg)
9171 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_gamma, deriv_gamma, deriv_gamma])
9172 IF (ASSOCIATED(deriv_att)) CALL xc_derivative_get(deriv_att, deriv_data=e_ggg)
9173 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_gamma])
9174 IF (ASSOCIATED(deriv_att)) CALL xc_derivative_get(deriv_att, deriv_data=e_rg)
9175 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_gamma, deriv_gamma])
9176 IF (ASSOCIATED(deriv_att)) CALL xc_derivative_get(deriv_att, deriv_data=e_gg)
9177
9178 ! The gamma derivatives are supplied by the LibXC path. Functionals
9179 ! implemented natively in CP2K still deliver only the norm_drho ones,
9180 ! for which the third derivative has not been written out.
9181 IF (.NOT. (ASSOCIATED(e_rrr) .AND. ASSOCIATED(e_rrg) .AND. ASSOCIATED(e_rgg) &
9182 .AND. ASSOCIATED(e_ggg) .AND. ASSOCIATED(e_rg) .AND. ASSOCIATED(e_gg))) THEN
9183 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
9184 END IF
9185 END IF
9186
9187 IF (gradient_f .AND. (tau_f .OR. laplace_f)) THEN
9188
9189 ! Restricted meta-GGA. Same gamma formulation as the GGA branch, with
9190 ! the variable set widened to (rho, gamma, laplace_rho, tau). tau and
9191 ! the Laplacian are linear in the density, so their second variations
9192 ! vanish and only gamma contributes a gK11 term.
9193 !
9194 ! out_Z = sum_XY e_{Z X Y} X1 Y1 + e_{Z gamma} gamma11
9195 ! A = out_gamma, B = sum_Y e_{gamma Y} Y1
9196 ! v = 2 grad rho A + 4 grad rho1 B
9197 !
9198 ! out_rho -> v_xc, out_tau -> v_xc_tau, out_laplace_rho -> v_laplace
9199 ! (folded back through xc_pw_laplace below).
9200
9201 CALL xc_rho_set_get(rho_set, drho=drho)
9202 CALL xc_rho_set_get(rho1_set, drho=drho1)
9203 CALL prepare_dr1dr(dr1dr, drho, drho1)
9204 CALL prepare_dr1dr(dr1dr1, drho1, drho1)
9205 IF (tau_f) CALL xc_rho_set_get(rho1_set, tau=tau1)
9206 IF (laplace_f) CALL xc_rho_set_get(rho1_set, laplace_rho=laplace1)
9207
9208 ! a zero field stands in for derivatives this functional does not have
9209 ALLOCATE (zero_f(bo(1, 1):bo(2, 1), bo(1, 2):bo(2, 2), bo(1, 3):bo(2, 3)))
9210 zero_f = 0.0_dp
9211 deriv_att => xc_dset_get_derivative(deriv_set, &
9212 [deriv_rho, deriv_rho])
9213 IF (ASSOCIATED(deriv_att)) THEN
9214 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_rho)
9215 ELSE
9216 m_rho_rho => zero_f
9217 END IF
9218 deriv_att => xc_dset_get_derivative(deriv_set, &
9219 [deriv_rho, deriv_gamma])
9220 IF (ASSOCIATED(deriv_att)) THEN
9221 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_gamma)
9222 ELSE
9223 m_rho_gamma => zero_f
9224 END IF
9225 deriv_att => xc_dset_get_derivative(deriv_set, &
9226 [deriv_rho, deriv_laplace_rho])
9227 IF (ASSOCIATED(deriv_att)) THEN
9228 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_laplace_rho)
9229 ELSE
9230 m_rho_laplace_rho => zero_f
9231 END IF
9232 deriv_att => xc_dset_get_derivative(deriv_set, &
9233 [deriv_rho, deriv_tau])
9234 IF (ASSOCIATED(deriv_att)) THEN
9235 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_tau)
9236 ELSE
9237 m_rho_tau => zero_f
9238 END IF
9239 deriv_att => xc_dset_get_derivative(deriv_set, &
9240 [deriv_gamma, deriv_gamma])
9241 IF (ASSOCIATED(deriv_att)) THEN
9242 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_gamma)
9243 ELSE
9244 m_gamma_gamma => zero_f
9245 END IF
9246 deriv_att => xc_dset_get_derivative(deriv_set, &
9247 [deriv_gamma, deriv_laplace_rho])
9248 IF (ASSOCIATED(deriv_att)) THEN
9249 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_laplace_rho)
9250 ELSE
9251 m_gamma_laplace_rho => zero_f
9252 END IF
9253 deriv_att => xc_dset_get_derivative(deriv_set, &
9254 [deriv_gamma, deriv_tau])
9255 IF (ASSOCIATED(deriv_att)) THEN
9256 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_tau)
9257 ELSE
9258 m_gamma_tau => zero_f
9259 END IF
9260 deriv_att => xc_dset_get_derivative(deriv_set, &
9261 [deriv_laplace_rho, deriv_laplace_rho])
9262 IF (ASSOCIATED(deriv_att)) THEN
9263 CALL xc_derivative_get(deriv_att, deriv_data=m_laplace_rho_laplace_rho)
9264 ELSE
9265 m_laplace_rho_laplace_rho => zero_f
9266 END IF
9267 deriv_att => xc_dset_get_derivative(deriv_set, &
9268 [deriv_laplace_rho, deriv_tau])
9269 IF (ASSOCIATED(deriv_att)) THEN
9270 CALL xc_derivative_get(deriv_att, deriv_data=m_laplace_rho_tau)
9271 ELSE
9272 m_laplace_rho_tau => zero_f
9273 END IF
9274 deriv_att => xc_dset_get_derivative(deriv_set, &
9275 [deriv_tau, deriv_tau])
9276 IF (ASSOCIATED(deriv_att)) THEN
9277 CALL xc_derivative_get(deriv_att, deriv_data=m_tau_tau)
9278 ELSE
9279 m_tau_tau => zero_f
9280 END IF
9281 deriv_att => xc_dset_get_derivative(deriv_set, &
9282 [deriv_rho, deriv_rho, deriv_rho])
9283 IF (ASSOCIATED(deriv_att)) THEN
9284 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_rho_rho)
9285 ELSE
9286 m_rho_rho_rho => zero_f
9287 END IF
9288 deriv_att => xc_dset_get_derivative(deriv_set, &
9289 [deriv_rho, deriv_rho, deriv_gamma])
9290 IF (ASSOCIATED(deriv_att)) THEN
9291 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_rho_gamma)
9292 ELSE
9293 m_rho_rho_gamma => zero_f
9294 END IF
9295 deriv_att => xc_dset_get_derivative(deriv_set, &
9296 [deriv_rho, deriv_rho, deriv_laplace_rho])
9297 IF (ASSOCIATED(deriv_att)) THEN
9298 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_rho_laplace_rho)
9299 ELSE
9300 m_rho_rho_laplace_rho => zero_f
9301 END IF
9302 deriv_att => xc_dset_get_derivative(deriv_set, &
9303 [deriv_rho, deriv_rho, deriv_tau])
9304 IF (ASSOCIATED(deriv_att)) THEN
9305 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_rho_tau)
9306 ELSE
9307 m_rho_rho_tau => zero_f
9308 END IF
9309 deriv_att => xc_dset_get_derivative(deriv_set, &
9310 [deriv_rho, deriv_gamma, deriv_gamma])
9311 IF (ASSOCIATED(deriv_att)) THEN
9312 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_gamma_gamma)
9313 ELSE
9314 m_rho_gamma_gamma => zero_f
9315 END IF
9316 deriv_att => xc_dset_get_derivative(deriv_set, &
9317 [deriv_rho, deriv_gamma, deriv_laplace_rho])
9318 IF (ASSOCIATED(deriv_att)) THEN
9319 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_gamma_laplace_rho)
9320 ELSE
9321 m_rho_gamma_laplace_rho => zero_f
9322 END IF
9323 deriv_att => xc_dset_get_derivative(deriv_set, &
9324 [deriv_rho, deriv_gamma, deriv_tau])
9325 IF (ASSOCIATED(deriv_att)) THEN
9326 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_gamma_tau)
9327 ELSE
9328 m_rho_gamma_tau => zero_f
9329 END IF
9330 deriv_att => xc_dset_get_derivative(deriv_set, &
9331 [deriv_rho, deriv_laplace_rho, deriv_laplace_rho])
9332 IF (ASSOCIATED(deriv_att)) THEN
9333 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_laplace_rho_laplace_rho)
9334 ELSE
9335 m_rho_laplace_rho_laplace_rho => zero_f
9336 END IF
9337 deriv_att => xc_dset_get_derivative(deriv_set, &
9338 [deriv_rho, deriv_laplace_rho, deriv_tau])
9339 IF (ASSOCIATED(deriv_att)) THEN
9340 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_laplace_rho_tau)
9341 ELSE
9342 m_rho_laplace_rho_tau => zero_f
9343 END IF
9344 deriv_att => xc_dset_get_derivative(deriv_set, &
9345 [deriv_rho, deriv_tau, deriv_tau])
9346 IF (ASSOCIATED(deriv_att)) THEN
9347 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_tau_tau)
9348 ELSE
9349 m_rho_tau_tau => zero_f
9350 END IF
9351 deriv_att => xc_dset_get_derivative(deriv_set, &
9352 [deriv_gamma, deriv_gamma, deriv_gamma])
9353 IF (ASSOCIATED(deriv_att)) THEN
9354 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_gamma_gamma)
9355 ELSE
9356 m_gamma_gamma_gamma => zero_f
9357 END IF
9358 deriv_att => xc_dset_get_derivative(deriv_set, &
9359 [deriv_gamma, deriv_gamma, deriv_laplace_rho])
9360 IF (ASSOCIATED(deriv_att)) THEN
9361 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_gamma_laplace_rho)
9362 ELSE
9363 m_gamma_gamma_laplace_rho => zero_f
9364 END IF
9365 deriv_att => xc_dset_get_derivative(deriv_set, &
9366 [deriv_gamma, deriv_gamma, deriv_tau])
9367 IF (ASSOCIATED(deriv_att)) THEN
9368 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_gamma_tau)
9369 ELSE
9370 m_gamma_gamma_tau => zero_f
9371 END IF
9372 deriv_att => xc_dset_get_derivative(deriv_set, &
9373 [deriv_gamma, deriv_laplace_rho, deriv_laplace_rho])
9374 IF (ASSOCIATED(deriv_att)) THEN
9375 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_laplace_rho_laplace_rho)
9376 ELSE
9377 m_gamma_laplace_rho_laplace_rho => zero_f
9378 END IF
9379 deriv_att => xc_dset_get_derivative(deriv_set, &
9380 [deriv_gamma, deriv_laplace_rho, deriv_tau])
9381 IF (ASSOCIATED(deriv_att)) THEN
9382 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_laplace_rho_tau)
9383 ELSE
9384 m_gamma_laplace_rho_tau => zero_f
9385 END IF
9386 deriv_att => xc_dset_get_derivative(deriv_set, &
9387 [deriv_gamma, deriv_tau, deriv_tau])
9388 IF (ASSOCIATED(deriv_att)) THEN
9389 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_tau_tau)
9390 ELSE
9391 m_gamma_tau_tau => zero_f
9392 END IF
9393 deriv_att => xc_dset_get_derivative(deriv_set, &
9394 [deriv_laplace_rho, deriv_laplace_rho, deriv_laplace_rho])
9395 IF (ASSOCIATED(deriv_att)) THEN
9396 CALL xc_derivative_get(deriv_att, deriv_data=m_laplace_rho_laplace_rho_laplace_rho)
9397 ELSE
9398 m_laplace_rho_laplace_rho_laplace_rho => zero_f
9399 END IF
9400 deriv_att => xc_dset_get_derivative(deriv_set, &
9401 [deriv_laplace_rho, deriv_laplace_rho, deriv_tau])
9402 IF (ASSOCIATED(deriv_att)) THEN
9403 CALL xc_derivative_get(deriv_att, deriv_data=m_laplace_rho_laplace_rho_tau)
9404 ELSE
9405 m_laplace_rho_laplace_rho_tau => zero_f
9406 END IF
9407 deriv_att => xc_dset_get_derivative(deriv_set, &
9408 [deriv_laplace_rho, deriv_tau, deriv_tau])
9409 IF (ASSOCIATED(deriv_att)) THEN
9410 CALL xc_derivative_get(deriv_att, deriv_data=m_laplace_rho_tau_tau)
9411 ELSE
9412 m_laplace_rho_tau_tau => zero_f
9413 END IF
9414 deriv_att => xc_dset_get_derivative(deriv_set, &
9415 [deriv_tau, deriv_tau, deriv_tau])
9416 IF (ASSOCIATED(deriv_att)) THEN
9417 CALL xc_derivative_get(deriv_att, deriv_data=m_tau_tau_tau)
9418 ELSE
9419 m_tau_tau_tau => zero_f
9420 END IF
9421
9422 IF (laplace_f) THEN
9423 ALLOCATE (v_laplace(nspins))
9424 DO ispin = 1, nspins
9425 CALL allocate_pw(v_laplace(ispin), pw_pool, bo)
9426 END DO
9427 END IF
9428
9429!$OMP PARALLEL DO PRIVATE(k,j,i,mp_rho,mp_gamma,mp_laplace_rho,mp_tau,mpp_gamma, &
9430!$OMP m_rho,m_gamma,m_laplace_rho,m_tau,m_B) DEFAULT(NONE) COLLAPSE(3) &
9431!$OMP SHARED(m_rho_rho) &
9432!$OMP SHARED(m_rho_gamma) &
9433!$OMP SHARED(m_rho_laplace_rho) &
9434!$OMP SHARED(m_rho_tau) &
9435!$OMP SHARED(m_gamma_gamma) &
9436!$OMP SHARED(m_gamma_laplace_rho) &
9437!$OMP SHARED(m_gamma_tau) &
9438!$OMP SHARED(m_laplace_rho_laplace_rho) &
9439!$OMP SHARED(m_laplace_rho_tau) &
9440!$OMP SHARED(m_tau_tau) &
9441!$OMP SHARED(m_rho_rho_rho) &
9442!$OMP SHARED(m_rho_rho_gamma) &
9443!$OMP SHARED(m_rho_rho_laplace_rho) &
9444!$OMP SHARED(m_rho_rho_tau) &
9445!$OMP SHARED(m_rho_gamma_gamma) &
9446!$OMP SHARED(m_rho_gamma_laplace_rho) &
9447!$OMP SHARED(m_rho_gamma_tau) &
9448!$OMP SHARED(m_rho_laplace_rho_laplace_rho) &
9449!$OMP SHARED(m_rho_laplace_rho_tau) &
9450!$OMP SHARED(m_rho_tau_tau) &
9451!$OMP SHARED(m_gamma_gamma_gamma) &
9452!$OMP SHARED(m_gamma_gamma_laplace_rho) &
9453!$OMP SHARED(m_gamma_gamma_tau) &
9454!$OMP SHARED(m_gamma_laplace_rho_laplace_rho) &
9455!$OMP SHARED(m_gamma_laplace_rho_tau) &
9456!$OMP SHARED(m_gamma_tau_tau) &
9457!$OMP SHARED(m_laplace_rho_laplace_rho_laplace_rho) &
9458!$OMP SHARED(m_laplace_rho_laplace_rho_tau) &
9459!$OMP SHARED(m_laplace_rho_tau_tau) &
9460!$OMP SHARED(m_tau_tau_tau) &
9461!$OMP SHARED(bo,rho1,dr1dr,dr1dr1,tau_f,tau1,laplace_f,laplace1, &
9462!$OMP v_xc,v_xc_tau,v_laplace,v_drho_r,drho,drho1)
9463 DO k = bo(1, 3), bo(2, 3)
9464 DO j = bo(1, 2), bo(2, 2)
9465 DO i = bo(1, 1), bo(2, 1)
9466 mp_rho = rho1(i, j, k)
9467 mp_gamma = 2.0_dp*dr1dr(i, j, k)
9468 mpp_gamma = 2.0_dp*dr1dr1(i, j, k)
9469 mp_tau = 0.0_dp
9470 IF (tau_f) mp_tau = tau1(i, j, k)
9471 mp_laplace_rho = 0.0_dp
9472 IF (laplace_f) mp_laplace_rho = laplace1(i, j, k)
9473
9474 m_rho = 0.0_dp
9475 m_rho = m_rho + 1.0_dp* &
9476 m_rho_rho_rho(i, j, k)*mp_rho*mp_rho
9477 m_rho = m_rho + 2.0_dp* &
9478 m_rho_rho_gamma(i, j, k)*mp_rho*mp_gamma
9479 m_rho = m_rho + 2.0_dp* &
9480 m_rho_rho_laplace_rho(i, j, k)*mp_rho*mp_laplace_rho
9481 m_rho = m_rho + 2.0_dp* &
9482 m_rho_rho_tau(i, j, k)*mp_rho*mp_tau
9483 m_rho = m_rho + 1.0_dp* &
9484 m_rho_gamma_gamma(i, j, k)*mp_gamma*mp_gamma
9485 m_rho = m_rho + 2.0_dp* &
9486 m_rho_gamma_laplace_rho(i, j, k)*mp_gamma*mp_laplace_rho
9487 m_rho = m_rho + 2.0_dp* &
9488 m_rho_gamma_tau(i, j, k)*mp_gamma*mp_tau
9489 m_rho = m_rho + 1.0_dp* &
9490 m_rho_laplace_rho_laplace_rho(i, j, k)*mp_laplace_rho*mp_laplace_rho
9491 m_rho = m_rho + 2.0_dp* &
9492 m_rho_laplace_rho_tau(i, j, k)*mp_laplace_rho*mp_tau
9493 m_rho = m_rho + 1.0_dp* &
9494 m_rho_tau_tau(i, j, k)*mp_tau*mp_tau
9495 m_rho = m_rho + m_rho_gamma(i, j, k)*mpp_gamma
9496 m_gamma = 0.0_dp
9497 m_gamma = m_gamma + 1.0_dp* &
9498 m_rho_rho_gamma(i, j, k)*mp_rho*mp_rho
9499 m_gamma = m_gamma + 2.0_dp* &
9500 m_rho_gamma_gamma(i, j, k)*mp_rho*mp_gamma
9501 m_gamma = m_gamma + 2.0_dp* &
9502 m_rho_gamma_laplace_rho(i, j, k)*mp_rho*mp_laplace_rho
9503 m_gamma = m_gamma + 2.0_dp* &
9504 m_rho_gamma_tau(i, j, k)*mp_rho*mp_tau
9505 m_gamma = m_gamma + 1.0_dp* &
9506 m_gamma_gamma_gamma(i, j, k)*mp_gamma*mp_gamma
9507 m_gamma = m_gamma + 2.0_dp* &
9508 m_gamma_gamma_laplace_rho(i, j, k)*mp_gamma*mp_laplace_rho
9509 m_gamma = m_gamma + 2.0_dp* &
9510 m_gamma_gamma_tau(i, j, k)*mp_gamma*mp_tau
9511 m_gamma = m_gamma + 1.0_dp* &
9512 m_gamma_laplace_rho_laplace_rho(i, j, k)*mp_laplace_rho*mp_laplace_rho
9513 m_gamma = m_gamma + 2.0_dp* &
9514 m_gamma_laplace_rho_tau(i, j, k)*mp_laplace_rho*mp_tau
9515 m_gamma = m_gamma + 1.0_dp* &
9516 m_gamma_tau_tau(i, j, k)*mp_tau*mp_tau
9517 m_gamma = m_gamma + m_gamma_gamma(i, j, k)*mpp_gamma
9518 m_laplace_rho = 0.0_dp
9519 m_laplace_rho = m_laplace_rho + 1.0_dp* &
9520 m_rho_rho_laplace_rho(i, j, k)*mp_rho*mp_rho
9521 m_laplace_rho = m_laplace_rho + 2.0_dp* &
9522 m_rho_gamma_laplace_rho(i, j, k)*mp_rho*mp_gamma
9523 m_laplace_rho = m_laplace_rho + 2.0_dp* &
9524 m_rho_laplace_rho_laplace_rho(i, j, k)*mp_rho*mp_laplace_rho
9525 m_laplace_rho = m_laplace_rho + 2.0_dp* &
9526 m_rho_laplace_rho_tau(i, j, k)*mp_rho*mp_tau
9527 m_laplace_rho = m_laplace_rho + 1.0_dp* &
9528 m_gamma_gamma_laplace_rho(i, j, k)*mp_gamma*mp_gamma
9529 m_laplace_rho = m_laplace_rho + 2.0_dp* &
9530 m_gamma_laplace_rho_laplace_rho(i, j, k)*mp_gamma*mp_laplace_rho
9531 m_laplace_rho = m_laplace_rho + 2.0_dp* &
9532 m_gamma_laplace_rho_tau(i, j, k)*mp_gamma*mp_tau
9533 m_laplace_rho = m_laplace_rho + 1.0_dp* &
9534 m_laplace_rho_laplace_rho_laplace_rho(i, j, k)*mp_laplace_rho*mp_laplace_rho
9535 m_laplace_rho = m_laplace_rho + 2.0_dp* &
9536 m_laplace_rho_laplace_rho_tau(i, j, k)*mp_laplace_rho*mp_tau
9537 m_laplace_rho = m_laplace_rho + 1.0_dp* &
9538 m_laplace_rho_tau_tau(i, j, k)*mp_tau*mp_tau
9539 m_laplace_rho = m_laplace_rho + m_gamma_laplace_rho(i, j, k)*mpp_gamma
9540 m_tau = 0.0_dp
9541 m_tau = m_tau + 1.0_dp* &
9542 m_rho_rho_tau(i, j, k)*mp_rho*mp_rho
9543 m_tau = m_tau + 2.0_dp* &
9544 m_rho_gamma_tau(i, j, k)*mp_rho*mp_gamma
9545 m_tau = m_tau + 2.0_dp* &
9546 m_rho_laplace_rho_tau(i, j, k)*mp_rho*mp_laplace_rho
9547 m_tau = m_tau + 2.0_dp* &
9548 m_rho_tau_tau(i, j, k)*mp_rho*mp_tau
9549 m_tau = m_tau + 1.0_dp* &
9550 m_gamma_gamma_tau(i, j, k)*mp_gamma*mp_gamma
9551 m_tau = m_tau + 2.0_dp* &
9552 m_gamma_laplace_rho_tau(i, j, k)*mp_gamma*mp_laplace_rho
9553 m_tau = m_tau + 2.0_dp* &
9554 m_gamma_tau_tau(i, j, k)*mp_gamma*mp_tau
9555 m_tau = m_tau + 1.0_dp* &
9556 m_laplace_rho_laplace_rho_tau(i, j, k)*mp_laplace_rho*mp_laplace_rho
9557 m_tau = m_tau + 2.0_dp* &
9558 m_laplace_rho_tau_tau(i, j, k)*mp_laplace_rho*mp_tau
9559 m_tau = m_tau + 1.0_dp* &
9560 m_tau_tau_tau(i, j, k)*mp_tau*mp_tau
9561 m_tau = m_tau + m_gamma_tau(i, j, k)*mpp_gamma
9562 m_b = 0.0_dp
9563 m_b = m_b + m_rho_gamma(i, j, k)*mp_rho
9564 m_b = m_b + m_gamma_gamma(i, j, k)*mp_gamma
9565 m_b = m_b + m_gamma_laplace_rho(i, j, k)*mp_laplace_rho
9566 m_b = m_b + m_gamma_tau(i, j, k)*mp_tau
9567
9568 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + m_rho
9569 IF (tau_f) v_xc_tau(1)%array(i, j, k) = &
9570 v_xc_tau(1)%array(i, j, k) + m_tau
9571 IF (laplace_f) v_laplace(1)%array(i, j, k) = &
9572 v_laplace(1)%array(i, j, k) + m_laplace_rho
9573
9574 ! xc_pw_divergence ADDS div(field), and g_xc = u - div(v)
9575 v_drho_r(1, 1)%array(i, j, k) = &
9576 -(2.0_dp*drho(1)%array(i, j, k)*m_gamma &
9577 + 4.0_dp*drho1(1)%array(i, j, k)*m_b)
9578 v_drho_r(2, 1)%array(i, j, k) = &
9579 -(2.0_dp*drho(2)%array(i, j, k)*m_gamma &
9580 + 4.0_dp*drho1(2)%array(i, j, k)*m_b)
9581 v_drho_r(3, 1)%array(i, j, k) = &
9582 -(2.0_dp*drho(3)%array(i, j, k)*m_gamma &
9583 + 4.0_dp*drho1(3)%array(i, j, k)*m_b)
9584 END DO
9585 END DO
9586 END DO
9587
9588 IF (my_gapw) THEN
9589 DO idir = 1, 3
9590 vxg(idir, :, :, 1) = -v_drho_r(idir, 1)%array(:, :, 1)
9591 END DO
9592 ELSE
9593 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 1), tmp_g, vxc_g, v_xc(1))
9594 END IF
9595
9596 IF (laplace_f) THEN
9597 DO ispin = 1, nspins
9598 CALL xc_pw_laplace(v_laplace(ispin), pw_pool, xc_deriv_method_id)
9599 CALL pw_axpy(v_laplace(ispin), v_xc(ispin))
9600 CALL deallocate_pw(v_laplace(ispin), pw_pool)
9601 END DO
9602 DEALLOCATE (v_laplace)
9603 END IF
9604 DEALLOCATE (zero_f)
9605
9606 ELSE IF (.NOT. gradient_f) THEN
9607 IF (ASSOCIATED(e_rrr)) THEN
9608!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE) SHARED(bo,v_xc,e_rrr,rho1) COLLAPSE(3)
9609 DO k = bo(1, 3), bo(2, 3)
9610 DO j = bo(1, 2), bo(2, 2)
9611 DO i = bo(1, 1), bo(2, 1)
9612 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
9613 e_rrr(i, j, k)*rho1(i, j, k)**2
9614 END DO
9615 END DO
9616 END DO
9617 END IF
9618 ELSE
9619!$OMP PARALLEL DO PRIVATE(k,j,i,g1,g11,uu,aa,bb) DEFAULT(NONE) &
9620!$OMP SHARED(bo,v_xc,v_drho_r,rho1,dr1dr,dr1dr1,drho,drho1, &
9621!$OMP e_rrr,e_rrg,e_rgg,e_ggg,e_rg,e_gg) COLLAPSE(3)
9622 DO k = bo(1, 3), bo(2, 3)
9623 DO j = bo(1, 2), bo(2, 2)
9624 DO i = bo(1, 1), bo(2, 1)
9625 g1 = 2.0_dp*dr1dr(i, j, k)
9626 g11 = 2.0_dp*dr1dr1(i, j, k)
9627
9628 uu = e_rrr(i, j, k)*rho1(i, j, k)**2 &
9629 + 2.0_dp*e_rrg(i, j, k)*rho1(i, j, k)*g1 &
9630 + e_rgg(i, j, k)*g1**2 &
9631 + e_rg(i, j, k)*g11
9632 aa = e_rrg(i, j, k)*rho1(i, j, k)**2 &
9633 + 2.0_dp*e_rgg(i, j, k)*rho1(i, j, k)*g1 &
9634 + e_ggg(i, j, k)*g1**2 &
9635 + e_gg(i, j, k)*g11
9636 bb = e_rg(i, j, k)*rho1(i, j, k) + e_gg(i, j, k)*g1
9637
9638 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + uu
9639 ! xc_pw_divergence ADDS div(field), and g_xc = u - div(v),
9640 ! so the field handed over is -v
9641 v_drho_r(1, 1)%array(i, j, k) = -(2.0_dp*drho(1)%array(i, j, k)*aa &
9642 + 4.0_dp*drho1(1)%array(i, j, k)*bb)
9643 v_drho_r(2, 1)%array(i, j, k) = -(2.0_dp*drho(2)%array(i, j, k)*aa &
9644 + 4.0_dp*drho1(2)%array(i, j, k)*bb)
9645 v_drho_r(3, 1)%array(i, j, k) = -(2.0_dp*drho(3)%array(i, j, k)*aa &
9646 + 4.0_dp*drho1(3)%array(i, j, k)*bb)
9647 END DO
9648 END DO
9649 END DO
9650
9651 IF (my_gapw) THEN
9652 DO idir = 1, 3
9653 vxg(idir, :, :, 1) = -v_drho_r(idir, 1)%array(:, :, 1)
9654 END DO
9655 ELSE
9656 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 1), tmp_g, vxc_g, v_xc(1))
9657 END IF
9658 END IF
9659
9660 END IF
9661
9662 IF (gradient_f) THEN
9663
9664 DO ispin = 1, nspins
9665 CALL deallocate_pw(v_drho(ispin), pw_pool)
9666 DO idir = 1, 3
9667 CALL deallocate_pw(v_drho_r(idir, ispin), pw_pool)
9668 END DO
9669 END DO
9670 DEALLOCATE (v_drho, v_drho_r)
9671
9672 END IF
9673
9674 IF (ASSOCIATED(tmp_g%pw_grid) .AND. ASSOCIATED(pw_pool)) THEN
9675 CALL pw_pool%give_back_pw(tmp_g)
9676 END IF
9677
9678 IF (ASSOCIATED(vxc_g%pw_grid) .AND. ASSOCIATED(pw_pool)) THEN
9679 CALL pw_pool%give_back_pw(vxc_g)
9680 END IF
9681
9682 CALL timestop(handle)
9683 END SUBROUTINE xc_calc_3rd_deriv_analytical
9684
9685! **************************************************************************************************
9686!> \brief allocates grids using pw_pool (if associated) or with bounds
9687!> \param pw ...
9688!> \param pw_pool ...
9689!> \param bo ...
9690! **************************************************************************************************
9691 SUBROUTINE allocate_pw(pw, pw_pool, bo)
9692 TYPE(pw_r3d_rs_type), INTENT(OUT) :: pw
9693 TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool
9694 INTEGER, DIMENSION(2, 3), INTENT(IN) :: bo
9695
9696 IF (ASSOCIATED(pw_pool)) THEN
9697 CALL pw_pool%create_pw(pw)
9698 CALL pw_zero(pw)
9699 ELSE
9700 ALLOCATE (pw%array(bo(1, 1):bo(2, 1), bo(1, 2):bo(2, 2), bo(1, 3):bo(2, 3)))
9701 pw%array = 0.0_dp
9702 END IF
9703
9704 END SUBROUTINE allocate_pw
9705
9706! **************************************************************************************************
9707!> \brief deallocates grid allocated with allocate_pw
9708!> \param pw ...
9709!> \param pw_pool ...
9710! **************************************************************************************************
9711 SUBROUTINE deallocate_pw(pw, pw_pool)
9712 TYPE(pw_r3d_rs_type), INTENT(INOUT) :: pw
9713 TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool
9714
9715 IF (ASSOCIATED(pw_pool)) THEN
9716 CALL pw_pool%give_back_pw(pw)
9717 ELSE
9718 CALL pw%release()
9719 END IF
9720
9721 END SUBROUTINE deallocate_pw
9722
9723! **************************************************************************************************
9724!> \brief updates virial from first derivative w.r.t. norm_drho
9725!> \param virial_pw ...
9726!> \param drho ...
9727!> \param drho1 ...
9728!> \param deriv_data ...
9729!> \param virial_xc ...
9730! **************************************************************************************************
9731 SUBROUTINE virial_drho_drho1(virial_pw, drho, drho1, deriv_data, virial_xc)
9732 TYPE(pw_r3d_rs_type), INTENT(IN) :: virial_pw
9733 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drho, drho1
9734 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: deriv_data
9735 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT) :: virial_xc
9736
9737 INTEGER :: idir, jdir
9738 REAL(kind=dp) :: tmp
9739
9740 DO idir = 1, 3
9741!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drho,idir,virial_pw,deriv_data)
9742 virial_pw%array(:, :, :) = drho(idir)%array(:, :, :)*deriv_data(:, :, :)
9743!$OMP END PARALLEL WORKSHARE
9744 DO jdir = 1, 3
9745 tmp = virial_pw%pw_grid%dvol*accurate_dot_product(virial_pw%array(:, :, :), &
9746 drho1(jdir)%array(:, :, :))
9747 virial_xc(jdir, idir) = virial_xc(jdir, idir) + tmp
9748 virial_xc(idir, jdir) = virial_xc(idir, jdir) + tmp
9749 END DO
9750 END DO
9751
9752 END SUBROUTINE virial_drho_drho1
9753
9754! **************************************************************************************************
9755!> \brief Adds virial contribution from second order potential parts
9756!> \param virial_pw ...
9757!> \param drho ...
9758!> \param v_drho ...
9759!> \param virial_xc ...
9760! **************************************************************************************************
9761 SUBROUTINE virial_drho_drho(virial_pw, drho, v_drho, virial_xc)
9762 TYPE(pw_r3d_rs_type), INTENT(IN) :: virial_pw
9763 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drho
9764 TYPE(pw_r3d_rs_type), INTENT(IN) :: v_drho
9765 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT) :: virial_xc
9766
9767 INTEGER :: idir, jdir
9768 REAL(kind=dp) :: tmp
9769
9770 DO idir = 1, 3
9771!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drho,idir,v_drho,virial_pw)
9772 virial_pw%array(:, :, :) = drho(idir)%array(:, :, :)*v_drho%array(:, :, :)
9773!$OMP END PARALLEL WORKSHARE
9774 DO jdir = 1, idir
9775 tmp = -virial_pw%pw_grid%dvol*accurate_dot_product(virial_pw%array(:, :, :), &
9776 drho(jdir)%array(:, :, :))
9777 virial_xc(jdir, idir) = virial_xc(jdir, idir) + tmp
9778 virial_xc(idir, jdir) = virial_xc(jdir, idir)
9779 END DO
9780 END DO
9781
9782 END SUBROUTINE virial_drho_drho
9783
9784! **************************************************************************************************
9785!> \brief ...
9786!> \param rho_r ...
9787!> \param pw_pool ...
9788!> \param virial_xc ...
9789!> \param deriv_data ...
9790! **************************************************************************************************
9791 SUBROUTINE virial_laplace(rho_r, pw_pool, virial_xc, deriv_data)
9792 TYPE(pw_r3d_rs_type), TARGET :: rho_r
9793 TYPE(pw_pool_type), POINTER, INTENT(IN) :: pw_pool
9794 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT) :: virial_xc
9795 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: deriv_data
9796
9797 CHARACTER(len=*), PARAMETER :: routinen = 'virial_laplace'
9798
9799 INTEGER :: handle, idir, jdir
9800 TYPE(pw_r3d_rs_type), POINTER :: virial_pw
9801 TYPE(pw_c1d_gs_type), POINTER :: tmp_g, rho_g
9802 INTEGER, DIMENSION(3) :: my_deriv
9803
9804 CALL timeset(routinen, handle)
9805
9806 NULLIFY (virial_pw, tmp_g, rho_g)
9807 ALLOCATE (virial_pw, tmp_g, rho_g)
9808 CALL pw_pool%create_pw(virial_pw)
9809 CALL pw_pool%create_pw(tmp_g)
9810 CALL pw_pool%create_pw(rho_g)
9811 CALL pw_zero(virial_pw)
9812 CALL pw_transfer(rho_r, rho_g)
9813 DO idir = 1, 3
9814 DO jdir = idir, 3
9815 CALL pw_copy(rho_g, tmp_g)
9816
9817 my_deriv = 0
9818 my_deriv(idir) = 1
9819 my_deriv(jdir) = my_deriv(jdir) + 1
9820
9821 CALL pw_derive(tmp_g, my_deriv)
9822 CALL pw_transfer(tmp_g, virial_pw)
9823 virial_xc(idir, jdir) = virial_xc(idir, jdir) - 2.0_dp*virial_pw%pw_grid%dvol* &
9824 accurate_dot_product(virial_pw%array(:, :, :), &
9825 deriv_data(:, :, :))
9826 virial_xc(jdir, idir) = virial_xc(idir, jdir)
9827 END DO
9828 END DO
9829 CALL pw_pool%give_back_pw(virial_pw)
9830 CALL pw_pool%give_back_pw(tmp_g)
9831 CALL pw_pool%give_back_pw(rho_g)
9832 DEALLOCATE (virial_pw, tmp_g, rho_g)
9833
9834 CALL timestop(handle)
9835
9836 END SUBROUTINE virial_laplace
9837
9838! **************************************************************************************************
9839!> \brief Prepare objects for the calculation of the 2nd derivatives of the density functional.
9840!> The calculation must then be performed with xc_calc_2nd_deriv.
9841!> \param deriv_set object containing the XC derivatives (out)
9842!> \param rho_set object that will contain the density at which the
9843!> derivatives were calculated
9844!> \param rho_r the place where you evaluate the derivative
9845!> \param pw_pool the pool for the grids
9846!> \param weights integration weights
9847!> \param xc_section which functional should be used and how to calculate it
9848!> \param tau_r kinetic energy density in real space
9849! **************************************************************************************************
9850 SUBROUTINE xc_prep_2nd_deriv(deriv_set, &
9851 rho_set, rho_r, pw_pool, weights, xc_section, tau_r)
9852
9853 TYPE(xc_derivative_set_type) :: deriv_set
9854 TYPE(xc_rho_set_type) :: rho_set
9855 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
9856 TYPE(pw_pool_type), POINTER :: pw_pool
9857 TYPE(pw_r3d_rs_type), POINTER :: weights
9858 TYPE(section_vals_type), POINTER :: xc_section
9859 TYPE(pw_r3d_rs_type), DIMENSION(:), &
9860 OPTIONAL, POINTER :: tau_r
9861
9862 CHARACTER(len=*), PARAMETER :: routinen = 'xc_prep_2nd_deriv'
9863
9864 INTEGER :: handle, nspins
9865 LOGICAL :: lsd
9866 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
9867 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: tau
9868
9869 CALL timeset(routinen, handle)
9870
9871 cpassert(ASSOCIATED(xc_section))
9872 cpassert(ASSOCIATED(pw_pool))
9873
9874 IF (xc_section_uses_gauxc(xc_section)) THEN
9875 CALL cp_abort(__location__, gauxc_high_deriv_message)
9876 END IF
9877
9878 nspins = SIZE(rho_r)
9879 lsd = (nspins /= 1)
9880
9881 NULLIFY (rho_g, tau)
9882 IF (PRESENT(tau_r)) tau => tau_r
9883
9884 IF (section_get_lval(xc_section, "2ND_DERIV_ANALYTICAL")) THEN
9885 CALL xc_rho_set_and_dset_create(rho_set, deriv_set, 2, &
9886 rho_r, rho_g, tau, xc_section, pw_pool, weights, &
9887 calc_potential=.true.)
9888 ELSE
9889 CALL xc_rho_set_and_dset_create(rho_set, deriv_set, 1, &
9890 rho_r, rho_g, tau, xc_section, pw_pool, weights, &
9891 calc_potential=.true.)
9892 END IF
9893
9894 CALL timestop(handle)
9895
9896 END SUBROUTINE xc_prep_2nd_deriv
9897
9898! **************************************************************************************************
9899!> \brief Prepare deriv_set for the calculation of the 3rd derivatives of the density functional.
9900!> The calculation must then be performed with xc_calc_3rd_deriv.
9901!> \param deriv_set object containing the XC derivatives (out)
9902!> \param rho_set object that will contain the density at which the
9903!> derivatives were calculated
9904!> \param rho_r the place where you evaluate the derivative
9905!> \param pw_pool the pool for the grids
9906!> \param weights integration weights
9907!> \param xc_section which functional should be used and how to calculate it
9908!> \param tau_r kinetic energy density in real space
9909!> \param do_sf Flag to activate the noncollinear kernel for spin flip calculations
9910!> \par History
9911!> * 07.2024 Created [LHS]
9912! **************************************************************************************************
9913 SUBROUTINE xc_prep_3rd_deriv(deriv_set, rho_set, rho_r, pw_pool, weights, &
9914 xc_section, tau_r, do_sf)
9915
9916 TYPE(xc_derivative_set_type) :: deriv_set
9917 TYPE(xc_rho_set_type) :: rho_set
9918 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
9919 TYPE(pw_pool_type), POINTER :: pw_pool
9920 TYPE(pw_r3d_rs_type), POINTER :: weights
9921 TYPE(section_vals_type), POINTER :: xc_section
9922 TYPE(pw_r3d_rs_type), DIMENSION(:), &
9923 OPTIONAL, POINTER :: tau_r
9924 LOGICAL, OPTIONAL :: do_sf
9925
9926 CHARACTER(len=*), PARAMETER :: routinen = 'xc_prep_3rd_deriv'
9927
9928 INTEGER :: handle, nspins
9929 LOGICAL :: lsd, my_do_sf
9930 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
9931 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: tau
9932
9933 CALL timeset(routinen, handle)
9934
9935 cpassert(ASSOCIATED(xc_section))
9936 cpassert(ASSOCIATED(pw_pool))
9937
9938 IF (xc_section_uses_gauxc(xc_section)) THEN
9939 CALL cp_abort(__location__, gauxc_high_deriv_message)
9940 END IF
9941
9942 nspins = SIZE(rho_r)
9943 lsd = (nspins /= 1)
9944
9945 NULLIFY (rho_g, tau)
9946 IF (PRESENT(tau_r)) tau => tau_r
9947
9948 my_do_sf = .false.
9949 IF (PRESENT(do_sf)) my_do_sf = do_sf
9950
9951 IF (do_sf) THEN
9952 CALL xc_rho_set_and_dset_create(rho_set, deriv_set, 2, &
9953 rho_r, rho_g, tau, xc_section, pw_pool, weights, &
9954 calc_potential=.true.)
9955 ELSE
9956 CALL xc_rho_set_and_dset_create(rho_set, deriv_set, 3, &
9957 rho_r, rho_g, tau, xc_section, pw_pool, weights, &
9958 calc_potential=.true.)
9959 END IF
9960
9961 CALL timestop(handle)
9962
9963 END SUBROUTINE xc_prep_3rd_deriv
9964
9965! **************************************************************************************************
9966!> \brief divides derivatives from deriv_set by norm_drho
9967!> \param deriv_set ...
9968!> \param rho_set ...
9969!> \param lsd ...
9970! **************************************************************************************************
9971 SUBROUTINE divide_by_norm_drho(deriv_set, rho_set, lsd)
9972
9973 TYPE(xc_derivative_set_type), INTENT(INOUT) :: deriv_set
9974 TYPE(xc_rho_set_type), INTENT(IN) :: rho_set
9975 LOGICAL, INTENT(IN) :: lsd
9976
9977 INTEGER, DIMENSION(:), POINTER :: split_desc
9978 INTEGER :: idesc
9979 INTEGER, DIMENSION(2, 3) :: bo
9980 REAL(kind=dp) :: drho_cutoff
9981 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: norm_drho, norm_drhoa, norm_drhob
9982 TYPE(cp_3d_r_cp_type), DIMENSION(3) :: drho, drhoa, drhob
9983 TYPE(cp_sll_xc_deriv_type), POINTER :: pos
9984 TYPE(xc_derivative_type), POINTER :: deriv_att
9985
9986! check for unknown derivatives and divide by norm_drho where necessary
9987
9988 bo = rho_set%local_bounds
9989 CALL xc_rho_set_get(rho_set, drho_cutoff=drho_cutoff, norm_drho=norm_drho, &
9990 norm_drhoa=norm_drhoa, norm_drhob=norm_drhob, &
9991 drho=drho, drhoa=drhoa, drhob=drhob, can_return_null=.true.)
9992
9993 pos => deriv_set%derivs
9994 DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
9995 CALL xc_derivative_get(deriv_att, split_desc=split_desc)
9996 DO idesc = 1, SIZE(split_desc)
9997 SELECT CASE (split_desc(idesc))
9998 CASE (deriv_norm_drho)
9999 IF (ASSOCIATED(norm_drho)) THEN
10000!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,norm_drho,drho_cutoff)
10001 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10002 max(norm_drho(:, :, :), drho_cutoff)
10003!$OMP END PARALLEL WORKSHARE
10004 ELSE IF (ASSOCIATED(drho(1)%array)) THEN
10005!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,drho,drho_cutoff)
10006 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10007 max(sqrt(drho(1)%array(:, :, :)**2 + &
10008 drho(2)%array(:, :, :)**2 + &
10009 drho(3)%array(:, :, :)**2), drho_cutoff)
10010!$OMP END PARALLEL WORKSHARE
10011 ELSE IF (ASSOCIATED(drhoa(1)%array) .AND. ASSOCIATED(drhob(1)%array)) THEN
10012!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,drhoa,drhob,drho_cutoff)
10013 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10014 max(sqrt((drhoa(1)%array(:, :, :) + drhob(1)%array(:, :, :))**2 + &
10015 (drhoa(2)%array(:, :, :) + drhob(2)%array(:, :, :))**2 + &
10016 (drhoa(3)%array(:, :, :) + drhob(3)%array(:, :, :))**2), drho_cutoff)
10017!$OMP END PARALLEL WORKSHARE
10018 ELSE
10019 cpabort("Normalization of derivative requires any of norm_drho, drho or drhoa+drhob!")
10020 END IF
10021 CASE (deriv_norm_drhoa)
10022 IF (ASSOCIATED(norm_drhoa)) THEN
10023!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,norm_drhoa,drho_cutoff)
10024 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10025 max(norm_drhoa(:, :, :), drho_cutoff)
10026!$OMP END PARALLEL WORKSHARE
10027 ELSE IF (ASSOCIATED(drhoa(1)%array)) THEN
10028!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,drhoa,drho_cutoff)
10029 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10030 max(sqrt(drhoa(1)%array(:, :, :)**2 + &
10031 drhoa(2)%array(:, :, :)**2 + &
10032 drhoa(3)%array(:, :, :)**2), drho_cutoff)
10033!$OMP END PARALLEL WORKSHARE
10034 ELSE
10035 cpabort("Normalization of derivative requires any of norm_drhoa or drhoa!")
10036 END IF
10037 CASE (deriv_norm_drhob)
10038 IF (ASSOCIATED(norm_drhob)) THEN
10039!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,norm_drhob,drho_cutoff)
10040 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10041 max(norm_drhob(:, :, :), drho_cutoff)
10042!$OMP END PARALLEL WORKSHARE
10043 ELSE IF (ASSOCIATED(drhob(1)%array)) THEN
10044!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,drhob,drho_cutoff)
10045 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10046 max(sqrt(drhob(1)%array(:, :, :)**2 + &
10047 drhob(2)%array(:, :, :)**2 + &
10048 drhob(3)%array(:, :, :)**2), drho_cutoff)
10049!$OMP END PARALLEL WORKSHARE
10050 ELSE
10051 cpabort("Normalization of derivative requires any of norm_drhob or drhob!")
10052 END IF
10053 CASE (deriv_rho, deriv_tau, deriv_laplace_rho, deriv_gamma)
10054 ! gamma derivatives need no normalization: unlike norm_drho they
10055 ! are already the variables LibXC differentiated with respect to
10056 IF (lsd) THEN
10057 cpabort(trim(id_to_desc(split_desc(idesc)))//" not handled in lsd!'")
10058 END IF
10059 CASE (deriv_rhoa, deriv_rhob, deriv_tau_a, deriv_tau_b, deriv_laplace_rhoa, deriv_laplace_rhob, &
10060 deriv_gamma_aa, deriv_gamma_ab, deriv_gamma_bb)
10061 CASE default
10062 cpabort("Unknown derivative id")
10063 END SELECT
10064 END DO
10065 END DO
10066
10067 END SUBROUTINE divide_by_norm_drho
10068
10069! **************************************************************************************************
10070!> \brief allocates and calculates drho from given spin densities drhoa, drhob
10071!> \param drho ...
10072!> \param drhoa ...
10073!> \param drhob ...
10074! **************************************************************************************************
10075 SUBROUTINE calc_drho_from_ab(drho, drhoa, drhob)
10076 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(OUT) :: drho
10077 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drhoa, drhob
10078
10079 CHARACTER(len=*), PARAMETER :: routinen = 'calc_drho_from_ab'
10080
10081 INTEGER :: handle, idir
10082
10083 CALL timeset(routinen, handle)
10084
10085 DO idir = 1, 3
10086 NULLIFY (drho(idir)%array)
10087 ALLOCATE (drho(idir)%array(lbound(drhoa(1)%array, 1):ubound(drhoa(1)%array, 1), &
10088 lbound(drhoa(1)%array, 2):ubound(drhoa(1)%array, 2), &
10089 lbound(drhoa(1)%array, 3):ubound(drhoa(1)%array, 3)))
10090!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drho,drhoa,drhob,idir)
10091 drho(idir)%array(:, :, :) = drhoa(idir)%array(:, :, :) + drhob(idir)%array(:, :, :)
10092!$OMP END PARALLEL WORKSHARE
10093 END DO
10094
10095 CALL timestop(handle)
10096
10097 END SUBROUTINE calc_drho_from_ab
10098
10099! **************************************************************************************************
10100!> \brief allocates and calculates drho from given spin densities drhoa, drhob
10101!> \param drho ...
10102!> \param drhoa ...
10103!> \param drhob ...
10104! **************************************************************************************************
10105 SUBROUTINE calc_drho_from_a(drho, drhoa)
10106 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(OUT) :: drho
10107 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drhoa
10108
10109 CHARACTER(len=*), PARAMETER :: routinen = 'calc_drho_from_a'
10110
10111 INTEGER :: handle, idir
10112
10113 CALL timeset(routinen, handle)
10114
10115 DO idir = 1, 3
10116 NULLIFY (drho(idir)%array)
10117 ALLOCATE (drho(idir)%array(lbound(drhoa(1)%array, 1):ubound(drhoa(1)%array, 1), &
10118 lbound(drhoa(1)%array, 2):ubound(drhoa(1)%array, 2), &
10119 lbound(drhoa(1)%array, 3):ubound(drhoa(1)%array, 3)))
10120!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drho,drhoa,idir)
10121 drho(idir)%array(:, :, :) = drhoa(idir)%array(:, :, :)
10122!$OMP END PARALLEL WORKSHARE
10123 END DO
10124
10125 CALL timestop(handle)
10126
10127 END SUBROUTINE calc_drho_from_a
10128
10129! **************************************************************************************************
10130!> \brief allocates and calculates dot products of two density gradients
10131!> \param dr1dr ...
10132!> \param drho ...
10133!> \param drho1 ...
10134! **************************************************************************************************
10135 SUBROUTINE prepare_dr1dr(dr1dr, drho, drho1)
10136 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
10137 INTENT(OUT) :: dr1dr
10138 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drho, drho1
10139
10140 CHARACTER(len=*), PARAMETER :: routinen = 'prepare_dr1dr'
10141
10142 INTEGER :: handle, idir
10143
10144 CALL timeset(routinen, handle)
10145
10146 ALLOCATE (dr1dr(lbound(drho(1)%array, 1):ubound(drho(1)%array, 1), &
10147 lbound(drho(1)%array, 2):ubound(drho(1)%array, 2), &
10148 lbound(drho(1)%array, 3):ubound(drho(1)%array, 3)))
10149
10150!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dr1dr,drho,drho1)
10151 dr1dr(:, :, :) = drho(1)%array(:, :, :)*drho1(1)%array(:, :, :)
10152!$OMP END PARALLEL WORKSHARE
10153 DO idir = 2, 3
10154!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dr1dr,drho,drho1,idir)
10155 dr1dr(:, :, :) = dr1dr(:, :, :) + drho(idir)%array(:, :, :)*drho1(idir)%array(:, :, :)
10156!$OMP END PARALLEL WORKSHARE
10157 END DO
10158
10159 CALL timestop(handle)
10160
10161 END SUBROUTINE prepare_dr1dr
10162
10163! **************************************************************************************************
10164!> \brief allocates and calculates dot product of two densities for triplets
10165!> \param dr1dr ...
10166!> \param drhoa ...
10167!> \param drhob ...
10168!> \param drho1a ...
10169!> \param drho1b ...
10170!> \param fac ...
10171! **************************************************************************************************
10172 SUBROUTINE prepare_dr1dr_ab(dr1dr, drhoa, drhob, drho1a, drho1b, fac)
10173 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
10174 INTENT(OUT) :: dr1dr
10175 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drhoa, drhob, drho1a, drho1b
10176 REAL(kind=dp), INTENT(IN) :: fac
10177
10178 CHARACTER(len=*), PARAMETER :: routinen = 'prepare_dr1dr_ab'
10179
10180 INTEGER :: handle, idir
10181
10182 CALL timeset(routinen, handle)
10183
10184 ALLOCATE (dr1dr(lbound(drhoa(1)%array, 1):ubound(drhoa(1)%array, 1), &
10185 lbound(drhoa(1)%array, 2):ubound(drhoa(1)%array, 2), &
10186 lbound(drhoa(1)%array, 3):ubound(drhoa(1)%array, 3)))
10187
10188!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(fac,dr1dr,drho1a,drho1b,drhoa,drhob)
10189 dr1dr(:, :, :) = drhoa(1)%array(:, :, :)*(drho1a(1)%array(:, :, :) + &
10190 fac*drho1b(1)%array(:, :, :)) + &
10191 drhob(1)%array(:, :, :)*(fac*drho1a(1)%array(:, :, :) + &
10192 drho1b(1)%array(:, :, :))
10193!$OMP END PARALLEL WORKSHARE
10194 DO idir = 2, 3
10195!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(fac,dr1dr,drho1a,drho1b,drhoa,drhob,idir)
10196 dr1dr(:, :, :) = dr1dr(:, :, :) + &
10197 drhoa(idir)%array(:, :, :)*(drho1a(idir)%array(:, :, :) + &
10198 fac*drho1b(idir)%array(:, :, :)) + &
10199 drhob(idir)%array(:, :, :)*(fac*drho1a(idir)%array(:, :, :) + &
10200 drho1b(idir)%array(:, :, :))
10201!$OMP END PARALLEL WORKSHARE
10202 END DO
10203
10204 CALL timestop(handle)
10205
10206 END SUBROUTINE prepare_dr1dr_ab
10207
10208! **************************************************************************************************
10209!> \brief checks for gradients
10210!> \param deriv_set ...
10211!> \param lsd ...
10212!> \param gradient_f ...
10213!> \param tau_f ...
10214!> \param laplace_f ...
10215! **************************************************************************************************
10216 SUBROUTINE check_for_derivatives(deriv_set, lsd, rho_f, gradient_f, tau_f, laplace_f)
10217 TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
10218 LOGICAL, INTENT(IN) :: lsd
10219 LOGICAL, INTENT(OUT) :: rho_f, gradient_f, tau_f, laplace_f
10220
10221 CHARACTER(len=*), PARAMETER :: routinen = 'check_for_derivatives'
10222
10223 INTEGER :: handle, iorder, order
10224 INTEGER, DIMENSION(:), POINTER :: split_desc
10225 TYPE(cp_sll_xc_deriv_type), POINTER :: pos
10226 TYPE(xc_derivative_type), POINTER :: deriv_att
10227
10228 CALL timeset(routinen, handle)
10229
10230 rho_f = .false.
10231 gradient_f = .false.
10232 tau_f = .false.
10233 laplace_f = .false.
10234 ! check for unknown derivatives
10235 pos => deriv_set%derivs
10236 DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
10237 CALL xc_derivative_get(deriv_att, order=order, &
10238 split_desc=split_desc)
10239 IF (lsd) THEN
10240 DO iorder = 1, size(split_desc)
10241 SELECT CASE (split_desc(iorder))
10242 CASE (deriv_rhoa, deriv_rhob)
10243 rho_f = .true.
10244 CASE (deriv_norm_drho, deriv_norm_drhoa, deriv_norm_drhob, &
10245 deriv_gamma_aa, deriv_gamma_ab, deriv_gamma_bb)
10246 gradient_f = .true.
10247 CASE (deriv_tau_a, deriv_tau_b)
10248 tau_f = .true.
10249 CASE (deriv_laplace_rhoa, deriv_laplace_rhob)
10250 laplace_f = .true.
10251 CASE (deriv_rho, deriv_tau, deriv_laplace_rho)
10252 cpabort("Derivative not handled in lsd!")
10253 CASE default
10254 cpabort("Unknown derivative id")
10255 END SELECT
10256 END DO
10257 ELSE
10258 DO iorder = 1, size(split_desc)
10259 SELECT CASE (split_desc(iorder))
10260 CASE (deriv_rho)
10261 rho_f = .true.
10262 CASE (deriv_tau)
10263 tau_f = .true.
10264 CASE (deriv_norm_drho, deriv_gamma)
10265 gradient_f = .true.
10266 CASE (deriv_laplace_rho)
10267 laplace_f = .true.
10268 CASE default
10269 cpabort("Unknown derivative id")
10270 END SELECT
10271 END DO
10272 END IF
10273 END DO
10274
10275 CALL timestop(handle)
10276
10277 END SUBROUTINE check_for_derivatives
10278
10279END MODULE xc
10280
static GRID_HOST_DEVICE double fac(const int i)
Factorial function, e.g. fac(5) = 5! = 120.
Definition grid_common.h:56
various utilities that regard array of different kinds: output, allocation,... maybe it is not a good...
logical function, public cp_sll_xc_deriv_next(iterator, el_att)
returns true if the actual element is valid (i.e. iterator ont at end) moves the iterator to the next...
various routines to log and control the output. The idea is that decisions about where to log should ...
recursive integer function, public cp_logger_get_default_unit_nr(logger, local, skip_not_ionode)
asks the default unit number of the given logger. try to use cp_logger_get_unit_nr
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
objects that represent the structure of input sections and the data contained in an input section
real(kind=dp) function, public section_get_rval(section_vals, keyword_name)
...
integer function, public section_get_ival(section_vals, keyword_name)
...
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
logical function, public section_get_lval(section_vals, keyword_name)
...
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_path_length
Definition kinds.F:58
integer, parameter, public pw_mode_distributed
subroutine, public pw_derive(pw, n)
Calculate the derivative of a plane wave vector.
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Module with functions to handle derivative descriptors. derivative description are strings have the f...
integer, parameter, public deriv_norm_drho
integer, parameter, public deriv_laplace_rhob
integer, parameter, public deriv_gamma
integer, parameter, public deriv_norm_drhoa
integer, parameter, public deriv_rhob
integer, parameter, public deriv_gamma_aa
integer, parameter, public deriv_rhoa
integer, parameter, public deriv_tau
integer, parameter, public deriv_tau_b
integer, parameter, public deriv_tau_a
integer, parameter, public deriv_laplace_rhoa
integer, parameter, public deriv_rho
integer, parameter, public deriv_gamma_bb
integer, parameter, public deriv_norm_drhob
character(len=max_label_length) function, public id_to_desc(id)
...
integer, parameter, public deriv_gamma_ab
integer, parameter, public deriv_laplace_rho
represent a group ofunctional derivatives
subroutine, public xc_dset_zero_all(deriv_set)
...
subroutine, public xc_dset_recover_pw(deriv_set, description, pw, pw_grid, pw_pool)
Recovers a derivative on a pw_r3d_rs_type, the caller is responsible to release the grid later If the...
type(xc_derivative_type) function, pointer, public xc_dset_get_derivative(derivative_set, description, allocate_deriv)
returns the requested xc_derivative
subroutine, public xc_dset_release(derivative_set)
releases a derivative set
subroutine, public xc_dset_create(derivative_set, pw_pool, local_bounds)
creates a derivative set object
Provides types for the management of the xc-functionals and their derivatives.
subroutine, public xc_derivative_get(deriv, split_desc, order, deriv_data, accept_null_data)
returns various information on the given derivative
type(xc_rho_cflags_type) function, public xc_functionals_get_needs(functionals, lsd, calc_potential)
...
subroutine, public xc_functionals_eval(functionals, lsd, rho_set, deriv_set, deriv_order)
...
logical function, public xc_section_uses_gauxc(xc_section)
...
contains the structure
contains the structure
subroutine, public xc_rho_set_create(rho_set, local_bounds, rho_cutoff, drho_cutoff, tau_cutoff)
allocates and does (minimal) initialization of a rho_set
subroutine, public xc_rho_set_release(rho_set, pw_pool)
releases the given rho_set
subroutine, public xc_rho_set_recover_pw(rho_set, pw_grid, pw_pool, owns_data, rho, drho, norm_drho, rhoa, rhob, norm_drhoa, norm_drhob, rho_1_3, rhoa_1_3, rhob_1_3, laplace_rho, laplace_rhoa, laplace_rhob, drhoa, drhob, tau, tau_a, tau_b)
Shifts association of the requested array to a pw grid Requires that the corresponding component of r...
subroutine, public xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, xc_deriv_method_id, xc_rho_smooth_id, pw_pool, spinflip)
updates the given rho set with the density given by rho_r (and rho_g). The rho set will contain the c...
subroutine, public xc_rho_set_get(rho_set, can_return_null, rho, drho, norm_drho, rhoa, rhob, norm_drhoa, norm_drhob, rho_1_3, rhoa_1_3, rhob_1_3, laplace_rho, laplace_rhoa, laplace_rhob, drhoa, drhob, rho_cutoff, drho_cutoff, tau_cutoff, tau, tau_a, tau_b, local_bounds)
returns the various attributes of rho_set
contains utility functions for the xc package
Definition xc_util.F:14
subroutine, public xc_pw_divergence(xc_deriv_method_id, pw_to_deriv, tmp_g, vxc_g, vxc_r)
Calculates the divergence of pw_to_deriv.
Definition xc_util.F:253
subroutine, public xc_pw_smooth(pw_in, pw_out, xc_smooth_id)
...
Definition xc_util.F:73
elemental logical function, public xc_requires_tmp_g(xc_deriv_id)
...
Definition xc_util.F:58
Exchange and Correlation functional calculations.
Definition xc.F:17
subroutine, public xc_prep_2nd_deriv(deriv_set, rho_set, rho_r, pw_pool, weights, xc_section, tau_r)
Prepare objects for the calculation of the 2nd derivatives of the density functional....
Definition xc.F:9860
subroutine, public divide_by_norm_drho(deriv_set, rho_set, lsd)
divides derivatives from deriv_set by norm_drho
Definition xc.F:9980
subroutine, public xc_calc_2nd_deriv_analytical(v_xc, v_xc_tau, deriv_set, rho_set, rho1_set, pw_pool, xc_section, gapw, vxg, tddfpt_fac, compute_virial, virial_xc, spinflip)
Calculates the second derivative of E_xc at rho in the direction rho1 (if you see the second derivati...
Definition xc.F:2057
subroutine, public xc_calc_2nd_deriv_numerical(v_xc, v_tau, rho_set, rho1_r, rho1_g, tau1_r, pw_pool, weights, xc_section, do_triplet, calc_virial, virial_xc, deriv_set)
calculates 2nd derivative numerically
Definition xc.F:1063
real(kind=dp) function, public xc_exc_calc(rho_r, rho_g, tau, xc_section, weights, pw_pool)
calculates just the exchange and correlation energy (no vxc)
Definition xc.F:792
logical function, public xc_uses_norm_drho(xc_fun_section, lsd)
...
Definition xc.F:116
logical function, public xc_uses_kinetic_energy_density(xc_fun_section, lsd)
...
Definition xc.F:96
subroutine, public xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section, weights, pw_pool, compute_virial, virial_xc, exc_r)
Exchange and Correlation functional calculations.
Definition xc.F:475
subroutine, public xc_calc_2nd_deriv(v_xc, v_xc_tau, deriv_set, rho_set, rho1_r, rho1_g, tau1_r, pw_pool, weights, xc_section, gapw, vxg, do_excitations, do_sf, do_triplet, compute_virial, virial_xc)
Caller routine to calculate the second order potential in the direction of rho1_r.
Definition xc.F:929
subroutine, public xc_calc_3rd_deriv_analytical(v_xc, v_xc_tau, deriv_set, rho_set, rho1_set, pw_pool, xc_section, spinflip, gapw, vxg)
Calculates the third functional derivative of the exchange-correlation functional,...
Definition xc.F:4736
subroutine, public xc_exc_pw_create(rho_r, rho_g, tau, xc_section, weights, pw_pool, exc)
calculates just the exchange and correlation energy density
Definition xc.F:858
subroutine, public xc_prep_3rd_deriv(deriv_set, rho_set, rho_r, pw_pool, weights, xc_section, tau_r, do_sf)
Prepare deriv_set for the calculation of the 3rd derivatives of the density functional....
Definition xc.F:9923
subroutine, public calc_xc_density(pot, rho, rho_cutoff)
Definition xc.F:403
subroutine, public smooth_cutoff(pot, rho, rhoa, rhob, rho_cutoff, rho_smooth_cutoff_range, e_0, e_0_scale_factor)
smooths the cutoff on rho with a function smoothderiv_rho that is 0 for rho<rho_cutoff and 1 for rho>...
Definition xc.F:243
represent a pointer to a contiguous 3d array
represent a single linked list that stores pointers to the elements
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
A derivative set contains the different derivatives of a xc-functional in form of a linked list.
represent a derivative of a functional
contains a flag for each component of xc_rho_set, so that you can use it to tell which components you...
represent a density, with all the representation and data needed to perform a functional evaluation