(git:f824184)
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: &
64#if defined(__LIBXC)
65 USE xc_libxc, ONLY: libxc_set_backend
66#endif
74#include "../base/base_uses.f90"
75
76 IMPLICIT NONE
77 PRIVATE
82 PUBLIC :: calc_xc_density
83
84 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
85 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc'
86 CHARACTER(len=*), PARAMETER, PRIVATE :: gauxc_high_deriv_message = &
87 "Response and kernel properties with GauXC/Skala require higher XC derivatives, "// &
88 "which are not implemented. Use a native CP2K XC functional or disable the coupled XC kernel."
89
90CONTAINS
91
92! **************************************************************************************************
93!> \brief ...
94!> \param xc_fun_section ...
95!> \param lsd ...
96!> \return ...
97! **************************************************************************************************
98 FUNCTION xc_uses_kinetic_energy_density(xc_fun_section, lsd) RESULT(res)
99 TYPE(section_vals_type), POINTER, INTENT(IN) :: xc_fun_section
100 LOGICAL, INTENT(IN) :: lsd
101 LOGICAL :: res
102
103 TYPE(xc_rho_cflags_type) :: needs
104
105 needs = xc_functionals_get_needs(xc_fun_section, &
106 lsd=lsd, &
107 calc_potential=.false.)
108 res = (needs%tau_spin .OR. needs%tau)
109
111
112! **************************************************************************************************
113!> \brief ...
114!> \param xc_fun_section ...
115!> \param lsd ...
116!> \return ...
117! **************************************************************************************************
118 FUNCTION xc_uses_norm_drho(xc_fun_section, lsd) RESULT(res)
119 TYPE(section_vals_type), POINTER, INTENT(IN) :: xc_fun_section
120 LOGICAL, INTENT(IN) :: lsd
121 LOGICAL :: res
122
123 TYPE(xc_rho_cflags_type) :: needs
124
125 needs = xc_functionals_get_needs(xc_fun_section, &
126 lsd=lsd, &
127 calc_potential=.false.)
128 res = (needs%norm_drho .OR. needs%norm_drho_spin)
129
130 END FUNCTION xc_uses_norm_drho
131
132! **************************************************************************************************
133!> \brief creates a xc_rho_set and a derivative set containing the derivatives
134!> of the functionals with the given deriv_order.
135!> \param rho_set will contain the rho set
136!> \param deriv_set will contain the derivatives
137!> \param deriv_order the maximum order of the requested derivatives.
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#if defined(__LIBXC)
179 ! Apply the runtime LibXC backend selection from &XC/LIBXC_GPU_BACKEND.
180 CALL libxc_set_backend(section_get_ival(xc_section, "LIBXC_GPU_BACKEND"))
181#endif
182
183 cpassert(ASSOCIATED(pw_pool))
184
185 nspins = SIZE(rho_r)
186 lsd = (nspins /= 1)
187
188 xc_fun_sections => section_vals_get_subs_vals(xc_section, "XC_FUNCTIONAL")
189
190 ! Create deriv_set object
191 CALL xc_dset_create(deriv_set, pw_pool)
192
193 ! Create objects for density related stuff
194 CALL xc_rho_set_create(rho_set, &
195 rho_r(1)%pw_grid%bounds_local, &
196 rho_cutoff=section_get_rval(xc_section, "density_cutoff"), &
197 drho_cutoff=section_get_rval(xc_section, "gradient_cutoff"), &
198 tau_cutoff=section_get_rval(xc_section, "tau_cutoff"))
199
200 ! Calculate density stuff, for example the gradient of rho, according to the functional needs
201 CALL xc_rho_set_update(rho_set, rho_r, rho_g, tau, &
202 xc_functionals_get_needs(xc_fun_sections, lsd, calc_potential), &
203 section_get_ival(xc_section, "XC_GRID%XC_DERIV"), &
204 section_get_ival(xc_section, "XC_GRID%XC_SMOOTH_RHO"), &
205 pw_pool)
206
207 ! Calculate values of the functional on the grid
208 CALL xc_functionals_eval(xc_fun_sections, &
209 lsd=lsd, &
210 rho_set=rho_set, &
211 deriv_set=deriv_set, &
212 deriv_order=deriv_order)
213
214 ! apply weights
215 IF (ASSOCIATED(weights)) THEN
216 pos => deriv_set%derivs
217 DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
218 deriv_att%deriv_data(:, :, :) = weights%array(:, :, :)*deriv_att%deriv_data(:, :, :)
219 END DO
220 END IF
221
222 CALL divide_by_norm_drho(deriv_set, rho_set, lsd)
223
224 CALL timestop(handle)
225
226 END SUBROUTINE xc_rho_set_and_dset_create
227
228! **************************************************************************************************
229!> \brief smooths the cutoff on rho with a function smoothderiv_rho that is 0
230!> for rho<rho_cutoff and 1 for rho>rho_cutoff*rho_smooth_cutoff_range:
231!> E= integral e_0*smoothderiv_rho => dE/d...= de/d... * smooth,
232!> dE/drho = de/drho * smooth + e_0 * dsmooth/drho
233!> \param pot the potential to smooth
234!> \param rho , rhoa,rhob: the value of the density (used to apply the cutoff)
235!> \param rhoa ...
236!> \param rhob ...
237!> \param rho_cutoff the value at whch the cutoff function must go to 0
238!> \param rho_smooth_cutoff_range range of the smoothing
239!> \param e_0 value of e_0, if given it is assumed that pot is the derivative
240!> wrt. to rho, and needs the dsmooth*e_0 contribution
241!> \param e_0_scale_factor ...
242!> \author Fawzi Mohamed
243! **************************************************************************************************
244 SUBROUTINE smooth_cutoff(pot, rho, rhoa, rhob, rho_cutoff, &
245 rho_smooth_cutoff_range, e_0, e_0_scale_factor)
246 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN), &
247 POINTER :: pot, rho, rhoa, rhob
248 REAL(kind=dp), INTENT(in) :: rho_cutoff, rho_smooth_cutoff_range
249 REAL(kind=dp), DIMENSION(:, :, :), OPTIONAL, &
250 POINTER :: e_0
251 REAL(kind=dp), INTENT(in), OPTIONAL :: e_0_scale_factor
252
253 INTEGER :: i, j, k
254 INTEGER, DIMENSION(2, 3) :: bo
255 REAL(kind=dp) :: my_e_0_scale_factor, my_rho, my_rho_n, my_rho_n2, rho_smooth_cutoff, &
256 rho_smooth_cutoff_2, rho_smooth_cutoff_range_2
257
258 cpassert(ASSOCIATED(pot))
259 bo(1, :) = lbound(pot)
260 bo(2, :) = ubound(pot)
261 my_e_0_scale_factor = 1.0_dp
262 IF (PRESENT(e_0_scale_factor)) my_e_0_scale_factor = e_0_scale_factor
263 rho_smooth_cutoff = rho_cutoff*rho_smooth_cutoff_range
264 rho_smooth_cutoff_2 = (rho_cutoff + rho_smooth_cutoff)/2
265 rho_smooth_cutoff_range_2 = rho_smooth_cutoff_2 - rho_cutoff
266
267 IF (rho_smooth_cutoff_range > 0.0_dp) THEN
268 IF (PRESENT(e_0)) THEN
269 cpassert(ASSOCIATED(e_0))
270 IF (ASSOCIATED(rho)) THEN
271!$OMP PARALLEL DO DEFAULT(NONE) &
272!$OMP SHARED(bo,e_0,pot,rho,rho_cutoff,rho_smooth_cutoff,rho_smooth_cutoff_2, &
273!$OMP rho_smooth_cutoff_range_2,my_e_0_scale_factor) &
274!$OMP PRIVATE(k,j,i,my_rho,my_rho_n,my_rho_n2) &
275!$OMP COLLAPSE(3)
276 DO k = bo(1, 3), bo(2, 3)
277 DO j = bo(1, 2), bo(2, 2)
278 DO i = bo(1, 1), bo(2, 1)
279 my_rho = rho(i, j, k)
280 IF (my_rho < rho_smooth_cutoff) THEN
281 IF (my_rho < rho_cutoff) THEN
282 pot(i, j, k) = 0.0_dp
283 ELSE IF (my_rho < rho_smooth_cutoff_2) THEN
284 my_rho_n = (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
285 my_rho_n2 = my_rho_n*my_rho_n
286 pot(i, j, k) = pot(i, j, k)* &
287 my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2) + &
288 my_e_0_scale_factor*e_0(i, j, k)* &
289 my_rho_n2*(3.0_dp - 2.0_dp*my_rho_n) &
290 /rho_smooth_cutoff_range_2
291 ELSE
292 my_rho_n = 2.0_dp - (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
293 my_rho_n2 = my_rho_n*my_rho_n
294 pot(i, j, k) = pot(i, j, k)* &
295 (1.0_dp - my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2)) &
296 + my_e_0_scale_factor*e_0(i, j, k)* &
297 my_rho_n2*(3.0_dp - 2.0_dp*my_rho_n) &
298 /rho_smooth_cutoff_range_2
299 END IF
300 END IF
301 END DO
302 END DO
303 END DO
304!$OMP END PARALLEL DO
305 ELSE
306!$OMP PARALLEL DO DEFAULT(NONE) &
307!$OMP SHARED(bo,pot,e_0,rhoa,rhob,rho_cutoff,rho_smooth_cutoff,rho_smooth_cutoff_2, &
308!$OMP rho_smooth_cutoff_range_2,my_e_0_scale_factor) &
309!$OMP PRIVATE(k,j,i,my_rho,my_rho_n,my_rho_n2) &
310!$OMP COLLAPSE(3)
311 DO k = bo(1, 3), bo(2, 3)
312 DO j = bo(1, 2), bo(2, 2)
313 DO i = bo(1, 1), bo(2, 1)
314 my_rho = rhoa(i, j, k) + rhob(i, j, k)
315 IF (my_rho < rho_smooth_cutoff) THEN
316 IF (my_rho < rho_cutoff) THEN
317 pot(i, j, k) = 0.0_dp
318 ELSE IF (my_rho < rho_smooth_cutoff_2) THEN
319 my_rho_n = (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
320 my_rho_n2 = my_rho_n*my_rho_n
321 pot(i, j, k) = pot(i, j, k)* &
322 my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2) + &
323 my_e_0_scale_factor*e_0(i, j, k)* &
324 my_rho_n2*(3.0_dp - 2.0_dp*my_rho_n) &
325 /rho_smooth_cutoff_range_2
326 ELSE
327 my_rho_n = 2.0_dp - (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
328 my_rho_n2 = my_rho_n*my_rho_n
329 pot(i, j, k) = pot(i, j, k)* &
330 (1.0_dp - my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2)) &
331 + my_e_0_scale_factor*e_0(i, j, k)* &
332 my_rho_n2*(3.0_dp - 2.0_dp*my_rho_n) &
333 /rho_smooth_cutoff_range_2
334 END IF
335 END IF
336 END DO
337 END DO
338 END DO
339!$OMP END PARALLEL DO
340 END IF
341 ELSE
342 IF (ASSOCIATED(rho)) THEN
343!$OMP PARALLEL DO DEFAULT(NONE) &
344!$OMP SHARED(bo,pot,rho_cutoff,rho_smooth_cutoff,rho_smooth_cutoff_2, &
345!$OMP rho_smooth_cutoff_range_2,rho) &
346!$OMP PRIVATE(k,j,i,my_rho,my_rho_n,my_rho_n2) &
347!$OMP COLLAPSE(3)
348 DO k = bo(1, 3), bo(2, 3)
349 DO j = bo(1, 2), bo(2, 2)
350 DO i = bo(1, 1), bo(2, 1)
351 my_rho = rho(i, j, k)
352 IF (my_rho < rho_smooth_cutoff) THEN
353 IF (my_rho < rho_cutoff) THEN
354 pot(i, j, k) = 0.0_dp
355 ELSE IF (my_rho < rho_smooth_cutoff_2) THEN
356 my_rho_n = (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
357 my_rho_n2 = my_rho_n*my_rho_n
358 pot(i, j, k) = pot(i, j, k)* &
359 my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2)
360 ELSE
361 my_rho_n = 2.0_dp - (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
362 my_rho_n2 = my_rho_n*my_rho_n
363 pot(i, j, k) = pot(i, j, k)* &
364 (1.0_dp - my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2))
365 END IF
366 END IF
367 END DO
368 END DO
369 END DO
370!$OMP END PARALLEL DO
371 ELSE
372!$OMP PARALLEL DO DEFAULT(NONE) &
373!$OMP SHARED(bo,pot,rho_cutoff,rho_smooth_cutoff,rho_smooth_cutoff_2, &
374!$OMP rho_smooth_cutoff_range_2,rhoa,rhob) &
375!$OMP PRIVATE(k,j,i,my_rho,my_rho_n,my_rho_n2) &
376!$OMP COLLAPSE(3)
377 DO k = bo(1, 3), bo(2, 3)
378 DO j = bo(1, 2), bo(2, 2)
379 DO i = bo(1, 1), bo(2, 1)
380 my_rho = rhoa(i, j, k) + rhob(i, j, k)
381 IF (my_rho < rho_smooth_cutoff) THEN
382 IF (my_rho < rho_cutoff) THEN
383 pot(i, j, k) = 0.0_dp
384 ELSE IF (my_rho < rho_smooth_cutoff_2) THEN
385 my_rho_n = (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
386 my_rho_n2 = my_rho_n*my_rho_n
387 pot(i, j, k) = pot(i, j, k)* &
388 my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2)
389 ELSE
390 my_rho_n = 2.0_dp - (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2
391 my_rho_n2 = my_rho_n*my_rho_n
392 pot(i, j, k) = pot(i, j, k)* &
393 (1.0_dp - my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2))
394 END IF
395 END IF
396 END DO
397 END DO
398 END DO
399!$OMP END PARALLEL DO
400 END IF
401 END IF
402 END IF
403 END SUBROUTINE smooth_cutoff
404
405 SUBROUTINE calc_xc_density(pot, rho, rho_cutoff)
406 TYPE(pw_r3d_rs_type), INTENT(INOUT) :: pot
407 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(INOUT) :: rho
408 REAL(kind=dp), INTENT(in) :: rho_cutoff
409
410 INTEGER :: i, j, k, nspins
411 INTEGER, DIMENSION(2, 3) :: bo
412 REAL(kind=dp) :: eps1, eps2, my_rho, my_pot
413
414 bo(1, :) = lbound(pot%array)
415 bo(2, :) = ubound(pot%array)
416 nspins = SIZE(rho)
417
418 eps1 = rho_cutoff*1.e-4_dp
419 eps2 = rho_cutoff
420
421 DO k = bo(1, 3), bo(2, 3)
422 DO j = bo(1, 2), bo(2, 2)
423 DO i = bo(1, 1), bo(2, 1)
424 my_pot = pot%array(i, j, k)
425 IF (nspins == 2) THEN
426 my_rho = rho(1)%array(i, j, k) + rho(2)%array(i, j, k)
427 ELSE
428 my_rho = rho(1)%array(i, j, k)
429 END IF
430 IF (my_rho > eps1) THEN
431 pot%array(i, j, k) = my_pot/my_rho
432 ELSE IF (my_rho < eps2) THEN
433 pot%array(i, j, k) = 0.0_dp
434 ELSE
435 pot%array(i, j, k) = min(my_pot/my_rho, my_rho**(1._dp/3._dp))
436 END IF
437 END DO
438 END DO
439 END DO
440
441 END SUBROUTINE calc_xc_density
442
443! **************************************************************************************************
444!> \brief Exchange and Correlation functional calculations
445!> \param vxc_rho will contain the v_xc part that depend on rho
446!> (if one of the chosen xc functionals has it it is allocated and you
447!> are responsible for it)
448!> \param vxc_tau will contain the kinetic tau part of v_xc
449!> (if one of the chosen xc functionals has it it is allocated and you
450!> are responsible for it)
451!> \param exc the xc energy
452!> \param rho_r the value of the density in the real space
453!> \param rho_g value of the density in the g space (needs to be associated
454!> only for gradient corrections)
455!> \param tau value of the kinetic density tau on the grid (can be null,
456!> used only with meta functionals)
457!> \param xc_section which functional to calculate, and how to do it
458!> \param weights integration weights
459!> \param pw_pool the pool for the grids
460!> \param compute_virial ...
461!> \param virial_xc ...
462!> \param exc_r the value of the xc functional in the real space
463!> \par History
464!> JGH (13-Jun-2002): adaptation to new functionals
465!> Fawzi (11.2002): drho_g(1:3)->drho_g
466!> Fawzi (1.2003). lsd version
467!> Fawzi (11.2003): version using the new xc interface
468!> Fawzi (03.2004): fft free for smoothed density and derivs, gga lsd
469!> Fawzi (04.2004): metafunctionals
470!> mguidon (12.2008) : laplace functionals
471!> \author fawzi; based LDA version of JGH, based on earlier version of apsi
472!> \note
473!> Beware: some really dirty pointer handling!
474!> energy should be kept consistent with xc_exc_calc
475! **************************************************************************************************
476 SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section, weights, &
477 pw_pool, compute_virial, virial_xc, exc_r)
478 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: vxc_rho, vxc_tau
479 REAL(kind=dp), INTENT(out) :: exc
480 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau
481 TYPE(pw_r3d_rs_type), POINTER :: weights
482 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
483 TYPE(section_vals_type), POINTER :: xc_section
484 TYPE(pw_pool_type), POINTER :: pw_pool
485 LOGICAL :: compute_virial
486 REAL(kind=dp), DIMENSION(3, 3), INTENT(OUT) :: virial_xc
487 TYPE(pw_r3d_rs_type), INTENT(INOUT), OPTIONAL :: exc_r
488
489 CHARACTER(len=*), PARAMETER :: routinen = 'xc_vxc_pw_create'
490 INTEGER, DIMENSION(2), PARAMETER :: norm_drho_spin_name = [deriv_norm_drhoa, deriv_norm_drhob]
491
492 INTEGER :: handle, idir, ispin, jdir, &
493 npoints, nspins, &
494 xc_deriv_method_id, xc_rho_smooth_id, deriv_id
495 INTEGER, DIMENSION(2, 3) :: bo
496 LOGICAL :: dealloc_pw_to_deriv, has_laplace, &
497 has_tau, lsd, use_virial, has_gradient, &
498 has_derivs, has_rho, dealloc_pw_to_deriv_rho
499 REAL(kind=dp) :: density_smooth_cut_range, drho_cutoff, &
500 rho_cutoff
501 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data, norm_drho, norm_drho_spin, &
502 rho, rhoa, rhob
503 TYPE(cp_sll_xc_deriv_type), POINTER :: pos
504 TYPE(pw_grid_type), POINTER :: pw_grid
505 TYPE(pw_r3d_rs_type), DIMENSION(3) :: pw_to_deriv, pw_to_deriv_rho
506 TYPE(pw_c1d_gs_type) :: tmp_g, vxc_g
507 TYPE(pw_r3d_rs_type) :: v_drho_r, virial_pw
508 TYPE(xc_derivative_set_type) :: deriv_set
509 TYPE(xc_derivative_type), POINTER :: deriv_att
510 TYPE(xc_rho_set_type) :: rho_set
511
512 CALL timeset(routinen, handle)
513 NULLIFY (norm_drho_spin, norm_drho, pos)
514
515 pw_grid => rho_r(1)%pw_grid
516
517 cpassert(ASSOCIATED(xc_section))
518 cpassert(ASSOCIATED(pw_pool))
519 cpassert(.NOT. ASSOCIATED(vxc_rho))
520 cpassert(.NOT. ASSOCIATED(vxc_tau))
521 nspins = SIZE(rho_r)
522 lsd = (nspins /= 1)
523 IF (lsd) THEN
524 cpassert(nspins == 2)
525 END IF
526
527 use_virial = compute_virial
528 virial_xc = 0.0_dp
529
530 bo = rho_r(1)%pw_grid%bounds_local
531 npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1)
532
533 ! calculate the potential derivatives
534 CALL xc_rho_set_and_dset_create(rho_set=rho_set, deriv_set=deriv_set, &
535 deriv_order=1, rho_r=rho_r, rho_g=rho_g, tau=tau, &
536 xc_section=xc_section, &
537 pw_pool=pw_pool, weights=weights, &
538 calc_potential=.true.)
539
540 CALL section_vals_val_get(xc_section, "XC_GRID%XC_DERIV", &
541 i_val=xc_deriv_method_id)
542 CALL section_vals_val_get(xc_section, "XC_GRID%XC_SMOOTH_RHO", &
543 i_val=xc_rho_smooth_id)
544 CALL section_vals_val_get(xc_section, "DENSITY_SMOOTH_CUTOFF_RANGE", &
545 r_val=density_smooth_cut_range)
546
547 CALL xc_rho_set_get(rho_set, rho_cutoff=rho_cutoff, &
548 drho_cutoff=drho_cutoff)
549
550 CALL check_for_derivatives(deriv_set, lsd, has_rho, has_gradient, has_tau, has_laplace)
551 ! check for unknown derivatives
552 has_derivs = has_rho .OR. has_gradient .OR. has_tau .OR. has_laplace
553
554 ALLOCATE (vxc_rho(nspins))
555
556 CALL xc_rho_set_get(rho_set, rho=rho, rhoa=rhoa, rhob=rhob, &
557 can_return_null=.true.)
558
559 ! recover the vxc arrays
560 IF (lsd) THEN
561 CALL xc_dset_recover_pw(deriv_set, [deriv_rhoa], vxc_rho(1), pw_grid, pw_pool)
562 CALL xc_dset_recover_pw(deriv_set, [deriv_rhob], vxc_rho(2), pw_grid, pw_pool)
563 ELSE
564 CALL xc_dset_recover_pw(deriv_set, [deriv_rho], vxc_rho(1), pw_grid, pw_pool)
565 END IF
566
567 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho])
568 IF (ASSOCIATED(deriv_att)) THEN
569 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
570
571 CALL xc_rho_set_get(rho_set, norm_drho=norm_drho, &
572 rho_cutoff=rho_cutoff, &
573 drho_cutoff=drho_cutoff, &
574 can_return_null=.true.)
575 CALL xc_rho_set_recover_pw(rho_set, pw_grid, pw_pool, dealloc_pw_to_deriv_rho, drho=pw_to_deriv_rho)
576
577 cpassert(ASSOCIATED(deriv_data))
578 IF (use_virial) THEN
579 CALL pw_pool%create_pw(virial_pw)
580 CALL pw_zero(virial_pw)
581 DO idir = 1, 3
582!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(virial_pw,pw_to_deriv_rho,deriv_data,idir)
583 virial_pw%array(:, :, :) = pw_to_deriv_rho(idir)%array(:, :, :)*deriv_data(:, :, :)
584!$OMP END PARALLEL WORKSHARE
585 DO jdir = 1, idir
586 virial_xc(idir, jdir) = -pw_grid%dvol* &
587 accurate_dot_product(virial_pw%array(:, :, :), &
588 pw_to_deriv_rho(jdir)%array(:, :, :))
589 virial_xc(jdir, idir) = virial_xc(idir, jdir)
590 END DO
591 END DO
592 CALL pw_pool%give_back_pw(virial_pw)
593 END IF ! use_virial
594 DO idir = 1, 3
595 cpassert(ASSOCIATED(pw_to_deriv_rho(idir)%array))
596!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_data,pw_to_deriv_rho,idir)
597 pw_to_deriv_rho(idir)%array(:, :, :) = pw_to_deriv_rho(idir)%array(:, :, :)*deriv_data(:, :, :)
598!$OMP END PARALLEL WORKSHARE
599 END DO
600
601 ! Deallocate pw to save memory
602 CALL pw_pool%give_back_cr3d(deriv_att%deriv_data)
603
604 END IF
605
606 IF ((has_gradient .AND. xc_requires_tmp_g(xc_deriv_method_id)) .OR. pw_grid%spherical) THEN
607 CALL pw_pool%create_pw(vxc_g)
608 IF (.NOT. pw_grid%spherical) THEN
609 CALL pw_pool%create_pw(tmp_g)
610 END IF
611 END IF
612
613 DO ispin = 1, nspins
614
615 IF (lsd) THEN
616 IF (ispin == 1) THEN
617 CALL xc_rho_set_get(rho_set, norm_drhoa=norm_drho_spin, &
618 can_return_null=.true.)
619 IF (ASSOCIATED(norm_drho_spin)) CALL xc_rho_set_recover_pw( &
620 rho_set, pw_grid, pw_pool, dealloc_pw_to_deriv, drhoa=pw_to_deriv)
621 ELSE
622 CALL xc_rho_set_get(rho_set, norm_drhob=norm_drho_spin, &
623 can_return_null=.true.)
624 IF (ASSOCIATED(norm_drho_spin)) CALL xc_rho_set_recover_pw( &
625 rho_set, pw_grid, pw_pool, dealloc_pw_to_deriv, drhob=pw_to_deriv)
626 END IF
627
628 deriv_att => xc_dset_get_derivative(deriv_set, [norm_drho_spin_name(ispin)])
629 IF (ASSOCIATED(deriv_att)) THEN
630 cpassert(lsd)
631 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
632
633 IF (use_virial) THEN
634 CALL pw_pool%create_pw(virial_pw)
635 CALL pw_zero(virial_pw)
636 DO idir = 1, 3
637!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_data,pw_to_deriv,virial_pw,idir)
638 virial_pw%array(:, :, :) = pw_to_deriv(idir)%array(:, :, :)*deriv_data(:, :, :)
639!$OMP END PARALLEL WORKSHARE
640 DO jdir = 1, idir
641 virial_xc(idir, jdir) = virial_xc(idir, jdir) - pw_grid%dvol* &
642 accurate_dot_product(virial_pw%array(:, :, :), &
643 pw_to_deriv(jdir)%array(:, :, :))
644 virial_xc(jdir, idir) = virial_xc(idir, jdir)
645 END DO
646 END DO
647 CALL pw_pool%give_back_pw(virial_pw)
648 END IF ! use_virial
649
650 DO idir = 1, 3
651!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_data,idir,pw_to_deriv)
652 pw_to_deriv(idir)%array(:, :, :) = deriv_data(:, :, :)*pw_to_deriv(idir)%array(:, :, :)
653!$OMP END PARALLEL WORKSHARE
654 END DO
655 END IF ! deriv_att
656
657 END IF ! LSD
658
659 IF (ASSOCIATED(pw_to_deriv_rho(1)%array)) THEN
660 IF (.NOT. ASSOCIATED(pw_to_deriv(1)%array)) THEN
661 pw_to_deriv = pw_to_deriv_rho
662 dealloc_pw_to_deriv = ((.NOT. lsd) .OR. (ispin == 2))
663 dealloc_pw_to_deriv = dealloc_pw_to_deriv .AND. dealloc_pw_to_deriv_rho
664 ELSE
665 ! This branch is called in case of open-shell systems
666 ! Add the contributions from norm_drho and norm_drho_spin
667 DO idir = 1, 3
668 CALL pw_axpy(pw_to_deriv_rho(idir), pw_to_deriv(idir))
669 IF (ispin == 2) THEN
670 IF (dealloc_pw_to_deriv_rho) THEN
671 CALL pw_pool%give_back_pw(pw_to_deriv_rho(idir))
672 END IF
673 END IF
674 END DO
675 END IF
676 END IF
677
678 IF (ASSOCIATED(pw_to_deriv(1)%array)) THEN
679 DO idir = 1, 3
680 CALL pw_scale(pw_to_deriv(idir), -1.0_dp)
681 END DO
682
683 CALL xc_pw_divergence(xc_deriv_method_id, pw_to_deriv, tmp_g, vxc_g, vxc_rho(ispin))
684
685 IF (dealloc_pw_to_deriv) THEN
686 DO idir = 1, 3
687 CALL pw_pool%give_back_pw(pw_to_deriv(idir))
688 END DO
689 END IF
690 END IF
691
692 ! Add laplace part to vxc_rho
693 IF (has_laplace) THEN
694 IF (lsd) THEN
695 IF (ispin == 1) THEN
696 deriv_id = deriv_laplace_rhoa
697 ELSE
698 deriv_id = deriv_laplace_rhob
699 END IF
700 ELSE
701 deriv_id = deriv_laplace_rho
702 END IF
703
704 CALL xc_dset_recover_pw(deriv_set, [deriv_id], pw_to_deriv(1), pw_grid)
705
706 IF (use_virial) CALL virial_laplace(rho_r(ispin), pw_pool, virial_xc, &
707 pw_to_deriv(1)%array)
708
709 CALL xc_pw_laplace(pw_to_deriv(1), pw_pool, xc_deriv_method_id)
710
711 CALL pw_axpy(pw_to_deriv(1), vxc_rho(ispin))
712
713 CALL pw_pool%give_back_pw(pw_to_deriv(1))
714 END IF
715
716 IF (pw_grid%spherical) THEN
717 ! filter vxc
718 CALL pw_transfer(vxc_rho(ispin), vxc_g)
719 CALL pw_transfer(vxc_g, vxc_rho(ispin))
720 END IF
721 CALL smooth_cutoff(pot=vxc_rho(ispin)%array, rho=rho, rhoa=rhoa, rhob=rhob, &
722 rho_cutoff=rho_cutoff*density_smooth_cut_range, &
723 rho_smooth_cutoff_range=density_smooth_cut_range)
724
725 v_drho_r = vxc_rho(ispin)
726 CALL pw_pool%create_pw(vxc_rho(ispin))
727 CALL xc_pw_smooth(v_drho_r, vxc_rho(ispin), xc_rho_smooth_id)
728 CALL pw_pool%give_back_pw(v_drho_r)
729 END DO
730
731 CALL pw_pool%give_back_pw(vxc_g)
732 CALL pw_pool%give_back_pw(tmp_g)
733
734 ! 0-deriv -> value of exc
735 ! this has to be kept consistent with xc_exc_calc
736 IF (has_derivs) THEN
737 CALL xc_dset_recover_pw(deriv_set, [INTEGER::], v_drho_r, pw_grid)
738
739 CALL smooth_cutoff(pot=v_drho_r%array, rho=rho, rhoa=rhoa, rhob=rhob, &
740 rho_cutoff=rho_cutoff, &
741 rho_smooth_cutoff_range=density_smooth_cut_range)
742
743 exc = pw_integrate_function(v_drho_r)
744 !
745 ! return the xc functional value at the grid points
746 !
747 IF (PRESENT(exc_r)) THEN
748 exc_r = v_drho_r
749 ELSE
750 CALL v_drho_r%release()
751 END IF
752 ELSE
753 exc = 0.0_dp
754 END IF
755
756 CALL xc_rho_set_release(rho_set, pw_pool=pw_pool)
757
758 ! tau part
759 IF (has_tau) THEN
760 ALLOCATE (vxc_tau(nspins))
761 IF (lsd) THEN
762 CALL xc_dset_recover_pw(deriv_set, [deriv_tau_a], vxc_tau(1), pw_grid)
763 CALL xc_dset_recover_pw(deriv_set, [deriv_tau_b], vxc_tau(2), pw_grid)
764 ELSE
765 CALL xc_dset_recover_pw(deriv_set, [deriv_tau], vxc_tau(1), pw_grid)
766 END IF
767 DO ispin = 1, nspins
768 cpassert(ASSOCIATED(vxc_tau(ispin)%array))
769 END DO
770 END IF
771 CALL xc_dset_release(deriv_set)
772
773 CALL timestop(handle)
774
775 END SUBROUTINE xc_vxc_pw_create
776
777! **************************************************************************************************
778!> \brief calculates just the exchange and correlation energy
779!> (no vxc)
780!> \param rho_r realspace density on the grid
781!> \param rho_g g-space density on the grid
782!> \param tau kinetic energy density on the grid
783!> \param xc_section XC parameters
784!> \param weights Integration weights
785!> \param pw_pool pool of plain-wave grids
786!> \return the XC energy
787!> \par History
788!> 11.2003 created [fawzi]
789!> \author fawzi
790!> \note
791!> has to be kept consistent with xc_vxc_pw_create
792! **************************************************************************************************
793 FUNCTION xc_exc_calc(rho_r, rho_g, tau, xc_section, weights, pw_pool) &
794 result(exc)
795 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau
796 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
797 TYPE(section_vals_type), POINTER :: xc_section
798 TYPE(pw_r3d_rs_type), POINTER :: weights
799 TYPE(pw_pool_type), POINTER :: pw_pool
800 REAL(kind=dp) :: exc
801
802 CHARACTER(len=*), PARAMETER :: routinen = 'xc_exc_calc'
803
804 INTEGER :: handle
805 REAL(dp) :: density_smooth_cut_range, rho_cutoff
806 REAL(dp), DIMENSION(:, :, :), POINTER :: e_0
807 TYPE(xc_derivative_set_type) :: deriv_set
808 TYPE(xc_derivative_type), POINTER :: deriv
809 TYPE(xc_rho_set_type) :: rho_set
810
811 CALL timeset(routinen, handle)
812
813 NULLIFY (deriv, e_0)
814 exc = 0.0_dp
815
816 ! this has to be consistent with what is done in xc_vxc_pw_create
817 CALL xc_rho_set_and_dset_create(rho_set=rho_set, &
818 deriv_set=deriv_set, deriv_order=0, &
819 rho_r=rho_r, rho_g=rho_g, tau=tau, xc_section=xc_section, &
820 pw_pool=pw_pool, weights=weights, &
821 calc_potential=.false.)
822 deriv => xc_dset_get_derivative(deriv_set, [INTEGER::])
823
824 IF (ASSOCIATED(deriv)) THEN
825 CALL xc_derivative_get(deriv, deriv_data=e_0)
826
827 CALL section_vals_val_get(xc_section, "DENSITY_CUTOFF", &
828 r_val=rho_cutoff)
829 CALL section_vals_val_get(xc_section, "DENSITY_SMOOTH_CUTOFF_RANGE", &
830 r_val=density_smooth_cut_range)
831 CALL smooth_cutoff(pot=e_0, rho=rho_set%rho, &
832 rhoa=rho_set%rhoa, rhob=rho_set%rhob, &
833 rho_cutoff=rho_cutoff, &
834 rho_smooth_cutoff_range=density_smooth_cut_range)
835
836 exc = accurate_sum(e_0)*rho_r(1)%pw_grid%dvol
837 IF (rho_r(1)%pw_grid%para%mode == pw_mode_distributed) THEN
838 CALL rho_r(1)%pw_grid%para%group%sum(exc)
839 END IF
840
841 CALL xc_rho_set_release(rho_set, pw_pool=pw_pool)
842 CALL xc_dset_release(deriv_set)
843 END IF
844
845 CALL timestop(handle)
846
847 END FUNCTION xc_exc_calc
848
849! **************************************************************************************************
850!> \brief calculates just the exchange and correlation energy density
851!> \param rho_r realspace density on the grid
852!> \param rho_g g-space density on the grid
853!> \param tau kinetic energy density on the grid
854!> \param xc_section XC parameters
855!> \param weights Integration weights
856!> \param pw_pool pool of plain-wave grids
857!> \param exc xc energy density
858!> \author JGH
859! **************************************************************************************************
860 SUBROUTINE xc_exc_pw_create(rho_r, rho_g, tau, xc_section, weights, pw_pool, exc)
861 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau
862 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
863 TYPE(section_vals_type), POINTER :: xc_section
864 TYPE(pw_r3d_rs_type), POINTER :: weights
865 TYPE(pw_pool_type), POINTER :: pw_pool
866 TYPE(pw_r3d_rs_type) :: exc
867
868 CHARACTER(len=*), PARAMETER :: routinen = 'xc_exc_pw_create'
869
870 INTEGER :: handle
871 REAL(dp) :: density_smooth_cut_range, rho_cutoff
872 REAL(dp), DIMENSION(:, :, :), POINTER :: e_0
873 TYPE(xc_derivative_set_type) :: deriv_set
874 TYPE(xc_derivative_type), POINTER :: deriv
875 TYPE(xc_rho_set_type) :: rho_set
876
877 CALL timeset(routinen, handle)
878
879 NULLIFY (deriv, e_0)
880
881 CALL xc_rho_set_and_dset_create(rho_set=rho_set, &
882 deriv_set=deriv_set, deriv_order=0, &
883 rho_r=rho_r, rho_g=rho_g, tau=tau, xc_section=xc_section, &
884 pw_pool=pw_pool, weights=weights, &
885 calc_potential=.false.)
886 deriv => xc_dset_get_derivative(deriv_set, [INTEGER::])
887
888 IF (ASSOCIATED(deriv)) THEN
889 CALL xc_derivative_get(deriv, deriv_data=e_0)
890
891 CALL section_vals_val_get(xc_section, "DENSITY_CUTOFF", &
892 r_val=rho_cutoff)
893 CALL section_vals_val_get(xc_section, "DENSITY_SMOOTH_CUTOFF_RANGE", &
894 r_val=density_smooth_cut_range)
895 CALL smooth_cutoff(pot=e_0, rho=rho_set%rho, &
896 rhoa=rho_set%rhoa, rhob=rho_set%rhob, &
897 rho_cutoff=rho_cutoff, &
898 rho_smooth_cutoff_range=density_smooth_cut_range)
899
900 exc%array = e_0
901
902 CALL xc_rho_set_release(rho_set, pw_pool=pw_pool)
903 CALL xc_dset_release(deriv_set)
904 END IF
905
906 CALL timestop(handle)
907
908 END SUBROUTINE xc_exc_pw_create
909
910! **************************************************************************************************
911!> \brief Caller routine to calculate the second order potential in the direction of rho1_r
912!> \param v_xc XC potential, will be allocated, to be integrated with the KS density
913!> \param v_xc_tau ...
914!> \param deriv_set XC derivatives from xc_prep_2nd_deriv
915!> \param rho_set XC rho set from KS rho from xc_prep_2nd_deriv
916!> \param rho1_r first-order density in r space
917!> \param rho1_g first-order density in g space
918!> \param tau1_r ...
919!> \param pw_pool pw pool to create new grids
920!> \param xc_section XC section to calculate the derivatives from
921!> \param gapw whether to carry out GAPW (not possible with numerical derivatives)
922!> \param vxg GAPW potential
923!> \param do_excitations ...
924!> \param do_triplet ...
925!> \param compute_virial ...
926!> \param virial_xc virial terms will be collected here
927! **************************************************************************************************
928 SUBROUTINE xc_calc_2nd_deriv(v_xc, v_xc_tau, deriv_set, rho_set, rho1_r, rho1_g, tau1_r, &
929 pw_pool, weights, xc_section, gapw, vxg, &
930 do_excitations, do_sf, do_triplet, &
931 compute_virial, virial_xc)
932
933 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_xc, v_xc_tau
934 TYPE(xc_derivative_set_type) :: deriv_set
935 TYPE(xc_rho_set_type) :: rho_set
936 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho1_r, tau1_r
937 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho1_g
938 TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool
939 TYPE(pw_r3d_rs_type), POINTER :: weights
940 TYPE(section_vals_type), INTENT(IN), POINTER :: xc_section
941 LOGICAL, INTENT(IN) :: gapw
942 REAL(kind=dp), DIMENSION(:, :, :, :), OPTIONAL, &
943 POINTER :: vxg
944 LOGICAL, INTENT(IN), OPTIONAL :: do_excitations, do_sf, &
945 do_triplet, compute_virial
946 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT), &
947 OPTIONAL :: virial_xc
948
949 CHARACTER(len=*), PARAMETER :: routinen = 'xc_calc_2nd_deriv'
950
951 INTEGER :: handle, ispin, nspins
952 INTEGER, DIMENSION(2, 3) :: bo
953 LOGICAL :: lsd, my_compute_virial, &
954 my_do_excitations, my_do_sf, &
955 my_do_triplet
956 REAL(kind=dp) :: fac
957 TYPE(section_vals_type), POINTER :: xc_fun_section
958 TYPE(xc_rho_cflags_type) :: needs
959 TYPE(xc_rho_set_type) :: rho1_set
960
961 CALL timeset(routinen, handle)
962
963 my_compute_virial = .false.
964 IF (PRESENT(compute_virial)) my_compute_virial = compute_virial
965
966 my_do_sf = .false.
967 IF (PRESENT(do_sf)) my_do_sf = do_sf
968
969 my_do_excitations = .false.
970 IF (PRESENT(do_excitations)) my_do_excitations = do_excitations
971
972 my_do_triplet = .false.
973 IF (PRESENT(do_triplet)) my_do_triplet = do_triplet
974
975 nspins = SIZE(rho1_r)
976 lsd = (nspins == 2)
977 IF (nspins == 1 .AND. my_do_excitations .AND. my_do_triplet) THEN
978 nspins = 2
979 lsd = .true.
980 ELSE IF (my_do_sf) THEN
981 nspins = 1
982 lsd = .true.
983 END IF
984
985 NULLIFY (v_xc, v_xc_tau)
986 ALLOCATE (v_xc(nspins))
987 DO ispin = 1, nspins
988 CALL pw_pool%create_pw(v_xc(ispin))
989 CALL pw_zero(v_xc(ispin))
990 END DO
991
992 xc_fun_section => section_vals_get_subs_vals(xc_section, "XC_FUNCTIONAL")
993 needs = xc_functionals_get_needs(xc_fun_section, lsd, .true.)
994
995 IF (needs%tau .OR. needs%tau_spin) THEN
996 IF (.NOT. ASSOCIATED(tau1_r)) THEN
997 cpabort("Tau-dependent functionals requires allocated kinetic energy density grid")
998 END IF
999 ALLOCATE (v_xc_tau(nspins))
1000 DO ispin = 1, nspins
1001 CALL pw_pool%create_pw(v_xc_tau(ispin))
1002 CALL pw_zero(v_xc_tau(ispin))
1003 END DO
1004 END IF
1005
1006 IF (section_get_lval(xc_section, "2ND_DERIV_ANALYTICAL")) THEN
1007 !------!
1008 ! rho1 !
1009 !------!
1010 bo = rho1_r(1)%pw_grid%bounds_local
1011 ! create the place where to store the argument for the functionals
1012 CALL xc_rho_set_create(rho1_set, bo, &
1013 rho_cutoff=section_get_rval(xc_section, "DENSITY_CUTOFF"), &
1014 drho_cutoff=section_get_rval(xc_section, "GRADIENT_CUTOFF"), &
1015 tau_cutoff=section_get_rval(xc_section, "TAU_CUTOFF"))
1016
1017 ! calculate the arguments needed by the functionals
1018 CALL xc_rho_set_update(rho1_set, rho1_r, rho1_g, tau1_r, needs, &
1019 section_get_ival(xc_section, "XC_GRID%XC_DERIV"), &
1020 section_get_ival(xc_section, "XC_GRID%XC_SMOOTH_RHO"), &
1021 pw_pool, spinflip=my_do_sf)
1022
1023 fac = 0._dp
1024 IF (nspins == 1 .AND. my_do_excitations) THEN
1025 IF (my_do_triplet) fac = -1.0_dp
1026 END IF
1027
1028 CALL xc_calc_2nd_deriv_analytical(v_xc, v_xc_tau, deriv_set, rho_set, &
1029 rho1_set, pw_pool, xc_section, &
1030 gapw, vxg=vxg, spinflip=my_do_sf, tddfpt_fac=fac, &
1031 compute_virial=compute_virial, virial_xc=virial_xc)
1032
1033 CALL xc_rho_set_release(rho1_set)
1034
1035 ELSE
1036 IF (gapw) cpabort("Numerical 2nd derivatives not implemented with GAPW")
1037
1038 CALL xc_calc_2nd_deriv_numerical(v_xc, v_xc_tau, rho_set, rho1_r, rho1_g, tau1_r, &
1039 pw_pool, weights, xc_section, &
1040 my_do_excitations .AND. my_do_triplet, &
1041 compute_virial, virial_xc, deriv_set)
1042 END IF
1043
1044 CALL timestop(handle)
1045
1046 END SUBROUTINE xc_calc_2nd_deriv
1047
1048! **************************************************************************************************
1049!> \brief calculates 2nd derivative numerically
1050!> \param v_xc potential to be calculated (has to be allocated already)
1051!> \param v_tau tau-part of the potential to be calculated (has to be allocated already)
1052!> \param rho_set KS density from xc_prep_2nd_deriv
1053!> \param rho1_r first-order density in r-space
1054!> \param rho1_g first-order density in g-space
1055!> \param tau1_r first-order kinetic-energy density in r-space
1056!> \param pw_pool pw pool for new grids
1057!> \param xc_section XC section to calculate the derivatives from
1058!> \param do_triplet ...
1059!> \param calc_virial whether to calculate virial terms
1060!> \param virial_xc collects stress tensor components (no metaGGAs!)
1061!> \param deriv_set deriv set from xc_prep_2nd_deriv (only for virials)
1062! **************************************************************************************************
1063 SUBROUTINE xc_calc_2nd_deriv_numerical(v_xc, v_tau, rho_set, rho1_r, rho1_g, tau1_r, &
1064 pw_pool, weights, xc_section, &
1065 do_triplet, calc_virial, virial_xc, deriv_set)
1066
1067 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(IN), POINTER :: v_xc, v_tau
1068 TYPE(xc_rho_set_type), INTENT(IN) :: rho_set
1069 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(IN), POINTER :: rho1_r, tau1_r
1070 TYPE(pw_c1d_gs_type), DIMENSION(:), INTENT(IN), POINTER :: rho1_g
1071 TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool
1072 TYPE(pw_r3d_rs_type), INTENT(IN), POINTER :: weights
1073 TYPE(section_vals_type), INTENT(IN), POINTER :: xc_section
1074 LOGICAL, INTENT(IN) :: do_triplet
1075 LOGICAL, INTENT(IN), OPTIONAL :: calc_virial
1076 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT), &
1077 OPTIONAL :: virial_xc
1078 TYPE(xc_derivative_set_type), OPTIONAL :: deriv_set
1079
1080 CHARACTER(len=*), PARAMETER :: routinen = 'xc_calc_2nd_deriv_numerical'
1081 REAL(kind=dp), DIMENSION(-4:4, 4), PARAMETER :: &
1082 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, &
1083 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, &
1084 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, &
1085 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])
1086
1087 INTEGER :: handle, idir, ispin, nspins, istep, nsteps
1088 INTEGER, DIMENSION(2, 3) :: bo
1089 LOGICAL :: gradient_f, lsd, my_calc_virial, tau_f, laplace_f, rho_f
1090 REAL(kind=dp) :: exc, gradient_cut, h, rweight, step, rho_cutoff
1091 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: dr1dr, dra1dra, drb1drb
1092 REAL(kind=dp), DIMENSION(3, 3) :: virial_dummy
1093 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: norm_drho, norm_drho2, norm_drho2a, &
1094 norm_drho2b, norm_drhoa, norm_drhob, &
1095 rho, rho1, rho1a, rho1b, rhoa, rhob, &
1096 tau_a, tau_b, tau, tau1, tau1a, tau1b, laplace, laplace1, &
1097 laplacea, laplaceb, laplace1a, laplace1b, &
1098 laplace2, laplace2a, laplace2b, deriv_data
1099 TYPE(cp_3d_r_cp_type), DIMENSION(3) :: drho, drho1, drho1a, drho1b, drhoa, drhob
1100 TYPE(pw_r3d_rs_type) :: v_drho, v_drhoa, v_drhob
1101 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: vxc_rho, vxc_tau
1102 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
1103 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau_r
1104 TYPE(pw_r3d_rs_type) :: virial_pw, v_laplace, v_laplacea, v_laplaceb
1105 TYPE(section_vals_type), POINTER :: xc_fun_section
1106 TYPE(xc_derivative_set_type) :: deriv_set1
1107 TYPE(xc_rho_cflags_type) :: needs
1108 TYPE(xc_rho_set_type) :: rho1_set, rho2_set
1109
1110 CALL timeset(routinen, handle)
1111
1112 my_calc_virial = .false.
1113 IF (PRESENT(calc_virial) .AND. PRESENT(virial_xc)) my_calc_virial = calc_virial
1114
1115 nspins = SIZE(v_xc)
1116
1117 NULLIFY (tau, tau_r, tau_a, tau_b)
1118
1119 h = section_get_rval(xc_section, "STEP_SIZE")
1120 nsteps = section_get_ival(xc_section, "NSTEPS")
1121 IF (nsteps < lbound(rweights, 2) .OR. nsteps > ubound(rweights, 2)) THEN
1122 cpabort("The number of steps must be a value from 1 to 4.")
1123 END IF
1124
1125 IF (nspins == 2) THEN
1126 NULLIFY (vxc_rho, rho_g, vxc_tau)
1127 ALLOCATE (rho_r(2))
1128 DO ispin = 1, nspins
1129 CALL pw_pool%create_pw(rho_r(ispin))
1130 END DO
1131 IF (ASSOCIATED(tau1_r) .AND. ASSOCIATED(v_tau)) THEN
1132 ALLOCATE (tau_r(2))
1133 DO ispin = 1, nspins
1134 CALL pw_pool%create_pw(tau_r(ispin))
1135 END DO
1136 END IF
1137 CALL xc_rho_set_get(rho_set, can_return_null=.true., rhoa=rhoa, rhob=rhob, tau_a=tau_a, tau_b=tau_b)
1138 DO istep = -nsteps, nsteps
1139 IF (istep == 0) cycle
1140 rweight = rweights(istep, nsteps)/h
1141 step = real(istep, dp)*h
1142 CALL calc_resp_potential_numer_ab(rho_r, rho_g, rho1_r, rhoa, rhob, vxc_rho, &
1143 tau_r, tau1_r, tau_a, tau_b, vxc_tau, xc_section, &
1144 weights, pw_pool, step)
1145 DO ispin = 1, nspins
1146 CALL pw_axpy(vxc_rho(ispin), v_xc(ispin), rweight)
1147 IF (ASSOCIATED(vxc_tau) .AND. ASSOCIATED(v_tau)) THEN
1148 CALL pw_axpy(vxc_tau(ispin), v_tau(ispin), rweight)
1149 END IF
1150 END DO
1151 DO ispin = 1, nspins
1152 CALL vxc_rho(ispin)%release()
1153 END DO
1154 DEALLOCATE (vxc_rho)
1155 IF (ASSOCIATED(vxc_tau)) THEN
1156 DO ispin = 1, nspins
1157 CALL vxc_tau(ispin)%release()
1158 END DO
1159 DEALLOCATE (vxc_tau)
1160 END IF
1161 END DO
1162 ELSE IF (nspins == 1 .AND. do_triplet) THEN
1163 NULLIFY (vxc_rho, vxc_tau, rho_g)
1164 ALLOCATE (rho_r(2))
1165 DO ispin = 1, 2
1166 CALL pw_pool%create_pw(rho_r(ispin))
1167 END DO
1168 IF (ASSOCIATED(tau1_r) .AND. ASSOCIATED(v_tau)) THEN
1169 ALLOCATE (tau_r(2))
1170 DO ispin = 1, nspins
1171 CALL pw_pool%create_pw(tau_r(ispin))
1172 END DO
1173 END IF
1174 CALL xc_rho_set_get(rho_set, can_return_null=.true., rhoa=rhoa, rhob=rhob, tau_a=tau_a, tau_b=tau_b)
1175 DO istep = -nsteps, nsteps
1176 IF (istep == 0) cycle
1177 rweight = rweights(istep, nsteps)/h
1178 step = real(istep, dp)*h
1179 ! K(alpha,alpha)
1180!$OMP PARALLEL DEFAULT(NONE) SHARED(rho_r,rhoa,rhob,step,rho1_r,tau_r,tau_a,tau_b,tau1_r)
1181!$OMP WORKSHARE
1182 rho_r(1)%array(:, :, :) = rhoa(:, :, :) + step*rho1_r(1)%array(:, :, :)
1183!$OMP END WORKSHARE NOWAIT
1184!$OMP WORKSHARE
1185 rho_r(2)%array(:, :, :) = rhob(:, :, :)
1186!$OMP END WORKSHARE NOWAIT
1187 IF (ASSOCIATED(tau1_r)) THEN
1188!$OMP WORKSHARE
1189 tau_r(1)%array(:, :, :) = tau_a(:, :, :) + step*tau1_r(1)%array(:, :, :)
1190!$OMP END WORKSHARE NOWAIT
1191!$OMP WORKSHARE
1192 tau_r(2)%array(:, :, :) = tau_b(:, :, :)
1193!$OMP END WORKSHARE NOWAIT
1194 END IF
1195!$OMP END PARALLEL
1196 CALL xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau_r, xc_section, &
1197 weights, pw_pool, .false., virial_dummy)
1198 CALL pw_axpy(vxc_rho(1), v_xc(1), rweight)
1199 IF (ASSOCIATED(vxc_tau) .AND. ASSOCIATED(v_tau)) THEN
1200 CALL pw_axpy(vxc_tau(1), v_tau(1), rweight)
1201 END IF
1202 DO ispin = 1, 2
1203 CALL vxc_rho(ispin)%release()
1204 END DO
1205 DEALLOCATE (vxc_rho)
1206 IF (ASSOCIATED(vxc_tau)) THEN
1207 DO ispin = 1, 2
1208 CALL vxc_tau(ispin)%release()
1209 END DO
1210 DEALLOCATE (vxc_tau)
1211 END IF
1212!$OMP PARALLEL DEFAULT(NONE) SHARED(rho_r,rhoa,rhob,step,rho1_r,tau_r,tau_a,tau_b,tau1_r)
1213!$OMP WORKSHARE
1214 ! K(alpha,beta)
1215 rho_r(1)%array(:, :, :) = rhoa(:, :, :)
1216!$OMP END WORKSHARE NOWAIT
1217!$OMP WORKSHARE
1218 rho_r(2)%array(:, :, :) = rhob(:, :, :) + step*rho1_r(1)%array(:, :, :)
1219!$OMP END WORKSHARE NOWAIT
1220 IF (ASSOCIATED(tau1_r)) THEN
1221!$OMP WORKSHARE
1222 tau_r(1)%array(:, :, :) = tau_a(:, :, :)
1223!$OMP END WORKSHARE NOWAIT
1224!$OMP WORKSHARE
1225 tau_r(2)%array(:, :, :) = tau_b(:, :, :) + step*tau1_r(1)%array(:, :, :)
1226!$OMP END WORKSHARE NOWAIT
1227 END IF
1228!$OMP END PARALLEL
1229 CALL xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau_r, xc_section, &
1230 weights, pw_pool, .false., virial_dummy)
1231 CALL pw_axpy(vxc_rho(1), v_xc(1), rweight)
1232 IF (ASSOCIATED(vxc_tau) .AND. ASSOCIATED(v_tau)) THEN
1233 CALL pw_axpy(vxc_tau(1), v_tau(1), rweight)
1234 END IF
1235 DO ispin = 1, 2
1236 CALL vxc_rho(ispin)%release()
1237 END DO
1238 DEALLOCATE (vxc_rho)
1239 IF (ASSOCIATED(vxc_tau)) THEN
1240 DO ispin = 1, 2
1241 CALL vxc_tau(ispin)%release()
1242 END DO
1243 DEALLOCATE (vxc_tau)
1244 END IF
1245 END DO
1246 ELSE
1247 NULLIFY (vxc_rho, rho_r, rho_g, vxc_tau, tau_r, tau)
1248 ALLOCATE (rho_r(1))
1249 CALL pw_pool%create_pw(rho_r(1))
1250 IF (ASSOCIATED(tau1_r) .AND. ASSOCIATED(v_tau)) THEN
1251 ALLOCATE (tau_r(1))
1252 CALL pw_pool%create_pw(tau_r(1))
1253 END IF
1254 CALL xc_rho_set_get(rho_set, can_return_null=.true., rho=rho, tau=tau)
1255 DO istep = -nsteps, nsteps
1256 IF (istep == 0) cycle
1257 rweight = rweights(istep, nsteps)/h
1258 step = real(istep, dp)*h
1259!$OMP PARALLEL DEFAULT(NONE) SHARED(rho_r,rho,step,rho1_r,tau1_r,tau,tau_r)
1260!$OMP WORKSHARE
1261 rho_r(1)%array(:, :, :) = rho(:, :, :) + step*rho1_r(1)%array(:, :, :)
1262!$OMP END WORKSHARE NOWAIT
1263 IF (ASSOCIATED(tau1_r) .AND. ASSOCIATED(tau) .AND. ASSOCIATED(tau1_r)) THEN
1264!$OMP WORKSHARE
1265 tau_r(1)%array(:, :, :) = tau(:, :, :) + step*tau1_r(1)%array(:, :, :)
1266!$OMP END WORKSHARE NOWAIT
1267 END IF
1268!$OMP END PARALLEL
1269 CALL xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau_r, xc_section, &
1270 weights, pw_pool, .false., virial_dummy)
1271 CALL pw_axpy(vxc_rho(1), v_xc(1), rweight)
1272 IF (ASSOCIATED(vxc_tau) .AND. ASSOCIATED(v_tau)) THEN
1273 CALL pw_axpy(vxc_tau(1), v_tau(1), rweight)
1274 END IF
1275 CALL vxc_rho(1)%release()
1276 DEALLOCATE (vxc_rho)
1277 IF (ASSOCIATED(vxc_tau)) THEN
1278 CALL vxc_tau(1)%release()
1279 DEALLOCATE (vxc_tau)
1280 END IF
1281 END DO
1282 END IF
1283
1284 IF (my_calc_virial) THEN
1285 lsd = (nspins == 2)
1286 IF (nspins == 1 .AND. do_triplet) THEN
1287 lsd = .true.
1288 END IF
1289
1290 CALL check_for_derivatives(deriv_set, (nspins == 2), rho_f, gradient_f, tau_f, laplace_f)
1291
1292 ! Calculate the virial terms
1293 ! Those arising from the first derivatives are treated like in xc_calc_2nd_deriv_analytical
1294 ! Those arising from the second derivatives are calculated numerically
1295 ! We assume that all metaGGA functionals require the gradient
1296 IF (gradient_f) THEN
1297 bo = rho_set%local_bounds
1298
1299 ! Create the work grid for the virial terms
1300 CALL allocate_pw(virial_pw, pw_pool, bo)
1301
1302 gradient_cut = section_get_rval(xc_section, "GRADIENT_CUTOFF")
1303
1304 ! create the container to store the argument of the functionals
1305 CALL xc_rho_set_create(rho1_set, bo, &
1306 rho_cutoff=section_get_rval(xc_section, "DENSITY_CUTOFF"), &
1307 drho_cutoff=gradient_cut, &
1308 tau_cutoff=section_get_rval(xc_section, "TAU_CUTOFF"))
1309
1310 xc_fun_section => section_vals_get_subs_vals(xc_section, "XC_FUNCTIONAL")
1311 needs = xc_functionals_get_needs(xc_fun_section, lsd, .true.)
1312
1313 ! calculate the arguments needed by the functionals
1314 CALL xc_rho_set_update(rho1_set, rho1_r, rho1_g, tau1_r, needs, &
1315 section_get_ival(xc_section, "XC_GRID%XC_DERIV"), &
1316 section_get_ival(xc_section, "XC_GRID%XC_SMOOTH_RHO"), &
1317 pw_pool)
1318
1319 IF (lsd) THEN
1320 CALL xc_rho_set_get(rho_set, drhoa=drhoa, drhob=drhob, norm_drho=norm_drho, &
1321 norm_drhoa=norm_drhoa, norm_drhob=norm_drhob, tau_a=tau_a, tau_b=tau_b, &
1322 laplace_rhoa=laplacea, laplace_rhob=laplaceb, can_return_null=.true.)
1323 CALL xc_rho_set_get(rho1_set, rhoa=rho1a, rhob=rho1b, drhoa=drho1a, drhob=drho1b, laplace_rhoa=laplace1a, &
1324 laplace_rhob=laplace1b, can_return_null=.true.)
1325
1326 CALL calc_drho_from_ab(drho, drhoa, drhob)
1327 CALL calc_drho_from_ab(drho1, drho1a, drho1b)
1328 ELSE
1329 CALL xc_rho_set_get(rho_set, drho=drho, norm_drho=norm_drho, tau=tau, laplace_rho=laplace, can_return_null=.true.)
1330 CALL xc_rho_set_get(rho1_set, rho=rho1, drho=drho1, laplace_rho=laplace1, can_return_null=.true.)
1331 END IF
1332
1333 CALL prepare_dr1dr(dr1dr, drho, drho1)
1334
1335 IF (lsd) THEN
1336 CALL prepare_dr1dr(dra1dra, drhoa, drho1a)
1337 CALL prepare_dr1dr(drb1drb, drhob, drho1b)
1338
1339 CALL allocate_pw(v_drho, pw_pool, bo)
1340 CALL allocate_pw(v_drhoa, pw_pool, bo)
1341 CALL allocate_pw(v_drhob, pw_pool, bo)
1342
1343 IF (ASSOCIATED(norm_drhoa)) CALL apply_drho(deriv_set, [deriv_norm_drhoa], virial_pw, &
1344 drhoa, drho1a, virial_xc, &
1345 norm_drhoa, gradient_cut, dra1dra, v_drhoa%array)
1346 IF (ASSOCIATED(norm_drhob)) CALL apply_drho(deriv_set, [deriv_norm_drhob], virial_pw, &
1347 drhob, drho1b, virial_xc, &
1348 norm_drhob, gradient_cut, drb1drb, v_drhob%array)
1349 IF (ASSOCIATED(norm_drho)) CALL apply_drho(deriv_set, [deriv_norm_drho], virial_pw, &
1350 drho, drho1, virial_xc, &
1351 norm_drho, gradient_cut, dr1dr, v_drho%array)
1352 IF (laplace_f) THEN
1353 CALL xc_derivative_get(xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa]), deriv_data=deriv_data)
1354 cpassert(ASSOCIATED(deriv_data))
1355 virial_pw%array(:, :, :) = -rho1a(:, :, :)
1356 CALL virial_laplace(virial_pw, pw_pool, virial_xc, deriv_data)
1357
1358 CALL allocate_pw(v_laplacea, pw_pool, bo)
1359
1360 CALL xc_derivative_get(xc_dset_get_derivative(deriv_set, [deriv_laplace_rhob]), deriv_data=deriv_data)
1361 cpassert(ASSOCIATED(deriv_data))
1362 virial_pw%array(:, :, :) = -rho1b(:, :, :)
1363 CALL virial_laplace(virial_pw, pw_pool, virial_xc, deriv_data)
1364
1365 CALL allocate_pw(v_laplaceb, pw_pool, bo)
1366 END IF
1367
1368 ELSE
1369
1370 ! Create the work grid for the potential of the gradient part
1371 CALL allocate_pw(v_drho, pw_pool, bo)
1372
1373 CALL apply_drho(deriv_set, [deriv_norm_drho], virial_pw, drho, drho1, virial_xc, &
1374 norm_drho, gradient_cut, dr1dr, v_drho%array)
1375 IF (laplace_f) THEN
1376 CALL xc_derivative_get(xc_dset_get_derivative(deriv_set, [deriv_laplace_rho]), deriv_data=deriv_data)
1377 cpassert(ASSOCIATED(deriv_data))
1378 virial_pw%array(:, :, :) = -rho1(:, :, :)
1379 CALL virial_laplace(virial_pw, pw_pool, virial_xc, deriv_data)
1380
1381 CALL allocate_pw(v_laplace, pw_pool, bo)
1382 END IF
1383
1384 END IF
1385
1386 IF (lsd) THEN
1387 rho_r(1)%array = rhoa
1388 rho_r(2)%array = rhob
1389 ELSE
1390 rho_r(1)%array = rho
1391 END IF
1392 IF (ASSOCIATED(tau1_r)) THEN
1393 IF (lsd) THEN
1394 tau_r(1)%array = tau_a
1395 tau_r(2)%array = tau_b
1396 ELSE
1397 tau_r(1)%array = tau
1398 END IF
1399 END IF
1400
1401 ! Create deriv sets with same densities but different gradients
1402 CALL xc_dset_create(deriv_set1, pw_pool)
1403
1404 rho_cutoff = section_get_rval(xc_section, "DENSITY_CUTOFF")
1405
1406 ! create the place where to store the argument for the functionals
1407 CALL xc_rho_set_create(rho2_set, bo, &
1408 rho_cutoff=rho_cutoff, &
1409 drho_cutoff=section_get_rval(xc_section, "GRADIENT_CUTOFF"), &
1410 tau_cutoff=section_get_rval(xc_section, "TAU_CUTOFF"))
1411
1412 ! calculate the arguments needed by the functionals
1413 CALL xc_rho_set_update(rho2_set, rho_r, rho_g, tau_r, needs, &
1414 section_get_ival(xc_section, "XC_GRID%XC_DERIV"), &
1415 section_get_ival(xc_section, "XC_GRID%XC_SMOOTH_RHO"), &
1416 pw_pool)
1417
1418 IF (lsd) THEN
1419 CALL xc_rho_set_get(rho1_set, rhoa=rho1a, rhob=rho1b, tau_a=tau1a, tau_b=tau1b, &
1420 laplace_rhoa=laplace1a, laplace_rhob=laplace1b, can_return_null=.true.)
1421 CALL xc_rho_set_get(rho2_set, norm_drhoa=norm_drho2a, norm_drhob=norm_drho2b, &
1422 norm_drho=norm_drho2, laplace_rhoa=laplace2a, laplace_rhob=laplace2b, can_return_null=.true.)
1423
1424 DO istep = -nsteps, nsteps
1425 IF (istep == 0) cycle
1426 rweight = rweights(istep, nsteps)/h
1427 step = real(istep, dp)*h
1428 IF (ASSOCIATED(norm_drhoa)) THEN
1429 CALL get_derivs_rho(norm_drho2a, norm_drhoa, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1430 CALL update_deriv_rho(deriv_set1, [deriv_rhoa], bo, &
1431 norm_drhoa, gradient_cut, rweight, rho1a, v_drhoa%array)
1432 CALL update_deriv_rho(deriv_set1, [deriv_rhob], bo, &
1433 norm_drhoa, gradient_cut, rweight, rho1b, v_drhoa%array)
1434 CALL update_deriv_rho(deriv_set1, [deriv_norm_drhoa], bo, &
1435 norm_drhoa, gradient_cut, rweight, dra1dra, v_drhoa%array)
1436 CALL update_deriv_drho_ab(deriv_set1, [deriv_norm_drhob], bo, &
1437 norm_drhoa, gradient_cut, rweight, dra1dra, drb1drb, v_drhoa%array, v_drhob%array)
1438 CALL update_deriv_drho_ab(deriv_set1, [deriv_norm_drho], bo, &
1439 norm_drhoa, gradient_cut, rweight, dra1dra, dr1dr, v_drhoa%array, v_drho%array)
1440 IF (tau_f) THEN
1441 CALL update_deriv_rho(deriv_set1, [deriv_tau_a], bo, &
1442 norm_drhoa, gradient_cut, rweight, tau1a, v_drhoa%array)
1443 CALL update_deriv_rho(deriv_set1, [deriv_tau_b], bo, &
1444 norm_drhoa, gradient_cut, rweight, tau1b, v_drhoa%array)
1445 END IF
1446 IF (laplace_f) THEN
1447 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rhoa], bo, &
1448 norm_drhoa, gradient_cut, rweight, laplace1a, v_drhoa%array)
1449 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rhob], bo, &
1450 norm_drhoa, gradient_cut, rweight, laplace1b, v_drhoa%array)
1451 END IF
1452 END IF
1453
1454 IF (ASSOCIATED(norm_drhob)) THEN
1455 CALL get_derivs_rho(norm_drho2b, norm_drhob, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1456 CALL update_deriv_rho(deriv_set1, [deriv_rhoa], bo, &
1457 norm_drhob, gradient_cut, rweight, rho1a, v_drhob%array)
1458 CALL update_deriv_rho(deriv_set1, [deriv_rhob], bo, &
1459 norm_drhob, gradient_cut, rweight, rho1b, v_drhob%array)
1460 CALL update_deriv_rho(deriv_set1, [deriv_norm_drhob], bo, &
1461 norm_drhob, gradient_cut, rweight, drb1drb, v_drhob%array)
1462 CALL update_deriv_drho_ab(deriv_set1, [deriv_norm_drhoa], bo, &
1463 norm_drhob, gradient_cut, rweight, drb1drb, dra1dra, v_drhob%array, v_drhoa%array)
1464 CALL update_deriv_drho_ab(deriv_set1, [deriv_norm_drho], bo, &
1465 norm_drhob, gradient_cut, rweight, drb1drb, dr1dr, v_drhob%array, v_drho%array)
1466 IF (tau_f) THEN
1467 CALL update_deriv_rho(deriv_set1, [deriv_tau_a], bo, &
1468 norm_drhob, gradient_cut, rweight, tau1a, v_drhob%array)
1469 CALL update_deriv_rho(deriv_set1, [deriv_tau_b], bo, &
1470 norm_drhob, gradient_cut, rweight, tau1b, v_drhob%array)
1471 END IF
1472 IF (laplace_f) THEN
1473 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rhoa], bo, &
1474 norm_drhob, gradient_cut, rweight, laplace1a, v_drhob%array)
1475 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rhob], bo, &
1476 norm_drhob, gradient_cut, rweight, laplace1b, v_drhob%array)
1477 END IF
1478 END IF
1479
1480 IF (ASSOCIATED(norm_drho)) THEN
1481 CALL get_derivs_rho(norm_drho2, norm_drho, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1482 CALL update_deriv_rho(deriv_set1, [deriv_rhoa], bo, &
1483 norm_drho, gradient_cut, rweight, rho1a, v_drho%array)
1484 CALL update_deriv_rho(deriv_set1, [deriv_rhob], bo, &
1485 norm_drho, gradient_cut, rweight, rho1b, v_drho%array)
1486 CALL update_deriv_rho(deriv_set1, [deriv_norm_drho], bo, &
1487 norm_drho, gradient_cut, rweight, dr1dr, v_drho%array)
1488 CALL update_deriv_drho_ab(deriv_set1, [deriv_norm_drhoa], bo, &
1489 norm_drho, gradient_cut, rweight, dr1dr, dra1dra, v_drho%array, v_drhoa%array)
1490 CALL update_deriv_drho_ab(deriv_set1, [deriv_norm_drhob], bo, &
1491 norm_drho, gradient_cut, rweight, dr1dr, drb1drb, v_drho%array, v_drhob%array)
1492 IF (tau_f) THEN
1493 CALL update_deriv_rho(deriv_set1, [deriv_tau_a], bo, &
1494 norm_drho, gradient_cut, rweight, tau1a, v_drho%array)
1495 CALL update_deriv_rho(deriv_set1, [deriv_tau_b], bo, &
1496 norm_drho, gradient_cut, rweight, tau1b, v_drho%array)
1497 END IF
1498 IF (laplace_f) THEN
1499 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rhoa], bo, &
1500 norm_drho, gradient_cut, rweight, laplace1a, v_drho%array)
1501 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rhob], bo, &
1502 norm_drho, gradient_cut, rweight, laplace1b, v_drho%array)
1503 END IF
1504 END IF
1505
1506 IF (laplace_f) THEN
1507
1508 CALL get_derivs_rho(laplace2a, laplacea, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1509
1510 ! Obtain the numerical 2nd derivatives w.r.t. to drho and collect the potential
1511 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_rhoa], bo, &
1512 rweight, rho1a, v_laplacea%array)
1513 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_rhob], bo, &
1514 rweight, rho1b, v_laplacea%array)
1515 IF (ASSOCIATED(norm_drho)) THEN
1516 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_norm_drho], bo, &
1517 rweight, dr1dr, v_laplacea%array)
1518 END IF
1519 IF (ASSOCIATED(norm_drhoa)) THEN
1520 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_norm_drhoa], bo, &
1521 rweight, dra1dra, v_laplacea%array)
1522 END IF
1523 IF (ASSOCIATED(norm_drhob)) THEN
1524 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_norm_drhob], bo, &
1525 rweight, drb1drb, v_laplacea%array)
1526 END IF
1527
1528 IF (ASSOCIATED(tau1a)) THEN
1529 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_tau_a], bo, &
1530 rweight, tau1a, v_laplacea%array)
1531 END IF
1532 IF (ASSOCIATED(tau1b)) THEN
1533 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_tau_b], bo, &
1534 rweight, tau1b, v_laplacea%array)
1535 END IF
1536
1537 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_laplace_rhoa], bo, &
1538 rweight, laplace1a, v_laplacea%array)
1539
1540 CALL update_deriv(deriv_set1, laplacea, rho_cutoff, [deriv_laplace_rhob], bo, &
1541 rweight, laplace1b, v_laplacea%array)
1542
1543 ! The same for the beta spin
1544 CALL get_derivs_rho(laplace2b, laplaceb, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1545
1546 ! Obtain the numerical 2nd derivatives w.r.t. to drho and collect the potential
1547 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_rhoa], bo, &
1548 rweight, rho1a, v_laplaceb%array)
1549 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_rhob], bo, &
1550 rweight, rho1b, v_laplaceb%array)
1551 IF (ASSOCIATED(norm_drho)) THEN
1552 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_norm_drho], bo, &
1553 rweight, dr1dr, v_laplaceb%array)
1554 END IF
1555 IF (ASSOCIATED(norm_drhoa)) THEN
1556 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_norm_drhoa], bo, &
1557 rweight, dra1dra, v_laplaceb%array)
1558 END IF
1559 IF (ASSOCIATED(norm_drhob)) THEN
1560 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_norm_drhob], bo, &
1561 rweight, drb1drb, v_laplaceb%array)
1562 END IF
1563
1564 IF (tau_f) THEN
1565 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_tau_a], bo, &
1566 rweight, tau1a, v_laplaceb%array)
1567 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_tau_b], bo, &
1568 rweight, tau1b, v_laplaceb%array)
1569 END IF
1570
1571 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_laplace_rhoa], bo, &
1572 rweight, laplace1a, v_laplaceb%array)
1573
1574 CALL update_deriv(deriv_set1, laplaceb, rho_cutoff, [deriv_laplace_rhob], bo, &
1575 rweight, laplace1b, v_laplaceb%array)
1576 END IF
1577 END DO
1578
1579 CALL virial_drho_drho(virial_pw, drhoa, v_drhoa, virial_xc)
1580 CALL virial_drho_drho(virial_pw, drhob, v_drhob, virial_xc)
1581 CALL virial_drho_drho(virial_pw, drho, v_drho, virial_xc)
1582
1583 CALL deallocate_pw(v_drho, pw_pool)
1584 CALL deallocate_pw(v_drhoa, pw_pool)
1585 CALL deallocate_pw(v_drhob, pw_pool)
1586
1587 IF (laplace_f) THEN
1588 virial_pw%array(:, :, :) = -rhoa(:, :, :)
1589 CALL virial_laplace(virial_pw, pw_pool, virial_xc, v_laplacea%array)
1590 CALL deallocate_pw(v_laplacea, pw_pool)
1591
1592 virial_pw%array(:, :, :) = -rhob(:, :, :)
1593 CALL virial_laplace(virial_pw, pw_pool, virial_xc, v_laplaceb%array)
1594 CALL deallocate_pw(v_laplaceb, pw_pool)
1595 END IF
1596
1597 CALL deallocate_pw(virial_pw, pw_pool)
1598
1599 DO idir = 1, 3
1600 DEALLOCATE (drho(idir)%array)
1601 DEALLOCATE (drho1(idir)%array)
1602 END DO
1603 DEALLOCATE (dra1dra, drb1drb)
1604
1605 ELSE
1606 CALL xc_rho_set_get(rho1_set, rho=rho1, tau=tau1, laplace_rho=laplace1, can_return_null=.true.)
1607 CALL xc_rho_set_get(rho2_set, norm_drho=norm_drho2, laplace_rho=laplace2, can_return_null=.true.)
1608
1609 DO istep = -nsteps, nsteps
1610 IF (istep == 0) cycle
1611 rweight = rweights(istep, nsteps)/h
1612 step = real(istep, dp)*h
1613 CALL get_derivs_rho(norm_drho2, norm_drho, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1614
1615 ! Obtain the numerical 2nd derivatives w.r.t. to drho and collect the potential
1616 CALL update_deriv_rho(deriv_set1, [deriv_rho], bo, &
1617 norm_drho, gradient_cut, rweight, rho1, v_drho%array)
1618 CALL update_deriv_rho(deriv_set1, [deriv_norm_drho], bo, &
1619 norm_drho, gradient_cut, rweight, dr1dr, v_drho%array)
1620
1621 IF (tau_f) THEN
1622 CALL update_deriv_rho(deriv_set1, [deriv_tau], bo, &
1623 norm_drho, gradient_cut, rweight, tau1, v_drho%array)
1624 END IF
1625 IF (laplace_f) THEN
1626 CALL update_deriv_rho(deriv_set1, [deriv_laplace_rho], bo, &
1627 norm_drho, gradient_cut, rweight, laplace1, v_drho%array)
1628
1629 CALL get_derivs_rho(laplace2, laplace, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1630
1631 ! Obtain the numerical 2nd derivatives w.r.t. to drho and collect the potential
1632 CALL update_deriv(deriv_set1, laplace, rho_cutoff, [deriv_rho], bo, &
1633 rweight, rho1, v_laplace%array)
1634 CALL update_deriv(deriv_set1, laplace, rho_cutoff, [deriv_norm_drho], bo, &
1635 rweight, dr1dr, v_laplace%array)
1636
1637 IF (tau_f) THEN
1638 CALL update_deriv(deriv_set1, laplace, rho_cutoff, [deriv_tau], bo, &
1639 rweight, tau1, v_laplace%array)
1640 END IF
1641
1642 CALL update_deriv(deriv_set1, laplace, rho_cutoff, [deriv_laplace_rho], bo, &
1643 rweight, laplace1, v_laplace%array)
1644 END IF
1645 END DO
1646
1647 ! Calculate the virial contribution from the potential
1648 CALL virial_drho_drho(virial_pw, drho, v_drho, virial_xc)
1649
1650 CALL deallocate_pw(v_drho, pw_pool)
1651
1652 IF (laplace_f) THEN
1653 virial_pw%array(:, :, :) = -rho(:, :, :)
1654 CALL virial_laplace(virial_pw, pw_pool, virial_xc, v_laplace%array)
1655 CALL deallocate_pw(v_laplace, pw_pool)
1656 END IF
1657
1658 CALL deallocate_pw(virial_pw, pw_pool)
1659 END IF
1660
1661 END IF
1662
1663 CALL xc_dset_release(deriv_set1)
1664
1665 DEALLOCATE (dr1dr)
1666
1667 CALL xc_rho_set_release(rho1_set)
1668 CALL xc_rho_set_release(rho2_set)
1669 END IF
1670
1671 DO ispin = 1, SIZE(rho_r)
1672 CALL pw_pool%give_back_pw(rho_r(ispin))
1673 END DO
1674 DEALLOCATE (rho_r)
1675
1676 IF (ASSOCIATED(tau_r)) THEN
1677 DO ispin = 1, SIZE(tau_r)
1678 CALL pw_pool%give_back_pw(tau_r(ispin))
1679 END DO
1680 DEALLOCATE (tau_r)
1681 END IF
1682
1683 CALL timestop(handle)
1684
1685 END SUBROUTINE xc_calc_2nd_deriv_numerical
1686
1687! **************************************************************************************************
1688!> \brief ...
1689!> \param rho_r ...
1690!> \param rho_g ...
1691!> \param rho1_r ...
1692!> \param rhoa ...
1693!> \param rhob ...
1694!> \param vxc_rho ...
1695!> \param tau_r ...
1696!> \param tau1_r ...
1697!> \param tau_a ...
1698!> \param tau_b ...
1699!> \param vxc_tau ...
1700!> \param xc_section ...
1701!> \param pw_pool ...
1702!> \param step ...
1703! **************************************************************************************************
1704 SUBROUTINE calc_resp_potential_numer_ab(rho_r, rho_g, rho1_r, rhoa, rhob, vxc_rho, &
1705 tau_r, tau1_r, tau_a, tau_b, vxc_tau, &
1706 xc_section, weights, pw_pool, step)
1707
1708 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER, INTENT(IN) :: vxc_rho, vxc_tau
1709 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(IN) :: rho1_r
1710 TYPE(pw_r3d_rs_type), DIMENSION(:), INTENT(IN), POINTER :: tau1_r
1711 TYPE(pw_r3d_rs_type), INTENT(IN), POINTER :: weights
1712 TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool
1713 TYPE(section_vals_type), INTENT(IN), POINTER :: xc_section
1714 REAL(kind=dp), INTENT(IN) :: step
1715 REAL(kind=dp), DIMENSION(:, :, :), POINTER, INTENT(IN) :: rhoa, rhob, tau_a, tau_b
1716 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER, INTENT(IN) :: rho_r
1717 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
1718 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: tau_r
1719
1720 CHARACTER(len=*), PARAMETER :: routinen = 'calc_resp_potential_numer_ab'
1721
1722 INTEGER :: handle
1723 REAL(kind=dp) :: exc
1724 REAL(kind=dp), DIMENSION(3, 3) :: virial_dummy
1725
1726 CALL timeset(routinen, handle)
1727
1728!$OMP PARALLEL DEFAULT(NONE) SHARED(rho_r,rhoa,rhob,step,rho1_r,tau_r,tau_a,tau_b,tau1_r)
1729!$OMP WORKSHARE
1730 rho_r(1)%array(:, :, :) = rhoa(:, :, :) + step*rho1_r(1)%array(:, :, :)
1731!$OMP END WORKSHARE NOWAIT
1732!$OMP WORKSHARE
1733 rho_r(2)%array(:, :, :) = rhob(:, :, :) + step*rho1_r(2)%array(:, :, :)
1734!$OMP END WORKSHARE NOWAIT
1735 IF (ASSOCIATED(tau1_r) .AND. ASSOCIATED(tau_r) .AND. ASSOCIATED(tau_a) .AND. ASSOCIATED(tau_b)) THEN
1736!$OMP WORKSHARE
1737 tau_r(1)%array(:, :, :) = tau_a(:, :, :) + step*tau1_r(1)%array(:, :, :)
1738!$OMP END WORKSHARE NOWAIT
1739!$OMP WORKSHARE
1740 tau_r(2)%array(:, :, :) = tau_b(:, :, :) + step*tau1_r(2)%array(:, :, :)
1741!$OMP END WORKSHARE NOWAIT
1742 END IF
1743!$OMP END PARALLEL
1744 CALL xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau_r, xc_section, &
1745 weights, pw_pool, .false., virial_dummy)
1746
1747 CALL timestop(handle)
1748
1749 END SUBROUTINE calc_resp_potential_numer_ab
1750
1751! **************************************************************************************************
1752!> \brief calculates stress tensor and potential contributions from the first derivative
1753!> \param deriv_set ...
1754!> \param description ...
1755!> \param virial_pw ...
1756!> \param drho ...
1757!> \param drho1 ...
1758!> \param virial_xc ...
1759!> \param norm_drho ...
1760!> \param gradient_cut ...
1761!> \param dr1dr ...
1762!> \param v_drho ...
1763! **************************************************************************************************
1764 SUBROUTINE apply_drho(deriv_set, description, virial_pw, drho, drho1, &
1765 virial_xc, norm_drho, gradient_cut, dr1dr, v_drho)
1766
1767 TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
1768 INTEGER, DIMENSION(:), INTENT(in) :: description
1769 TYPE(pw_r3d_rs_type), INTENT(IN) :: virial_pw
1770 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drho, drho1
1771 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT) :: virial_xc
1772 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: norm_drho
1773 REAL(kind=dp), INTENT(IN) :: gradient_cut
1774 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: dr1dr
1775 REAL(kind=dp), DIMENSION(:, :, :), INTENT(INOUT) :: v_drho
1776
1777 CHARACTER(len=*), PARAMETER :: routinen = 'apply_drho'
1778
1779 INTEGER :: handle
1780 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data
1781 TYPE(xc_derivative_type), POINTER :: deriv_att
1782
1783 CALL timeset(routinen, handle)
1784
1785 deriv_att => xc_dset_get_derivative(deriv_set, description)
1786 IF (ASSOCIATED(deriv_att)) THEN
1787 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
1788 CALL virial_drho_drho1(virial_pw, drho, drho1, deriv_data, virial_xc)
1789
1790!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dr1dr,gradient_cut,norm_drho,v_drho,deriv_data)
1791 v_drho(:, :, :) = v_drho(:, :, :) + &
1792 deriv_data(:, :, :)*dr1dr(:, :, :)/max(gradient_cut, norm_drho(:, :, :))**2
1793!$OMP END PARALLEL WORKSHARE
1794 END IF
1795
1796 CALL timestop(handle)
1797
1798 END SUBROUTINE apply_drho
1799
1800! **************************************************************************************************
1801!> \brief adds potential contributions from derivatives of rho or diagonal terms of norm_drho
1802!> \param deriv_set1 ...
1803!> \param description ...
1804!> \param bo ...
1805!> \param norm_drho norm_drho of which derivative is calculated
1806!> \param gradient_cut ...
1807!> \param h ...
1808!> \param rho1 function to contract the derivative with (rho1 for rho, dr1dr for norm_drho)
1809!> \param v_drho ...
1810! **************************************************************************************************
1811 SUBROUTINE update_deriv_rho(deriv_set1, description, bo, norm_drho, gradient_cut, weight, rho1, v_drho)
1812
1813 TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set1
1814 INTEGER, DIMENSION(:), INTENT(in) :: description
1815 INTEGER, DIMENSION(2, 3), INTENT(IN) :: bo
1816 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
1817 REAL(kind=dp), INTENT(IN) :: gradient_cut, weight
1818 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
1819 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
1820
1821 CHARACTER(len=*), PARAMETER :: routinen = 'update_deriv_rho'
1822
1823 INTEGER :: handle, i, j, k
1824 REAL(kind=dp) :: de
1825 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data1
1826 TYPE(xc_derivative_type), POINTER :: deriv_att1
1827
1828 CALL timeset(routinen, handle)
1829
1830 ! Obtain the numerical 2nd derivatives w.r.t. to drho and collect the potential
1831 deriv_att1 => xc_dset_get_derivative(deriv_set1, description)
1832 IF (ASSOCIATED(deriv_att1)) THEN
1833 CALL xc_derivative_get(deriv_att1, deriv_data=deriv_data1)
1834!$OMP PARALLEL DO DEFAULT(NONE) &
1835!$OMP SHARED(bo,deriv_data1,weight,norm_drho,v_drho,rho1,gradient_cut) &
1836!$OMP PRIVATE(i,j,k,de) &
1837!$OMP COLLAPSE(3)
1838 DO k = bo(1, 3), bo(2, 3)
1839 DO j = bo(1, 2), bo(2, 2)
1840 DO i = bo(1, 1), bo(2, 1)
1841 de = weight*deriv_data1(i, j, k)/max(gradient_cut, norm_drho(i, j, k))**2
1842 v_drho(i, j, k) = v_drho(i, j, k) - de*rho1(i, j, k)
1843 END DO
1844 END DO
1845 END DO
1846!$OMP END PARALLEL DO
1847 END IF
1848
1849 CALL timestop(handle)
1850
1851 END SUBROUTINE update_deriv_rho
1852
1853! **************************************************************************************************
1854!> \brief adds potential contributions from derivatives of a component with positive and negative values
1855!> \param deriv_set1 ...
1856!> \param description ...
1857!> \param bo ...
1858!> \param h ...
1859!> \param rho1 function to contract the derivative with (rho1 for rho, dr1dr for norm_drho)
1860!> \param v ...
1861! **************************************************************************************************
1862 SUBROUTINE update_deriv(deriv_set1, rho, rho_cutoff, description, bo, weight, rho1, v)
1863
1864 TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set1
1865 INTEGER, DIMENSION(:), INTENT(in) :: description
1866 INTEGER, DIMENSION(2, 3), INTENT(IN) :: bo
1867 REAL(kind=dp), INTENT(IN) :: weight, rho_cutoff
1868 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
1869 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
1870
1871 CHARACTER(len=*), PARAMETER :: routinen = 'update_deriv'
1872
1873 INTEGER :: handle, i, j, k
1874 REAL(kind=dp) :: de
1875 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data1
1876 TYPE(xc_derivative_type), POINTER :: deriv_att1
1877
1878 CALL timeset(routinen, handle)
1879
1880 ! Obtain the numerical 2nd derivatives w.r.t. to drho and collect the potential
1881 deriv_att1 => xc_dset_get_derivative(deriv_set1, description)
1882 IF (ASSOCIATED(deriv_att1)) THEN
1883 CALL xc_derivative_get(deriv_att1, deriv_data=deriv_data1)
1884!$OMP PARALLEL DO DEFAULT(NONE) &
1885!$OMP SHARED(bo,deriv_data1,weight,v,rho1,rho, rho_cutoff) &
1886!$OMP PRIVATE(i,j,k,de) &
1887!$OMP COLLAPSE(3)
1888 DO k = bo(1, 3), bo(2, 3)
1889 DO j = bo(1, 2), bo(2, 2)
1890 DO i = bo(1, 1), bo(2, 1)
1891 ! We have to consider that the given density (mostly the Laplacian) may have positive and negative values
1892 de = weight*deriv_data1(i, j, k)/sign(max(abs(rho(i, j, k)), rho_cutoff), rho(i, j, k))
1893 v(i, j, k) = v(i, j, k) + de*rho1(i, j, k)
1894 END DO
1895 END DO
1896 END DO
1897!$OMP END PARALLEL DO
1898 END IF
1899
1900 CALL timestop(handle)
1901
1902 END SUBROUTINE update_deriv
1903
1904! **************************************************************************************************
1905!> \brief adds mixed derivatives of norm_drho
1906!> \param deriv_set1 ...
1907!> \param description ...
1908!> \param bo ...
1909!> \param norm_drhoa norm_drho of which derivatives is calculated
1910!> \param gradient_cut ...
1911!> \param h ...
1912!> \param dra1dra dr1dr corresponding to norm_drho
1913!> \param drb1drb ...
1914!> \param v_drhoa potential corresponding to norm_drho
1915!> \param v_drhob ...
1916! **************************************************************************************************
1917 SUBROUTINE update_deriv_drho_ab(deriv_set1, description, bo, &
1918 norm_drhoa, gradient_cut, weight, dra1dra, drb1drb, v_drhoa, v_drhob)
1919
1920 TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set1
1921 INTEGER, DIMENSION(:), INTENT(in) :: description
1922 INTEGER, DIMENSION(2, 3), INTENT(IN) :: bo
1923 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
1924 REAL(kind=dp), INTENT(IN) :: gradient_cut, weight
1925 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
1926 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
1927
1928 CHARACTER(len=*), PARAMETER :: routinen = 'update_deriv_drho_ab'
1929
1930 INTEGER :: handle, i, j, k
1931 REAL(kind=dp) :: de
1932 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data1
1933 TYPE(xc_derivative_type), POINTER :: deriv_att1
1934
1935 CALL timeset(routinen, handle)
1936
1937 deriv_att1 => xc_dset_get_derivative(deriv_set1, description)
1938 IF (ASSOCIATED(deriv_att1)) THEN
1939 CALL xc_derivative_get(deriv_att1, deriv_data=deriv_data1)
1940!$OMP PARALLEL DO DEFAULT(NONE) &
1941!$OMP PRIVATE(k,j,i,de) &
1942!$OMP SHARED(bo,drb1drb,dra1dra,deriv_data1,weight,gradient_cut,norm_drhoa,v_drhoa,v_drhob) &
1943!$OMP COLLAPSE(3)
1944 DO k = bo(1, 3), bo(2, 3)
1945 DO j = bo(1, 2), bo(2, 2)
1946 DO i = bo(1, 1), bo(2, 1)
1947 ! We introduce a factor of two because we will average between both numerical derivatives
1948 de = 0.5_dp*weight*deriv_data1(i, j, k)/max(gradient_cut, norm_drhoa(i, j, k))**2
1949 v_drhoa(i, j, k) = v_drhoa(i, j, k) - de*drb1drb(i, j, k)
1950 v_drhob(i, j, k) = v_drhob(i, j, k) - de*dra1dra(i, j, k)
1951 END DO
1952 END DO
1953 END DO
1954!$OMP END PARALLEL DO
1955 END IF
1956
1957 CALL timestop(handle)
1958
1959 END SUBROUTINE update_deriv_drho_ab
1960
1961! **************************************************************************************************
1962!> \brief calculate derivative sets for helper points
1963!> \param norm_drho2 norm_drho of new points
1964!> \param norm_drho norm_drho of KS density
1965!> \param h ...
1966!> \param xc_fun_section ...
1967!> \param lsd ...
1968!> \param rho2_set rho_set for new points
1969!> \param deriv_set1 will contain derivatives of the perturbed density
1970! **************************************************************************************************
1971 SUBROUTINE get_derivs_rho(norm_drho2, norm_drho, step, xc_fun_section, lsd, rho2_set, deriv_set1)
1972 REAL(kind=dp), DIMENSION(:, :, :), INTENT(OUT) :: norm_drho2
1973 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: norm_drho
1974 REAL(kind=dp), INTENT(IN) :: step
1975 TYPE(section_vals_type), INTENT(IN), POINTER :: xc_fun_section
1976 LOGICAL, INTENT(IN) :: lsd
1977 TYPE(xc_rho_set_type), INTENT(INOUT) :: rho2_set
1978 TYPE(xc_derivative_set_type) :: deriv_set1
1979
1980 CHARACTER(len=*), PARAMETER :: routinen = 'get_derivs_rho'
1981
1982 INTEGER :: handle
1983
1984 CALL timeset(routinen, handle)
1985
1986 ! Copy the densities, do one step into the direction of drho
1987!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(norm_drho,norm_drho2,step)
1988 norm_drho2 = norm_drho*(1.0_dp + step)
1989!$OMP END PARALLEL WORKSHARE
1990
1991 CALL xc_dset_zero_all(deriv_set1)
1992
1993 ! Calculate the derivatives of the functional
1994 CALL xc_functionals_eval(xc_fun_section, &
1995 lsd=lsd, &
1996 rho_set=rho2_set, &
1997 deriv_set=deriv_set1, &
1998 deriv_order=1)
1999
2000 ! Return to the original values
2001!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(norm_drho,norm_drho2)
2002 norm_drho2 = norm_drho
2003!$OMP END PARALLEL WORKSHARE
2004
2005 CALL divide_by_norm_drho(deriv_set1, rho2_set, lsd)
2006
2007 CALL timestop(handle)
2008
2009 END SUBROUTINE get_derivs_rho
2010
2011! **************************************************************************************************
2012!> \brief Calculates the second derivative of E_xc at rho in the direction
2013!> rho1 (if you see the second derivative as bilinear form)
2014!> partial_rho|_(rho=rho) partial_rho|_(rho=rho) E_xc drho(rho1)drho
2015!> The other direction is still undetermined, thus it returns
2016!> a potential (partial integration is performed to reduce it to
2017!> function of rho, removing the dependence from its partial derivs)
2018!> Has to be called after the setup by xc_prep_2nd_deriv.
2019!> \param v_xc exchange-correlation potential
2020!> \param v_xc_tau ...
2021!> \param deriv_set derivatives of the exchange-correlation potential
2022!> \param rho_set object containing the density at which the derivatives were calculated
2023!> \param rho1_set object containing the density with which to fold
2024!> \param pw_pool the pool for the grids
2025!> \param xc_section XC parameters
2026!> \param gapw Gaussian and augmented plane waves calculation
2027!> \param vxg ...
2028!> \param tddfpt_fac factor that multiplies the crossterms (tddfpt triplets
2029!> on a closed shell system it should be -1, defaults to 1)
2030!> \param compute_virial ...
2031!> \param virial_xc ...
2032!> \note
2033!> The old version of this routine was smarter: it handled split_desc(1)
2034!> and split_desc(2) separately, thus the code automatically handled all
2035!> possible cross terms (you only had to check if it was diagonal to avoid
2036!> double counting). I think that is the way to go if you want to add more
2037!> terms (tau,rho in LSD,...). The problem with the old code was that it
2038!> because of the old functional structure it sometime guessed wrongly
2039!> which derivative was where. There were probably still bugs with gradient
2040!> corrected functionals (never tested), and it didn't contain first
2041!> derivatives with respect to drho (that contribute also to the second
2042!> derivative wrt. rho).
2043!> The code was a little complex because it really tried to handle any
2044!> functional derivative in the most efficient way with the given contents of
2045!> rho_set.
2046!> Anyway I strongly encourage whoever wants to modify this code to give a
2047!> look to the old version. [fawzi]
2048! **************************************************************************************************
2049 SUBROUTINE xc_calc_2nd_deriv_analytical(v_xc, v_xc_tau, deriv_set, rho_set, rho1_set, &
2050 pw_pool, xc_section, gapw, vxg, tddfpt_fac, &
2051 compute_virial, virial_xc, spinflip)
2052
2053 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_xc, v_xc_tau
2054 TYPE(xc_derivative_set_type) :: deriv_set
2055 TYPE(xc_rho_set_type), INTENT(IN) :: rho_set, rho1_set
2056 TYPE(pw_pool_type), POINTER :: pw_pool
2057 TYPE(section_vals_type), POINTER :: xc_section
2058 LOGICAL, INTENT(IN), OPTIONAL :: gapw
2059 REAL(kind=dp), DIMENSION(:, :, :, :), OPTIONAL, &
2060 POINTER :: vxg
2061 REAL(kind=dp), INTENT(in), OPTIONAL :: tddfpt_fac
2062 LOGICAL, INTENT(IN), OPTIONAL :: compute_virial
2063 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT), &
2064 OPTIONAL :: virial_xc
2065 LOGICAL, INTENT(in), OPTIONAL :: spinflip
2066
2067 CHARACTER(len=*), PARAMETER :: routinen = 'xc_calc_2nd_deriv_analytical'
2068
2069 INTEGER :: handle, i, ia, idir, ir, ispin, j, jdir, &
2070 k, nspins, xc_deriv_method_id
2071 INTEGER, DIMENSION(2, 3) :: bo
2072 LOGICAL :: gradient_f, lsd, my_compute_virial, alda0, &
2073 my_gapw, tau_f, laplace_f, rho_f, do_spinflip
2074 REAL(kind=dp) :: fac, gradient_cut, tmp, factor2, s, s_thresh
2075 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: dr1dr, dra1dra, drb1drb
2076 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data, deriv_data2, &
2077 e_drhoa, e_drhob, e_drho, norm_drho, norm_drhoa, &
2078 norm_drhob, rho1, rho1a, rho1b, &
2079 tau1, tau1a, tau1b, laplace1, laplace1a, laplace1b, &
2080 rho, rhoa, rhob
2081 TYPE(cp_3d_r_cp_type), DIMENSION(3) :: drho, drho1, drho1a, drho1b, drhoa, drhob
2082 TYPE(pw_r3d_rs_type), DIMENSION(:), ALLOCATABLE :: v_drhoa, v_drhob, v_drho, v_laplace
2083 TYPE(pw_r3d_rs_type), DIMENSION(:, :), ALLOCATABLE :: v_drho_r
2084 TYPE(pw_r3d_rs_type) :: virial_pw
2085 TYPE(pw_c1d_gs_type) :: tmp_g, vxc_g
2086 TYPE(xc_derivative_type), POINTER :: deriv_att
2087
2088 CALL timeset(routinen, handle)
2089
2090 NULLIFY (e_drhoa, e_drhob, e_drho)
2091
2092 my_gapw = .false.
2093 IF (PRESENT(gapw)) my_gapw = gapw
2094
2095 my_compute_virial = .false.
2096 IF (PRESENT(compute_virial)) my_compute_virial = compute_virial
2097
2098 cpassert(ASSOCIATED(v_xc))
2099 cpassert(ASSOCIATED(xc_section))
2100 IF (my_gapw) THEN
2101 cpassert(PRESENT(vxg))
2102 END IF
2103 IF (my_compute_virial) THEN
2104 cpassert(PRESENT(virial_xc))
2105 END IF
2106
2107 CALL section_vals_val_get(xc_section, "XC_GRID%XC_DERIV", &
2108 i_val=xc_deriv_method_id)
2109 CALL xc_rho_set_get(rho_set, drho_cutoff=gradient_cut)
2110 nspins = SIZE(v_xc)
2111 lsd = ASSOCIATED(rho_set%rhoa)
2112 fac = 0.0_dp
2113 factor2 = 1.0_dp
2114 IF (PRESENT(tddfpt_fac)) fac = tddfpt_fac
2115 IF (PRESENT(tddfpt_fac)) factor2 = tddfpt_fac
2116 do_spinflip = .false.
2117 IF (PRESENT(spinflip)) do_spinflip = spinflip
2118
2119 bo = rho_set%local_bounds
2120
2121 CALL check_for_derivatives(deriv_set, lsd, rho_f, gradient_f, tau_f, laplace_f)
2122
2123 alda0 = .false.
2124 IF (gradient_f) THEN
2125 s_thresh = 1.0e-04_dp
2126 ELSE
2127 s_thresh = 1.0e-10_dp
2128 END IF
2129
2130 IF (tau_f) THEN
2131 cpassert(ASSOCIATED(v_xc_tau))
2132 END IF
2133
2134 IF (gradient_f) THEN
2135 ALLOCATE (v_drho_r(3, nspins), v_drho(nspins))
2136 DO ispin = 1, nspins
2137 DO idir = 1, 3
2138 CALL allocate_pw(v_drho_r(idir, ispin), pw_pool, bo)
2139 END DO
2140 CALL allocate_pw(v_drho(ispin), pw_pool, bo)
2141 END DO
2142
2143 IF (xc_requires_tmp_g(xc_deriv_method_id) .AND. .NOT. my_gapw) THEN
2144 IF (ASSOCIATED(pw_pool)) THEN
2145 CALL pw_pool%create_pw(tmp_g)
2146 CALL pw_pool%create_pw(vxc_g)
2147 ELSE
2148 ! remember to refix for gapw
2149 cpabort("XC_DERIV method is not implemented in GAPW")
2150 END IF
2151 END IF
2152 END IF
2153
2154 DO ispin = 1, nspins
2155 v_xc(ispin)%array = 0.0_dp
2156 END DO
2157
2158 IF (tau_f) THEN
2159 DO ispin = 1, nspins
2160 v_xc_tau(ispin)%array = 0.0_dp
2161 END DO
2162 END IF
2163
2164 IF (laplace_f .AND. my_gapw) THEN
2165 cpabort("Laplace-dependent functional not implemented with GAPW!")
2166 END IF
2167
2168 IF (my_compute_virial .AND. (gradient_f .OR. laplace_f)) CALL allocate_pw(virial_pw, pw_pool, bo)
2169
2170 IF (lsd) THEN
2171
2172 !-------------------!
2173 ! UNrestricted case !
2174 !-------------------!
2175
2176 IF (do_spinflip) THEN
2177 CALL xc_rho_set_get(rho1_set, rhoa=rho1a)
2178 CALL xc_rho_set_get(rho_set, rhoa=rhoa, rhob=rhob)
2179 ELSE
2180 CALL xc_rho_set_get(rho1_set, rhoa=rho1a, rhob=rho1b)
2181 END IF
2182
2183 IF (gradient_f) THEN
2184 CALL xc_rho_set_get(rho_set, drhoa=drhoa, drhob=drhob, &
2185 norm_drho=norm_drho, norm_drhoa=norm_drhoa, norm_drhob=norm_drhob)
2186 IF (do_spinflip) THEN
2187 CALL xc_rho_set_get(rho1_set, drhoa=drho1a)
2188 CALL calc_drho_from_a(drho1, drho1a)
2189 ELSE
2190 CALL xc_rho_set_get(rho1_set, drhoa=drho1a, drhob=drho1b)
2191 CALL calc_drho_from_ab(drho1, drho1a, drho1b)
2192 END IF
2193
2194 CALL calc_drho_from_ab(drho, drhoa, drhob)
2195
2196 CALL prepare_dr1dr(dra1dra, drhoa, drho1a)
2197 IF (do_spinflip) THEN
2198 CALL prepare_dr1dr(drb1drb, drhob, drho1a)
2199 CALL prepare_dr1dr(dr1dr, drho, drho1a)
2200 ELSE IF (nspins /= 1) THEN
2201 CALL prepare_dr1dr(drb1drb, drhob, drho1b)
2202 CALL prepare_dr1dr(dr1dr, drho, drho1)
2203 ELSE
2204 CALL prepare_dr1dr(drb1drb, drhob, drho1b)
2205 CALL prepare_dr1dr_ab(dr1dr, drhoa, drhob, drho1a, drho1b, fac)
2206 END IF
2207
2208 ALLOCATE (v_drhoa(nspins), v_drhob(nspins))
2209 DO ispin = 1, nspins
2210 CALL allocate_pw(v_drhoa(ispin), pw_pool, bo)
2211 CALL allocate_pw(v_drhob(ispin), pw_pool, bo)
2212 END DO
2213
2214 END IF
2215
2216 IF (laplace_f) THEN
2217 CALL xc_rho_set_get(rho1_set, laplace_rhoa=laplace1a, laplace_rhob=laplace1b)
2218
2219 ALLOCATE (v_laplace(nspins))
2220 DO ispin = 1, nspins
2221 CALL allocate_pw(v_laplace(ispin), pw_pool, bo)
2222 END DO
2223
2224 IF (my_compute_virial) CALL xc_rho_set_get(rho_set, rhoa=rhoa, rhob=rhob)
2225 END IF
2226
2227 IF (tau_f) THEN
2228 CALL xc_rho_set_get(rho1_set, tau_a=tau1a, tau_b=tau1b)
2229 END IF
2230
2231 IF (do_spinflip) THEN
2232
2233 ! vxc contributions
2234 ! vxc = (vxc^{\alpha}-vxc^{\beta})*rho1/(rhoa-rhob)
2235 ! Alpha LDA contribution
2236 ! | d e_xc d e_xc | rho1a
2237 ! vxca = |-------- - --------|*-------------
2238 ! | drhoa drhob | |rhoa - rhob|
2239 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa])
2240 IF (ASSOCIATED(deriv_att)) THEN
2241 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2242 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob])
2243 IF (ASSOCIATED(deriv_att)) THEN
2244 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
2245!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
2246!$OMP SHARED(bo,v_xc,deriv_data,deriv_data2,rho1a,rhoa,rhob,S_THRESH) COLLAPSE(3)
2247 DO k = bo(1, 3), bo(2, 3)
2248 DO j = bo(1, 2), bo(2, 2)
2249 DO i = bo(1, 1), bo(2, 1)
2250 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
2251 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2252 (deriv_data(i, j, k) - deriv_data2(i, j, k))*rho1a(i, j, k)/s
2253 END DO
2254 END DO
2255 END DO
2256!$OMP END PARALLEL DO
2257 END IF
2258 END IF
2259 ! GGA contributions to the spin-flip xcKernel
2260 ! GGA contribution
2261 ! | d e_xc d e_xc | 1
2262 ! vxca += |----------* dra1dra - ----------*drb1drb|*-------------
2263 ! | d|drhoa| d|drhob| | |rhoa - rhob|
2264 IF (.NOT. alda0) THEN
2265 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa])
2266 IF (ASSOCIATED(deriv_att)) THEN
2267 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2268 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob])
2269 IF (ASSOCIATED(deriv_att)) THEN
2270 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
2271!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
2272!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,v_xc,rhoa,rhob,S_THRESH) COLLAPSE(3)
2273 DO k = bo(1, 3), bo(2, 3)
2274 DO j = bo(1, 2), bo(2, 2)
2275 DO i = bo(1, 1), bo(2, 1)
2276 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
2277 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2278 (deriv_data(i, j, k)*dra1dra(i, j, k) - &
2279 deriv_data2(i, j, k)*drb1drb(i, j, k))/s
2280 END DO
2281 END DO
2282 END DO
2283!$OMP END PARALLEL DO
2284 END IF
2285 END IF
2286 END IF
2287
2288 ELSE IF (nspins /= 1) THEN
2289
2290 ! Compute \sum_{\tau}fxc^{\sigma\tau}*\rho^{\tau}(1) over the grid points
2291 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_rhoa])
2292 IF (ASSOCIATED(deriv_att)) THEN
2293 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2294!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2295!$OMP SHARED(bo,v_xc,deriv_data,rho1a,fac) COLLAPSE(3)
2296 DO k = bo(1, 3), bo(2, 3)
2297 DO j = bo(1, 2), bo(2, 2)
2298 DO i = bo(1, 1), bo(2, 1)
2299 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2300 deriv_data(i, j, k)*rho1a(i, j, k)
2301 END DO
2302 END DO
2303 END DO
2304 END IF
2305 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_rhob])
2306 IF (ASSOCIATED(deriv_att)) THEN
2307 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2308!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2309!$OMP SHARED(bo,v_xc,deriv_data,rho1b,fac) COLLAPSE(3)
2310 DO k = bo(1, 3), bo(2, 3)
2311 DO j = bo(1, 2), bo(2, 2)
2312 DO i = bo(1, 1), bo(2, 1)
2313 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2314 deriv_data(i, j, k)*rho1b(i, j, k)
2315 END DO
2316 END DO
2317 END DO
2318 END IF
2319 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drho])
2320 IF (ASSOCIATED(deriv_att)) THEN
2321 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2322!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2323!$OMP SHARED(bo,v_xc,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
2324 DO k = bo(1, 3), bo(2, 3)
2325 DO j = bo(1, 2), bo(2, 2)
2326 DO i = bo(1, 1), bo(2, 1)
2327 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2328 deriv_data(i, j, k)*dr1dr(i, j, k)
2329 END DO
2330 END DO
2331 END DO
2332 END IF
2333 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drhoa])
2334 IF (ASSOCIATED(deriv_att)) THEN
2335 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2336!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2337!$OMP SHARED(bo,v_xc,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
2338 DO k = bo(1, 3), bo(2, 3)
2339 DO j = bo(1, 2), bo(2, 2)
2340 DO i = bo(1, 1), bo(2, 1)
2341 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2342 deriv_data(i, j, k)*dra1dra(i, j, k)
2343 END DO
2344 END DO
2345 END DO
2346 END IF
2347 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drhob])
2348 IF (ASSOCIATED(deriv_att)) THEN
2349 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2350!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2351!$OMP SHARED(bo,v_xc,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
2352 DO k = bo(1, 3), bo(2, 3)
2353 DO j = bo(1, 2), bo(2, 2)
2354 DO i = bo(1, 1), bo(2, 1)
2355 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2356 deriv_data(i, j, k)*drb1drb(i, j, k)
2357 END DO
2358 END DO
2359 END DO
2360 END IF
2361 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_tau_a])
2362 IF (ASSOCIATED(deriv_att)) THEN
2363 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2364!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2365!$OMP SHARED(bo,v_xc,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
2366 DO k = bo(1, 3), bo(2, 3)
2367 DO j = bo(1, 2), bo(2, 2)
2368 DO i = bo(1, 1), bo(2, 1)
2369 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2370 deriv_data(i, j, k)*tau1a(i, j, k)
2371 END DO
2372 END DO
2373 END DO
2374 END IF
2375 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_tau_b])
2376 IF (ASSOCIATED(deriv_att)) THEN
2377 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2378!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2379!$OMP SHARED(bo,v_xc,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
2380 DO k = bo(1, 3), bo(2, 3)
2381 DO j = bo(1, 2), bo(2, 2)
2382 DO i = bo(1, 1), bo(2, 1)
2383 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2384 deriv_data(i, j, k)*tau1b(i, j, k)
2385 END DO
2386 END DO
2387 END DO
2388 END IF
2389 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_laplace_rhoa])
2390 IF (ASSOCIATED(deriv_att)) THEN
2391 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2392!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2393!$OMP SHARED(bo,v_xc,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
2394 DO k = bo(1, 3), bo(2, 3)
2395 DO j = bo(1, 2), bo(2, 2)
2396 DO i = bo(1, 1), bo(2, 1)
2397 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2398 deriv_data(i, j, k)*laplace1a(i, j, k)
2399 END DO
2400 END DO
2401 END DO
2402 END IF
2403 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_laplace_rhob])
2404 IF (ASSOCIATED(deriv_att)) THEN
2405 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2406!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2407!$OMP SHARED(bo,v_xc,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
2408 DO k = bo(1, 3), bo(2, 3)
2409 DO j = bo(1, 2), bo(2, 2)
2410 DO i = bo(1, 1), bo(2, 1)
2411 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
2412 deriv_data(i, j, k)*laplace1b(i, j, k)
2413 END DO
2414 END DO
2415 END DO
2416 END IF
2417
2418
2419 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_rhoa])
2420 IF (ASSOCIATED(deriv_att)) THEN
2421 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2422!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2423!$OMP SHARED(bo,v_xc,deriv_data,rho1a,fac) COLLAPSE(3)
2424 DO k = bo(1, 3), bo(2, 3)
2425 DO j = bo(1, 2), bo(2, 2)
2426 DO i = bo(1, 1), bo(2, 1)
2427 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2428 deriv_data(i, j, k)*rho1a(i, j, k)
2429 END DO
2430 END DO
2431 END DO
2432 END IF
2433 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_rhob])
2434 IF (ASSOCIATED(deriv_att)) THEN
2435 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2436!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2437!$OMP SHARED(bo,v_xc,deriv_data,rho1b,fac) COLLAPSE(3)
2438 DO k = bo(1, 3), bo(2, 3)
2439 DO j = bo(1, 2), bo(2, 2)
2440 DO i = bo(1, 1), bo(2, 1)
2441 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2442 deriv_data(i, j, k)*rho1b(i, j, k)
2443 END DO
2444 END DO
2445 END DO
2446 END IF
2447 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_norm_drho])
2448 IF (ASSOCIATED(deriv_att)) THEN
2449 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2450!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2451!$OMP SHARED(bo,v_xc,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
2452 DO k = bo(1, 3), bo(2, 3)
2453 DO j = bo(1, 2), bo(2, 2)
2454 DO i = bo(1, 1), bo(2, 1)
2455 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2456 deriv_data(i, j, k)*dr1dr(i, j, k)
2457 END DO
2458 END DO
2459 END DO
2460 END IF
2461 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_norm_drhoa])
2462 IF (ASSOCIATED(deriv_att)) THEN
2463 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2464!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2465!$OMP SHARED(bo,v_xc,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
2466 DO k = bo(1, 3), bo(2, 3)
2467 DO j = bo(1, 2), bo(2, 2)
2468 DO i = bo(1, 1), bo(2, 1)
2469 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2470 deriv_data(i, j, k)*dra1dra(i, j, k)
2471 END DO
2472 END DO
2473 END DO
2474 END IF
2475 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_norm_drhob])
2476 IF (ASSOCIATED(deriv_att)) THEN
2477 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2478!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2479!$OMP SHARED(bo,v_xc,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
2480 DO k = bo(1, 3), bo(2, 3)
2481 DO j = bo(1, 2), bo(2, 2)
2482 DO i = bo(1, 1), bo(2, 1)
2483 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2484 deriv_data(i, j, k)*drb1drb(i, j, k)
2485 END DO
2486 END DO
2487 END DO
2488 END IF
2489 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_tau_a])
2490 IF (ASSOCIATED(deriv_att)) THEN
2491 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2492!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2493!$OMP SHARED(bo,v_xc,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
2494 DO k = bo(1, 3), bo(2, 3)
2495 DO j = bo(1, 2), bo(2, 2)
2496 DO i = bo(1, 1), bo(2, 1)
2497 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2498 deriv_data(i, j, k)*tau1a(i, j, k)
2499 END DO
2500 END DO
2501 END DO
2502 END IF
2503 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_tau_b])
2504 IF (ASSOCIATED(deriv_att)) THEN
2505 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2506!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2507!$OMP SHARED(bo,v_xc,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
2508 DO k = bo(1, 3), bo(2, 3)
2509 DO j = bo(1, 2), bo(2, 2)
2510 DO i = bo(1, 1), bo(2, 1)
2511 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2512 deriv_data(i, j, k)*tau1b(i, j, k)
2513 END DO
2514 END DO
2515 END DO
2516 END IF
2517 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_laplace_rhoa])
2518 IF (ASSOCIATED(deriv_att)) THEN
2519 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2520!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2521!$OMP SHARED(bo,v_xc,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
2522 DO k = bo(1, 3), bo(2, 3)
2523 DO j = bo(1, 2), bo(2, 2)
2524 DO i = bo(1, 1), bo(2, 1)
2525 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2526 deriv_data(i, j, k)*laplace1a(i, j, k)
2527 END DO
2528 END DO
2529 END DO
2530 END IF
2531 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_laplace_rhob])
2532 IF (ASSOCIATED(deriv_att)) THEN
2533 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2534!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2535!$OMP SHARED(bo,v_xc,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
2536 DO k = bo(1, 3), bo(2, 3)
2537 DO j = bo(1, 2), bo(2, 2)
2538 DO i = bo(1, 1), bo(2, 1)
2539 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
2540 deriv_data(i, j, k)*laplace1b(i, j, k)
2541 END DO
2542 END DO
2543 END DO
2544 END IF
2545
2546
2547 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rhoa])
2548 IF (ASSOCIATED(deriv_att)) THEN
2549 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2550!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2551!$OMP SHARED(bo,v_drho,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
2552 DO k = bo(1, 3), bo(2, 3)
2553 DO j = bo(1, 2), bo(2, 2)
2554 DO i = bo(1, 1), bo(2, 1)
2555 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2556 deriv_data(i, j, k)*rho1a(i, j, k)
2557 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2558 deriv_data(i, j, k)*rho1a(i, j, k)
2559 END DO
2560 END DO
2561 END DO
2562 END IF
2563 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rhob])
2564 IF (ASSOCIATED(deriv_att)) THEN
2565 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2566!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2567!$OMP SHARED(bo,v_drho,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
2568 DO k = bo(1, 3), bo(2, 3)
2569 DO j = bo(1, 2), bo(2, 2)
2570 DO i = bo(1, 1), bo(2, 1)
2571 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2572 deriv_data(i, j, k)*rho1b(i, j, k)
2573 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2574 deriv_data(i, j, k)*rho1b(i, j, k)
2575 END DO
2576 END DO
2577 END DO
2578 END IF
2579 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drho])
2580 IF (ASSOCIATED(deriv_att)) THEN
2581 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2582!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2583!$OMP SHARED(bo,v_drho,deriv_data,dr1dr,fac) COLLAPSE(3)
2584 DO k = bo(1, 3), bo(2, 3)
2585 DO j = bo(1, 2), bo(2, 2)
2586 DO i = bo(1, 1), bo(2, 1)
2587 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2588 deriv_data(i, j, k)*dr1dr(i, j, k)
2589 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2590 deriv_data(i, j, k)*dr1dr(i, j, k)
2591 END DO
2592 END DO
2593 END DO
2594 END IF
2595 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drhoa])
2596 IF (ASSOCIATED(deriv_att)) THEN
2597 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2598!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2599!$OMP SHARED(bo,v_drho,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
2600 DO k = bo(1, 3), bo(2, 3)
2601 DO j = bo(1, 2), bo(2, 2)
2602 DO i = bo(1, 1), bo(2, 1)
2603 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2604 deriv_data(i, j, k)*dra1dra(i, j, k)
2605 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2606 deriv_data(i, j, k)*dra1dra(i, j, k)
2607 END DO
2608 END DO
2609 END DO
2610 END IF
2611 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drhob])
2612 IF (ASSOCIATED(deriv_att)) THEN
2613 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2614!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2615!$OMP SHARED(bo,v_drho,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
2616 DO k = bo(1, 3), bo(2, 3)
2617 DO j = bo(1, 2), bo(2, 2)
2618 DO i = bo(1, 1), bo(2, 1)
2619 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2620 deriv_data(i, j, k)*drb1drb(i, j, k)
2621 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2622 deriv_data(i, j, k)*drb1drb(i, j, k)
2623 END DO
2624 END DO
2625 END DO
2626 END IF
2627 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_tau_a])
2628 IF (ASSOCIATED(deriv_att)) THEN
2629 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2630!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2631!$OMP SHARED(bo,v_drho,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
2632 DO k = bo(1, 3), bo(2, 3)
2633 DO j = bo(1, 2), bo(2, 2)
2634 DO i = bo(1, 1), bo(2, 1)
2635 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2636 deriv_data(i, j, k)*tau1a(i, j, k)
2637 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2638 deriv_data(i, j, k)*tau1a(i, j, k)
2639 END DO
2640 END DO
2641 END DO
2642 END IF
2643 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_tau_b])
2644 IF (ASSOCIATED(deriv_att)) THEN
2645 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2646!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2647!$OMP SHARED(bo,v_drho,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
2648 DO k = bo(1, 3), bo(2, 3)
2649 DO j = bo(1, 2), bo(2, 2)
2650 DO i = bo(1, 1), bo(2, 1)
2651 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2652 deriv_data(i, j, k)*tau1b(i, j, k)
2653 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2654 deriv_data(i, j, k)*tau1b(i, j, k)
2655 END DO
2656 END DO
2657 END DO
2658 END IF
2660 IF (ASSOCIATED(deriv_att)) THEN
2661 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2662!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2663!$OMP SHARED(bo,v_drho,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
2664 DO k = bo(1, 3), bo(2, 3)
2665 DO j = bo(1, 2), bo(2, 2)
2666 DO i = bo(1, 1), bo(2, 1)
2667 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2668 deriv_data(i, j, k)*laplace1a(i, j, k)
2669 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2670 deriv_data(i, j, k)*laplace1a(i, j, k)
2671 END DO
2672 END DO
2673 END DO
2674 END IF
2676 IF (ASSOCIATED(deriv_att)) THEN
2677 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2678!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2679!$OMP SHARED(bo,v_drho,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
2680 DO k = bo(1, 3), bo(2, 3)
2681 DO j = bo(1, 2), bo(2, 2)
2682 DO i = bo(1, 1), bo(2, 1)
2683 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
2684 deriv_data(i, j, k)*laplace1b(i, j, k)
2685 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
2686 deriv_data(i, j, k)*laplace1b(i, j, k)
2687 END DO
2688 END DO
2689 END DO
2690 END IF
2691
2692 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho])
2693 IF (ASSOCIATED(deriv_att)) THEN
2694 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2695 CALL xc_derivative_get(deriv_att, deriv_data=e_drho)
2696
2697 IF (my_compute_virial) THEN
2698 CALL virial_drho_drho1(virial_pw, drho, drho1, deriv_data, virial_xc)
2699 END IF ! my_compute_virial
2700
2701!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dr1dr,gradient_cut,norm_drho,v_drho,deriv_data)
2702 v_drho(1)%array(:, :, :) = v_drho(1)%array(:, :, :) + &
2703 deriv_data(:, :, :)*dr1dr(:, :, :)/max(gradient_cut, norm_drho(:, :, :))**2
2704 v_drho(2)%array(:, :, :) = v_drho(2)%array(:, :, :) + &
2705 deriv_data(:, :, :)*dr1dr(:, :, :)/max(gradient_cut, norm_drho(:, :, :))**2
2706!$OMP END PARALLEL WORKSHARE
2707 END IF
2708
2709 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_rhoa])
2710 IF (ASSOCIATED(deriv_att)) THEN
2711 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2712!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2713!$OMP SHARED(bo,v_drhoa,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
2714 DO k = bo(1, 3), bo(2, 3)
2715 DO j = bo(1, 2), bo(2, 2)
2716 DO i = bo(1, 1), bo(2, 1)
2717 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2718 deriv_data(i, j, k)*rho1a(i, j, k)
2719 END DO
2720 END DO
2721 END DO
2722 END IF
2723 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_rhob])
2724 IF (ASSOCIATED(deriv_att)) THEN
2725 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2726!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2727!$OMP SHARED(bo,v_drhoa,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
2728 DO k = bo(1, 3), bo(2, 3)
2729 DO j = bo(1, 2), bo(2, 2)
2730 DO i = bo(1, 1), bo(2, 1)
2731 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2732 deriv_data(i, j, k)*rho1b(i, j, k)
2733 END DO
2734 END DO
2735 END DO
2736 END IF
2737 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drho])
2738 IF (ASSOCIATED(deriv_att)) THEN
2739 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2740!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2741!$OMP SHARED(bo,v_drhoa,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
2742 DO k = bo(1, 3), bo(2, 3)
2743 DO j = bo(1, 2), bo(2, 2)
2744 DO i = bo(1, 1), bo(2, 1)
2745 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2746 deriv_data(i, j, k)*dr1dr(i, j, k)
2747 END DO
2748 END DO
2749 END DO
2750 END IF
2751 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drhoa])
2752 IF (ASSOCIATED(deriv_att)) THEN
2753 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2754!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2755!$OMP SHARED(bo,v_drhoa,deriv_data,dra1dra,fac) COLLAPSE(3)
2756 DO k = bo(1, 3), bo(2, 3)
2757 DO j = bo(1, 2), bo(2, 2)
2758 DO i = bo(1, 1), bo(2, 1)
2759 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2760 deriv_data(i, j, k)*dra1dra(i, j, k)
2761 END DO
2762 END DO
2763 END DO
2764 END IF
2765 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drhob])
2766 IF (ASSOCIATED(deriv_att)) THEN
2767 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2768!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2769!$OMP SHARED(bo,v_drhoa,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
2770 DO k = bo(1, 3), bo(2, 3)
2771 DO j = bo(1, 2), bo(2, 2)
2772 DO i = bo(1, 1), bo(2, 1)
2773 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2774 deriv_data(i, j, k)*drb1drb(i, j, k)
2775 END DO
2776 END DO
2777 END DO
2778 END IF
2779 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_tau_a])
2780 IF (ASSOCIATED(deriv_att)) THEN
2781 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2782!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2783!$OMP SHARED(bo,v_drhoa,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
2784 DO k = bo(1, 3), bo(2, 3)
2785 DO j = bo(1, 2), bo(2, 2)
2786 DO i = bo(1, 1), bo(2, 1)
2787 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2788 deriv_data(i, j, k)*tau1a(i, j, k)
2789 END DO
2790 END DO
2791 END DO
2792 END IF
2793 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_tau_b])
2794 IF (ASSOCIATED(deriv_att)) THEN
2795 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2796!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2797!$OMP SHARED(bo,v_drhoa,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
2798 DO k = bo(1, 3), bo(2, 3)
2799 DO j = bo(1, 2), bo(2, 2)
2800 DO i = bo(1, 1), bo(2, 1)
2801 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2802 deriv_data(i, j, k)*tau1b(i, j, k)
2803 END DO
2804 END DO
2805 END DO
2806 END IF
2808 IF (ASSOCIATED(deriv_att)) THEN
2809 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2810!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2811!$OMP SHARED(bo,v_drhoa,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
2812 DO k = bo(1, 3), bo(2, 3)
2813 DO j = bo(1, 2), bo(2, 2)
2814 DO i = bo(1, 1), bo(2, 1)
2815 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2816 deriv_data(i, j, k)*laplace1a(i, j, k)
2817 END DO
2818 END DO
2819 END DO
2820 END IF
2822 IF (ASSOCIATED(deriv_att)) THEN
2823 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2824!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2825!$OMP SHARED(bo,v_drhoa,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
2826 DO k = bo(1, 3), bo(2, 3)
2827 DO j = bo(1, 2), bo(2, 2)
2828 DO i = bo(1, 1), bo(2, 1)
2829 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
2830 deriv_data(i, j, k)*laplace1b(i, j, k)
2831 END DO
2832 END DO
2833 END DO
2834 END IF
2835
2836 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa])
2837 IF (ASSOCIATED(deriv_att)) THEN
2838 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2839 CALL xc_derivative_get(deriv_att, deriv_data=e_drhoa)
2840
2841 IF (my_compute_virial) THEN
2842 CALL virial_drho_drho1(virial_pw, drhoa, drho1a, deriv_data, virial_xc)
2843 END IF ! my_compute_virial
2844
2845!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dra1dra,gradient_cut,norm_drhoa,v_drhoa,deriv_data)
2846 v_drhoa(1)%array(:, :, :) = v_drhoa(1)%array(:, :, :) + &
2847 deriv_data(:, :, :)*dra1dra(:, :, :)/max(gradient_cut, norm_drhoa(:, :, :))**2
2848!$OMP END PARALLEL WORKSHARE
2849 END IF
2850
2851 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_rhoa])
2852 IF (ASSOCIATED(deriv_att)) THEN
2853 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2854!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2855!$OMP SHARED(bo,v_drhob,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
2856 DO k = bo(1, 3), bo(2, 3)
2857 DO j = bo(1, 2), bo(2, 2)
2858 DO i = bo(1, 1), bo(2, 1)
2859 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2860 deriv_data(i, j, k)*rho1a(i, j, k)
2861 END DO
2862 END DO
2863 END DO
2864 END IF
2865 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_rhob])
2866 IF (ASSOCIATED(deriv_att)) THEN
2867 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2868!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2869!$OMP SHARED(bo,v_drhob,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
2870 DO k = bo(1, 3), bo(2, 3)
2871 DO j = bo(1, 2), bo(2, 2)
2872 DO i = bo(1, 1), bo(2, 1)
2873 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2874 deriv_data(i, j, k)*rho1b(i, j, k)
2875 END DO
2876 END DO
2877 END DO
2878 END IF
2879 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_norm_drho])
2880 IF (ASSOCIATED(deriv_att)) THEN
2881 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2882!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2883!$OMP SHARED(bo,v_drhob,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
2884 DO k = bo(1, 3), bo(2, 3)
2885 DO j = bo(1, 2), bo(2, 2)
2886 DO i = bo(1, 1), bo(2, 1)
2887 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2888 deriv_data(i, j, k)*dr1dr(i, j, k)
2889 END DO
2890 END DO
2891 END DO
2892 END IF
2893 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_norm_drhoa])
2894 IF (ASSOCIATED(deriv_att)) THEN
2895 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2896!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2897!$OMP SHARED(bo,v_drhob,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
2898 DO k = bo(1, 3), bo(2, 3)
2899 DO j = bo(1, 2), bo(2, 2)
2900 DO i = bo(1, 1), bo(2, 1)
2901 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2902 deriv_data(i, j, k)*dra1dra(i, j, k)
2903 END DO
2904 END DO
2905 END DO
2906 END IF
2907 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_norm_drhob])
2908 IF (ASSOCIATED(deriv_att)) THEN
2909 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2910!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2911!$OMP SHARED(bo,v_drhob,deriv_data,drb1drb,fac) COLLAPSE(3)
2912 DO k = bo(1, 3), bo(2, 3)
2913 DO j = bo(1, 2), bo(2, 2)
2914 DO i = bo(1, 1), bo(2, 1)
2915 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2916 deriv_data(i, j, k)*drb1drb(i, j, k)
2917 END DO
2918 END DO
2919 END DO
2920 END IF
2921 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_tau_a])
2922 IF (ASSOCIATED(deriv_att)) THEN
2923 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2924!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2925!$OMP SHARED(bo,v_drhob,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
2926 DO k = bo(1, 3), bo(2, 3)
2927 DO j = bo(1, 2), bo(2, 2)
2928 DO i = bo(1, 1), bo(2, 1)
2929 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2930 deriv_data(i, j, k)*tau1a(i, j, k)
2931 END DO
2932 END DO
2933 END DO
2934 END IF
2935 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_tau_b])
2936 IF (ASSOCIATED(deriv_att)) THEN
2937 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2938!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2939!$OMP SHARED(bo,v_drhob,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
2940 DO k = bo(1, 3), bo(2, 3)
2941 DO j = bo(1, 2), bo(2, 2)
2942 DO i = bo(1, 1), bo(2, 1)
2943 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2944 deriv_data(i, j, k)*tau1b(i, j, k)
2945 END DO
2946 END DO
2947 END DO
2948 END IF
2950 IF (ASSOCIATED(deriv_att)) THEN
2951 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2952!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2953!$OMP SHARED(bo,v_drhob,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
2954 DO k = bo(1, 3), bo(2, 3)
2955 DO j = bo(1, 2), bo(2, 2)
2956 DO i = bo(1, 1), bo(2, 1)
2957 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2958 deriv_data(i, j, k)*laplace1a(i, j, k)
2959 END DO
2960 END DO
2961 END DO
2962 END IF
2964 IF (ASSOCIATED(deriv_att)) THEN
2965 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2966!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2967!$OMP SHARED(bo,v_drhob,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
2968 DO k = bo(1, 3), bo(2, 3)
2969 DO j = bo(1, 2), bo(2, 2)
2970 DO i = bo(1, 1), bo(2, 1)
2971 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
2972 deriv_data(i, j, k)*laplace1b(i, j, k)
2973 END DO
2974 END DO
2975 END DO
2976 END IF
2977
2978 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob])
2979 IF (ASSOCIATED(deriv_att)) THEN
2980 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2981 CALL xc_derivative_get(deriv_att, deriv_data=e_drhob)
2982
2983 IF (my_compute_virial) THEN
2984 CALL virial_drho_drho1(virial_pw, drhob, drho1b, deriv_data, virial_xc)
2985 END IF ! my_compute_virial
2986
2987!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drb1drb,gradient_cut,norm_drhob,v_drhob,deriv_data)
2988 v_drhob(2)%array(:, :, :) = v_drhob(2)%array(:, :, :) + &
2989 deriv_data(:, :, :)*drb1drb(:, :, :)/max(gradient_cut, norm_drhob(:, :, :))**2
2990!$OMP END PARALLEL WORKSHARE
2991 END IF
2992
2993 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_rhoa])
2994 IF (ASSOCIATED(deriv_att)) THEN
2995 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
2996!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
2997!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
2998 DO k = bo(1, 3), bo(2, 3)
2999 DO j = bo(1, 2), bo(2, 2)
3000 DO i = bo(1, 1), bo(2, 1)
3001 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3002 deriv_data(i, j, k)*rho1a(i, j, k)
3003 END DO
3004 END DO
3005 END DO
3006 END IF
3007 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_rhob])
3008 IF (ASSOCIATED(deriv_att)) THEN
3009 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3010!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3011!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
3012 DO k = bo(1, 3), bo(2, 3)
3013 DO j = bo(1, 2), bo(2, 2)
3014 DO i = bo(1, 1), bo(2, 1)
3015 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3016 deriv_data(i, j, k)*rho1b(i, j, k)
3017 END DO
3018 END DO
3019 END DO
3020 END IF
3021 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_norm_drho])
3022 IF (ASSOCIATED(deriv_att)) THEN
3023 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3024!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3025!$OMP SHARED(bo,v_xc_tau,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3026 DO k = bo(1, 3), bo(2, 3)
3027 DO j = bo(1, 2), bo(2, 2)
3028 DO i = bo(1, 1), bo(2, 1)
3029 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3030 deriv_data(i, j, k)*dr1dr(i, j, k)
3031 END DO
3032 END DO
3033 END DO
3034 END IF
3035 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_norm_drhoa])
3036 IF (ASSOCIATED(deriv_att)) THEN
3037 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3038!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3039!$OMP SHARED(bo,v_xc_tau,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3040 DO k = bo(1, 3), bo(2, 3)
3041 DO j = bo(1, 2), bo(2, 2)
3042 DO i = bo(1, 1), bo(2, 1)
3043 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3044 deriv_data(i, j, k)*dra1dra(i, j, k)
3045 END DO
3046 END DO
3047 END DO
3048 END IF
3049 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_norm_drhob])
3050 IF (ASSOCIATED(deriv_att)) THEN
3051 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3052!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3053!$OMP SHARED(bo,v_xc_tau,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3054 DO k = bo(1, 3), bo(2, 3)
3055 DO j = bo(1, 2), bo(2, 2)
3056 DO i = bo(1, 1), bo(2, 1)
3057 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3058 deriv_data(i, j, k)*drb1drb(i, j, k)
3059 END DO
3060 END DO
3061 END DO
3062 END IF
3063 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_tau_a])
3064 IF (ASSOCIATED(deriv_att)) THEN
3065 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3066!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3067!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1a,fac) COLLAPSE(3)
3068 DO k = bo(1, 3), bo(2, 3)
3069 DO j = bo(1, 2), bo(2, 2)
3070 DO i = bo(1, 1), bo(2, 1)
3071 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3072 deriv_data(i, j, k)*tau1a(i, j, k)
3073 END DO
3074 END DO
3075 END DO
3076 END IF
3077 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_tau_b])
3078 IF (ASSOCIATED(deriv_att)) THEN
3079 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3080!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3081!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1b,fac) COLLAPSE(3)
3082 DO k = bo(1, 3), bo(2, 3)
3083 DO j = bo(1, 2), bo(2, 2)
3084 DO i = bo(1, 1), bo(2, 1)
3085 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3086 deriv_data(i, j, k)*tau1b(i, j, k)
3087 END DO
3088 END DO
3089 END DO
3090 END IF
3091 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_laplace_rhoa])
3092 IF (ASSOCIATED(deriv_att)) THEN
3093 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3094!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3095!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
3096 DO k = bo(1, 3), bo(2, 3)
3097 DO j = bo(1, 2), bo(2, 2)
3098 DO i = bo(1, 1), bo(2, 1)
3099 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3100 deriv_data(i, j, k)*laplace1a(i, j, k)
3101 END DO
3102 END DO
3103 END DO
3104 END IF
3105 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_laplace_rhob])
3106 IF (ASSOCIATED(deriv_att)) THEN
3107 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3108!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3109!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
3110 DO k = bo(1, 3), bo(2, 3)
3111 DO j = bo(1, 2), bo(2, 2)
3112 DO i = bo(1, 1), bo(2, 1)
3113 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3114 deriv_data(i, j, k)*laplace1b(i, j, k)
3115 END DO
3116 END DO
3117 END DO
3118 END IF
3119
3120
3121 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_rhoa])
3122 IF (ASSOCIATED(deriv_att)) THEN
3123 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3124!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3125!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
3126 DO k = bo(1, 3), bo(2, 3)
3127 DO j = bo(1, 2), bo(2, 2)
3128 DO i = bo(1, 1), bo(2, 1)
3129 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3130 deriv_data(i, j, k)*rho1a(i, j, k)
3131 END DO
3132 END DO
3133 END DO
3134 END IF
3135 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_rhob])
3136 IF (ASSOCIATED(deriv_att)) THEN
3137 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3138!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3139!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
3140 DO k = bo(1, 3), bo(2, 3)
3141 DO j = bo(1, 2), bo(2, 2)
3142 DO i = bo(1, 1), bo(2, 1)
3143 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3144 deriv_data(i, j, k)*rho1b(i, j, k)
3145 END DO
3146 END DO
3147 END DO
3148 END IF
3149 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_norm_drho])
3150 IF (ASSOCIATED(deriv_att)) THEN
3151 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3152!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3153!$OMP SHARED(bo,v_xc_tau,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3154 DO k = bo(1, 3), bo(2, 3)
3155 DO j = bo(1, 2), bo(2, 2)
3156 DO i = bo(1, 1), bo(2, 1)
3157 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3158 deriv_data(i, j, k)*dr1dr(i, j, k)
3159 END DO
3160 END DO
3161 END DO
3162 END IF
3163 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_norm_drhoa])
3164 IF (ASSOCIATED(deriv_att)) THEN
3165 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3166!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3167!$OMP SHARED(bo,v_xc_tau,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3168 DO k = bo(1, 3), bo(2, 3)
3169 DO j = bo(1, 2), bo(2, 2)
3170 DO i = bo(1, 1), bo(2, 1)
3171 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3172 deriv_data(i, j, k)*dra1dra(i, j, k)
3173 END DO
3174 END DO
3175 END DO
3176 END IF
3177 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_norm_drhob])
3178 IF (ASSOCIATED(deriv_att)) THEN
3179 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3180!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3181!$OMP SHARED(bo,v_xc_tau,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3182 DO k = bo(1, 3), bo(2, 3)
3183 DO j = bo(1, 2), bo(2, 2)
3184 DO i = bo(1, 1), bo(2, 1)
3185 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3186 deriv_data(i, j, k)*drb1drb(i, j, k)
3187 END DO
3188 END DO
3189 END DO
3190 END IF
3191 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_tau_a])
3192 IF (ASSOCIATED(deriv_att)) THEN
3193 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3194!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3195!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1a,fac) COLLAPSE(3)
3196 DO k = bo(1, 3), bo(2, 3)
3197 DO j = bo(1, 2), bo(2, 2)
3198 DO i = bo(1, 1), bo(2, 1)
3199 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3200 deriv_data(i, j, k)*tau1a(i, j, k)
3201 END DO
3202 END DO
3203 END DO
3204 END IF
3205 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_tau_b])
3206 IF (ASSOCIATED(deriv_att)) THEN
3207 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3208!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3209!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1b,fac) COLLAPSE(3)
3210 DO k = bo(1, 3), bo(2, 3)
3211 DO j = bo(1, 2), bo(2, 2)
3212 DO i = bo(1, 1), bo(2, 1)
3213 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3214 deriv_data(i, j, k)*tau1b(i, j, k)
3215 END DO
3216 END DO
3217 END DO
3218 END IF
3219 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_laplace_rhoa])
3220 IF (ASSOCIATED(deriv_att)) THEN
3221 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3222!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3223!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
3224 DO k = bo(1, 3), bo(2, 3)
3225 DO j = bo(1, 2), bo(2, 2)
3226 DO i = bo(1, 1), bo(2, 1)
3227 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3228 deriv_data(i, j, k)*laplace1a(i, j, k)
3229 END DO
3230 END DO
3231 END DO
3232 END IF
3233 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_b, deriv_laplace_rhob])
3234 IF (ASSOCIATED(deriv_att)) THEN
3235 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3236!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3237!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
3238 DO k = bo(1, 3), bo(2, 3)
3239 DO j = bo(1, 2), bo(2, 2)
3240 DO i = bo(1, 1), bo(2, 1)
3241 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + &
3242 deriv_data(i, j, k)*laplace1b(i, j, k)
3243 END DO
3244 END DO
3245 END DO
3246 END IF
3247
3248
3249 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_rhoa])
3250 IF (ASSOCIATED(deriv_att)) THEN
3251 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3252!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3253!$OMP SHARED(bo,v_laplace,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
3254 DO k = bo(1, 3), bo(2, 3)
3255 DO j = bo(1, 2), bo(2, 2)
3256 DO i = bo(1, 1), bo(2, 1)
3257 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3258 deriv_data(i, j, k)*rho1a(i, j, k)
3259 END DO
3260 END DO
3261 END DO
3262 END IF
3263 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_rhob])
3264 IF (ASSOCIATED(deriv_att)) THEN
3265 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3266!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3267!$OMP SHARED(bo,v_laplace,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
3268 DO k = bo(1, 3), bo(2, 3)
3269 DO j = bo(1, 2), bo(2, 2)
3270 DO i = bo(1, 1), bo(2, 1)
3271 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3272 deriv_data(i, j, k)*rho1b(i, j, k)
3273 END DO
3274 END DO
3275 END DO
3276 END IF
3278 IF (ASSOCIATED(deriv_att)) THEN
3279 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3280!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3281!$OMP SHARED(bo,v_laplace,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3282 DO k = bo(1, 3), bo(2, 3)
3283 DO j = bo(1, 2), bo(2, 2)
3284 DO i = bo(1, 1), bo(2, 1)
3285 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3286 deriv_data(i, j, k)*dr1dr(i, j, k)
3287 END DO
3288 END DO
3289 END DO
3290 END IF
3292 IF (ASSOCIATED(deriv_att)) THEN
3293 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3294!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3295!$OMP SHARED(bo,v_laplace,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3296 DO k = bo(1, 3), bo(2, 3)
3297 DO j = bo(1, 2), bo(2, 2)
3298 DO i = bo(1, 1), bo(2, 1)
3299 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3300 deriv_data(i, j, k)*dra1dra(i, j, k)
3301 END DO
3302 END DO
3303 END DO
3304 END IF
3306 IF (ASSOCIATED(deriv_att)) THEN
3307 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3308!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3309!$OMP SHARED(bo,v_laplace,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3310 DO k = bo(1, 3), bo(2, 3)
3311 DO j = bo(1, 2), bo(2, 2)
3312 DO i = bo(1, 1), bo(2, 1)
3313 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3314 deriv_data(i, j, k)*drb1drb(i, j, k)
3315 END DO
3316 END DO
3317 END DO
3318 END IF
3319 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_tau_a])
3320 IF (ASSOCIATED(deriv_att)) THEN
3321 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3322!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3323!$OMP SHARED(bo,v_laplace,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
3324 DO k = bo(1, 3), bo(2, 3)
3325 DO j = bo(1, 2), bo(2, 2)
3326 DO i = bo(1, 1), bo(2, 1)
3327 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3328 deriv_data(i, j, k)*tau1a(i, j, k)
3329 END DO
3330 END DO
3331 END DO
3332 END IF
3333 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_tau_b])
3334 IF (ASSOCIATED(deriv_att)) THEN
3335 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3336!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3337!$OMP SHARED(bo,v_laplace,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
3338 DO k = bo(1, 3), bo(2, 3)
3339 DO j = bo(1, 2), bo(2, 2)
3340 DO i = bo(1, 1), bo(2, 1)
3341 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3342 deriv_data(i, j, k)*tau1b(i, j, k)
3343 END DO
3344 END DO
3345 END DO
3346 END IF
3348 IF (ASSOCIATED(deriv_att)) THEN
3349 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3350!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3351!$OMP SHARED(bo,v_laplace,deriv_data,laplace1a,fac) COLLAPSE(3)
3352 DO k = bo(1, 3), bo(2, 3)
3353 DO j = bo(1, 2), bo(2, 2)
3354 DO i = bo(1, 1), bo(2, 1)
3355 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3356 deriv_data(i, j, k)*laplace1a(i, j, k)
3357 END DO
3358 END DO
3359 END DO
3360 END IF
3362 IF (ASSOCIATED(deriv_att)) THEN
3363 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3364!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3365!$OMP SHARED(bo,v_laplace,deriv_data,laplace1b,fac) COLLAPSE(3)
3366 DO k = bo(1, 3), bo(2, 3)
3367 DO j = bo(1, 2), bo(2, 2)
3368 DO i = bo(1, 1), bo(2, 1)
3369 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
3370 deriv_data(i, j, k)*laplace1b(i, j, k)
3371 END DO
3372 END DO
3373 END DO
3374 END IF
3375
3376
3377 IF (my_compute_virial) THEN
3378 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa])
3379 IF (ASSOCIATED(deriv_att)) THEN
3380 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3381
3382 virial_pw%array(:, :, :) = -rho1a(:, :, :)
3383 CALL virial_laplace(virial_pw, pw_pool, virial_xc, deriv_data)
3384 END IF
3385 END IF ! my_compute_virial
3386 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhob, deriv_rhoa])
3387 IF (ASSOCIATED(deriv_att)) THEN
3388 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3389!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3390!$OMP SHARED(bo,v_laplace,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
3391 DO k = bo(1, 3), bo(2, 3)
3392 DO j = bo(1, 2), bo(2, 2)
3393 DO i = bo(1, 1), bo(2, 1)
3394 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3395 deriv_data(i, j, k)*rho1a(i, j, k)
3396 END DO
3397 END DO
3398 END DO
3399 END IF
3400 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhob, deriv_rhob])
3401 IF (ASSOCIATED(deriv_att)) THEN
3402 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3403!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3404!$OMP SHARED(bo,v_laplace,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
3405 DO k = bo(1, 3), bo(2, 3)
3406 DO j = bo(1, 2), bo(2, 2)
3407 DO i = bo(1, 1), bo(2, 1)
3408 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3409 deriv_data(i, j, k)*rho1b(i, j, k)
3410 END DO
3411 END DO
3412 END DO
3413 END IF
3415 IF (ASSOCIATED(deriv_att)) THEN
3416 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3417!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3418!$OMP SHARED(bo,v_laplace,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3419 DO k = bo(1, 3), bo(2, 3)
3420 DO j = bo(1, 2), bo(2, 2)
3421 DO i = bo(1, 1), bo(2, 1)
3422 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3423 deriv_data(i, j, k)*dr1dr(i, j, k)
3424 END DO
3425 END DO
3426 END DO
3427 END IF
3429 IF (ASSOCIATED(deriv_att)) THEN
3430 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3431!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3432!$OMP SHARED(bo,v_laplace,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3433 DO k = bo(1, 3), bo(2, 3)
3434 DO j = bo(1, 2), bo(2, 2)
3435 DO i = bo(1, 1), bo(2, 1)
3436 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3437 deriv_data(i, j, k)*dra1dra(i, j, k)
3438 END DO
3439 END DO
3440 END DO
3441 END IF
3443 IF (ASSOCIATED(deriv_att)) THEN
3444 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3445!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3446!$OMP SHARED(bo,v_laplace,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3447 DO k = bo(1, 3), bo(2, 3)
3448 DO j = bo(1, 2), bo(2, 2)
3449 DO i = bo(1, 1), bo(2, 1)
3450 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3451 deriv_data(i, j, k)*drb1drb(i, j, k)
3452 END DO
3453 END DO
3454 END DO
3455 END IF
3456 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhob, deriv_tau_a])
3457 IF (ASSOCIATED(deriv_att)) THEN
3458 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3459!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3460!$OMP SHARED(bo,v_laplace,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
3461 DO k = bo(1, 3), bo(2, 3)
3462 DO j = bo(1, 2), bo(2, 2)
3463 DO i = bo(1, 1), bo(2, 1)
3464 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3465 deriv_data(i, j, k)*tau1a(i, j, k)
3466 END DO
3467 END DO
3468 END DO
3469 END IF
3470 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhob, deriv_tau_b])
3471 IF (ASSOCIATED(deriv_att)) THEN
3472 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3473!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3474!$OMP SHARED(bo,v_laplace,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
3475 DO k = bo(1, 3), bo(2, 3)
3476 DO j = bo(1, 2), bo(2, 2)
3477 DO i = bo(1, 1), bo(2, 1)
3478 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3479 deriv_data(i, j, k)*tau1b(i, j, k)
3480 END DO
3481 END DO
3482 END DO
3483 END IF
3485 IF (ASSOCIATED(deriv_att)) THEN
3486 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3487!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3488!$OMP SHARED(bo,v_laplace,deriv_data,laplace1a,fac) COLLAPSE(3)
3489 DO k = bo(1, 3), bo(2, 3)
3490 DO j = bo(1, 2), bo(2, 2)
3491 DO i = bo(1, 1), bo(2, 1)
3492 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3493 deriv_data(i, j, k)*laplace1a(i, j, k)
3494 END DO
3495 END DO
3496 END DO
3497 END IF
3499 IF (ASSOCIATED(deriv_att)) THEN
3500 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3501!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3502!$OMP SHARED(bo,v_laplace,deriv_data,laplace1b,fac) COLLAPSE(3)
3503 DO k = bo(1, 3), bo(2, 3)
3504 DO j = bo(1, 2), bo(2, 2)
3505 DO i = bo(1, 1), bo(2, 1)
3506 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
3507 deriv_data(i, j, k)*laplace1b(i, j, k)
3508 END DO
3509 END DO
3510 END DO
3511 END IF
3512
3513
3514 IF (my_compute_virial) THEN
3515 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhob])
3516 IF (ASSOCIATED(deriv_att)) THEN
3517 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3518
3519 virial_pw%array(:, :, :) = -rho1b(:, :, :)
3520 CALL virial_laplace(virial_pw, pw_pool, virial_xc, deriv_data)
3521 END IF
3522 END IF ! my_compute_virial
3523
3524
3525 ELSE
3526
3527 ! Compute (fxc^{\alpha\alpha}+-fxc^{\beta\beta})*\rho(1) over the grid points
3528 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_rhoa])
3529 IF (ASSOCIATED(deriv_att)) THEN
3530 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3531!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3532!$OMP SHARED(bo,v_xc,deriv_data,rho1a,fac) COLLAPSE(3)
3533 DO k = bo(1, 3), bo(2, 3)
3534 DO j = bo(1, 2), bo(2, 2)
3535 DO i = bo(1, 1), bo(2, 1)
3536 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3537 deriv_data(i, j, k)*rho1a(i, j, k)
3538 END DO
3539 END DO
3540 END DO
3541 END IF
3542 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drho])
3543 IF (ASSOCIATED(deriv_att)) THEN
3544 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3545!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3546!$OMP SHARED(bo,v_xc,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3547 DO k = bo(1, 3), bo(2, 3)
3548 DO j = bo(1, 2), bo(2, 2)
3549 DO i = bo(1, 1), bo(2, 1)
3550 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3551 deriv_data(i, j, k)*dr1dr(i, j, k)
3552 END DO
3553 END DO
3554 END DO
3555 END IF
3556 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drhoa])
3557 IF (ASSOCIATED(deriv_att)) THEN
3558 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3559!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3560!$OMP SHARED(bo,v_xc,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3561 DO k = bo(1, 3), bo(2, 3)
3562 DO j = bo(1, 2), bo(2, 2)
3563 DO i = bo(1, 1), bo(2, 1)
3564 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3565 deriv_data(i, j, k)*dra1dra(i, j, k)
3566 END DO
3567 END DO
3568 END DO
3569 END IF
3570 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_tau_a])
3571 IF (ASSOCIATED(deriv_att)) THEN
3572 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3573!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3574!$OMP SHARED(bo,v_xc,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
3575 DO k = bo(1, 3), bo(2, 3)
3576 DO j = bo(1, 2), bo(2, 2)
3577 DO i = bo(1, 1), bo(2, 1)
3578 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3579 deriv_data(i, j, k)*tau1a(i, j, k)
3580 END DO
3581 END DO
3582 END DO
3583 END IF
3584 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_laplace_rhoa])
3585 IF (ASSOCIATED(deriv_att)) THEN
3586 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3587!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3588!$OMP SHARED(bo,v_xc,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
3589 DO k = bo(1, 3), bo(2, 3)
3590 DO j = bo(1, 2), bo(2, 2)
3591 DO i = bo(1, 1), bo(2, 1)
3592 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3593 deriv_data(i, j, k)*laplace1a(i, j, k)
3594 END DO
3595 END DO
3596 END DO
3597 END IF
3598 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_rhob])
3599 IF (ASSOCIATED(deriv_att)) THEN
3600 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3601!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3602!$OMP SHARED(bo,v_xc,deriv_data,rho1b,fac) COLLAPSE(3)
3603 DO k = bo(1, 3), bo(2, 3)
3604 DO j = bo(1, 2), bo(2, 2)
3605 DO i = bo(1, 1), bo(2, 1)
3606 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3607 fac*deriv_data(i, j, k)*rho1b(i, j, k)
3608 END DO
3609 END DO
3610 END DO
3611 END IF
3612 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drhob])
3613 IF (ASSOCIATED(deriv_att)) THEN
3614 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3615!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3616!$OMP SHARED(bo,v_xc,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3617 DO k = bo(1, 3), bo(2, 3)
3618 DO j = bo(1, 2), bo(2, 2)
3619 DO i = bo(1, 1), bo(2, 1)
3620 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3621 fac*deriv_data(i, j, k)*drb1drb(i, j, k)
3622 END DO
3623 END DO
3624 END DO
3625 END IF
3626 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_tau_b])
3627 IF (ASSOCIATED(deriv_att)) THEN
3628 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3629!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3630!$OMP SHARED(bo,v_xc,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
3631 DO k = bo(1, 3), bo(2, 3)
3632 DO j = bo(1, 2), bo(2, 2)
3633 DO i = bo(1, 1), bo(2, 1)
3634 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3635 fac*deriv_data(i, j, k)*tau1b(i, j, k)
3636 END DO
3637 END DO
3638 END DO
3639 END IF
3640 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_laplace_rhob])
3641 IF (ASSOCIATED(deriv_att)) THEN
3642 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3643!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3644!$OMP SHARED(bo,v_xc,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
3645 DO k = bo(1, 3), bo(2, 3)
3646 DO j = bo(1, 2), bo(2, 2)
3647 DO i = bo(1, 1), bo(2, 1)
3648 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
3649 fac*deriv_data(i, j, k)*laplace1b(i, j, k)
3650 END DO
3651 END DO
3652 END DO
3653 END IF
3654
3655
3656 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rhoa])
3657 IF (ASSOCIATED(deriv_att)) THEN
3658 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3659!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3660!$OMP SHARED(bo,v_drho,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
3661 DO k = bo(1, 3), bo(2, 3)
3662 DO j = bo(1, 2), bo(2, 2)
3663 DO i = bo(1, 1), bo(2, 1)
3664 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3665 deriv_data(i, j, k)*rho1a(i, j, k)
3666 END DO
3667 END DO
3668 END DO
3669 END IF
3670 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drho])
3671 IF (ASSOCIATED(deriv_att)) THEN
3672 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3673!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3674!$OMP SHARED(bo,v_drho,deriv_data,dr1dr,fac) COLLAPSE(3)
3675 DO k = bo(1, 3), bo(2, 3)
3676 DO j = bo(1, 2), bo(2, 2)
3677 DO i = bo(1, 1), bo(2, 1)
3678 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3679 deriv_data(i, j, k)*dr1dr(i, j, k)
3680 END DO
3681 END DO
3682 END DO
3683 END IF
3684 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drhoa])
3685 IF (ASSOCIATED(deriv_att)) THEN
3686 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3687!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3688!$OMP SHARED(bo,v_drho,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3689 DO k = bo(1, 3), bo(2, 3)
3690 DO j = bo(1, 2), bo(2, 2)
3691 DO i = bo(1, 1), bo(2, 1)
3692 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3693 deriv_data(i, j, k)*dra1dra(i, j, k)
3694 END DO
3695 END DO
3696 END DO
3697 END IF
3698 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_tau_a])
3699 IF (ASSOCIATED(deriv_att)) THEN
3700 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3701!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3702!$OMP SHARED(bo,v_drho,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
3703 DO k = bo(1, 3), bo(2, 3)
3704 DO j = bo(1, 2), bo(2, 2)
3705 DO i = bo(1, 1), bo(2, 1)
3706 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3707 deriv_data(i, j, k)*tau1a(i, j, k)
3708 END DO
3709 END DO
3710 END DO
3711 END IF
3713 IF (ASSOCIATED(deriv_att)) THEN
3714 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3715!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3716!$OMP SHARED(bo,v_drho,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
3717 DO k = bo(1, 3), bo(2, 3)
3718 DO j = bo(1, 2), bo(2, 2)
3719 DO i = bo(1, 1), bo(2, 1)
3720 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3721 deriv_data(i, j, k)*laplace1a(i, j, k)
3722 END DO
3723 END DO
3724 END DO
3725 END IF
3726 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rhob])
3727 IF (ASSOCIATED(deriv_att)) THEN
3728 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3729!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3730!$OMP SHARED(bo,v_drho,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
3731 DO k = bo(1, 3), bo(2, 3)
3732 DO j = bo(1, 2), bo(2, 2)
3733 DO i = bo(1, 1), bo(2, 1)
3734 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3735 fac*deriv_data(i, j, k)*rho1b(i, j, k)
3736 END DO
3737 END DO
3738 END DO
3739 END IF
3740 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drhob])
3741 IF (ASSOCIATED(deriv_att)) THEN
3742 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3743!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3744!$OMP SHARED(bo,v_drho,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3745 DO k = bo(1, 3), bo(2, 3)
3746 DO j = bo(1, 2), bo(2, 2)
3747 DO i = bo(1, 1), bo(2, 1)
3748 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3749 fac*deriv_data(i, j, k)*drb1drb(i, j, k)
3750 END DO
3751 END DO
3752 END DO
3753 END IF
3754 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_tau_b])
3755 IF (ASSOCIATED(deriv_att)) THEN
3756 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3757!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3758!$OMP SHARED(bo,v_drho,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
3759 DO k = bo(1, 3), bo(2, 3)
3760 DO j = bo(1, 2), bo(2, 2)
3761 DO i = bo(1, 1), bo(2, 1)
3762 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3763 fac*deriv_data(i, j, k)*tau1b(i, j, k)
3764 END DO
3765 END DO
3766 END DO
3767 END IF
3769 IF (ASSOCIATED(deriv_att)) THEN
3770 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3771!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3772!$OMP SHARED(bo,v_drho,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
3773 DO k = bo(1, 3), bo(2, 3)
3774 DO j = bo(1, 2), bo(2, 2)
3775 DO i = bo(1, 1), bo(2, 1)
3776 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
3777 fac*deriv_data(i, j, k)*laplace1b(i, j, k)
3778 END DO
3779 END DO
3780 END DO
3781 END IF
3782
3783 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho])
3784 IF (ASSOCIATED(deriv_att)) THEN
3785 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3786 CALL xc_derivative_get(deriv_att, deriv_data=e_drho)
3787
3788
3789!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dr1dr,gradient_cut,norm_drho,v_drho,deriv_data)
3790 v_drho(1)%array(:, :, :) = v_drho(1)%array(:, :, :) + &
3791 deriv_data(:, :, :)*dr1dr(:, :, :)/max(gradient_cut, norm_drho(:, :, :))**2
3792!$OMP END PARALLEL WORKSHARE
3793 END IF
3794
3795 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_rhoa])
3796 IF (ASSOCIATED(deriv_att)) THEN
3797 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3798!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3799!$OMP SHARED(bo,v_drhoa,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
3800 DO k = bo(1, 3), bo(2, 3)
3801 DO j = bo(1, 2), bo(2, 2)
3802 DO i = bo(1, 1), bo(2, 1)
3803 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3804 deriv_data(i, j, k)*rho1a(i, j, k)
3805 END DO
3806 END DO
3807 END DO
3808 END IF
3809 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drho])
3810 IF (ASSOCIATED(deriv_att)) THEN
3811 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3812!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3813!$OMP SHARED(bo,v_drhoa,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3814 DO k = bo(1, 3), bo(2, 3)
3815 DO j = bo(1, 2), bo(2, 2)
3816 DO i = bo(1, 1), bo(2, 1)
3817 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3818 deriv_data(i, j, k)*dr1dr(i, j, k)
3819 END DO
3820 END DO
3821 END DO
3822 END IF
3823 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drhoa])
3824 IF (ASSOCIATED(deriv_att)) THEN
3825 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3826!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3827!$OMP SHARED(bo,v_drhoa,deriv_data,dra1dra,fac) COLLAPSE(3)
3828 DO k = bo(1, 3), bo(2, 3)
3829 DO j = bo(1, 2), bo(2, 2)
3830 DO i = bo(1, 1), bo(2, 1)
3831 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3832 deriv_data(i, j, k)*dra1dra(i, j, k)
3833 END DO
3834 END DO
3835 END DO
3836 END IF
3837 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_tau_a])
3838 IF (ASSOCIATED(deriv_att)) THEN
3839 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3840!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3841!$OMP SHARED(bo,v_drhoa,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
3842 DO k = bo(1, 3), bo(2, 3)
3843 DO j = bo(1, 2), bo(2, 2)
3844 DO i = bo(1, 1), bo(2, 1)
3845 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3846 deriv_data(i, j, k)*tau1a(i, j, k)
3847 END DO
3848 END DO
3849 END DO
3850 END IF
3852 IF (ASSOCIATED(deriv_att)) THEN
3853 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3854!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3855!$OMP SHARED(bo,v_drhoa,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
3856 DO k = bo(1, 3), bo(2, 3)
3857 DO j = bo(1, 2), bo(2, 2)
3858 DO i = bo(1, 1), bo(2, 1)
3859 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3860 deriv_data(i, j, k)*laplace1a(i, j, k)
3861 END DO
3862 END DO
3863 END DO
3864 END IF
3865 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_rhob])
3866 IF (ASSOCIATED(deriv_att)) THEN
3867 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3868!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3869!$OMP SHARED(bo,v_drhoa,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
3870 DO k = bo(1, 3), bo(2, 3)
3871 DO j = bo(1, 2), bo(2, 2)
3872 DO i = bo(1, 1), bo(2, 1)
3873 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3874 fac*deriv_data(i, j, k)*rho1b(i, j, k)
3875 END DO
3876 END DO
3877 END DO
3878 END IF
3879 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drhob])
3880 IF (ASSOCIATED(deriv_att)) THEN
3881 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3882!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3883!$OMP SHARED(bo,v_drhoa,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
3884 DO k = bo(1, 3), bo(2, 3)
3885 DO j = bo(1, 2), bo(2, 2)
3886 DO i = bo(1, 1), bo(2, 1)
3887 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3888 fac*deriv_data(i, j, k)*drb1drb(i, j, k)
3889 END DO
3890 END DO
3891 END DO
3892 END IF
3893 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_tau_b])
3894 IF (ASSOCIATED(deriv_att)) THEN
3895 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3896!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3897!$OMP SHARED(bo,v_drhoa,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
3898 DO k = bo(1, 3), bo(2, 3)
3899 DO j = bo(1, 2), bo(2, 2)
3900 DO i = bo(1, 1), bo(2, 1)
3901 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3902 fac*deriv_data(i, j, k)*tau1b(i, j, k)
3903 END DO
3904 END DO
3905 END DO
3906 END IF
3908 IF (ASSOCIATED(deriv_att)) THEN
3909 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3910!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3911!$OMP SHARED(bo,v_drhoa,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
3912 DO k = bo(1, 3), bo(2, 3)
3913 DO j = bo(1, 2), bo(2, 2)
3914 DO i = bo(1, 1), bo(2, 1)
3915 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
3916 fac*deriv_data(i, j, k)*laplace1b(i, j, k)
3917 END DO
3918 END DO
3919 END DO
3920 END IF
3921
3922 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa])
3923 IF (ASSOCIATED(deriv_att)) THEN
3924 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3925 CALL xc_derivative_get(deriv_att, deriv_data=e_drhoa)
3926
3927
3928!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dra1dra,gradient_cut,norm_drhoa,v_drhoa,deriv_data)
3929 v_drhoa(1)%array(:, :, :) = v_drhoa(1)%array(:, :, :) + &
3930 deriv_data(:, :, :)*dra1dra(:, :, :)/max(gradient_cut, norm_drhoa(:, :, :))**2
3931!$OMP END PARALLEL WORKSHARE
3932 END IF
3933
3934 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_rhoa])
3935 IF (ASSOCIATED(deriv_att)) THEN
3936 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3937!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3938!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
3939 DO k = bo(1, 3), bo(2, 3)
3940 DO j = bo(1, 2), bo(2, 2)
3941 DO i = bo(1, 1), bo(2, 1)
3942 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3943 deriv_data(i, j, k)*rho1a(i, j, k)
3944 END DO
3945 END DO
3946 END DO
3947 END IF
3948 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_norm_drho])
3949 IF (ASSOCIATED(deriv_att)) THEN
3950 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3951!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3952!$OMP SHARED(bo,v_xc_tau,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
3953 DO k = bo(1, 3), bo(2, 3)
3954 DO j = bo(1, 2), bo(2, 2)
3955 DO i = bo(1, 1), bo(2, 1)
3956 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3957 deriv_data(i, j, k)*dr1dr(i, j, k)
3958 END DO
3959 END DO
3960 END DO
3961 END IF
3962 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_norm_drhoa])
3963 IF (ASSOCIATED(deriv_att)) THEN
3964 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3965!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3966!$OMP SHARED(bo,v_xc_tau,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
3967 DO k = bo(1, 3), bo(2, 3)
3968 DO j = bo(1, 2), bo(2, 2)
3969 DO i = bo(1, 1), bo(2, 1)
3970 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3971 deriv_data(i, j, k)*dra1dra(i, j, k)
3972 END DO
3973 END DO
3974 END DO
3975 END IF
3976 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_tau_a])
3977 IF (ASSOCIATED(deriv_att)) THEN
3978 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3979!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3980!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1a,fac) COLLAPSE(3)
3981 DO k = bo(1, 3), bo(2, 3)
3982 DO j = bo(1, 2), bo(2, 2)
3983 DO i = bo(1, 1), bo(2, 1)
3984 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3985 deriv_data(i, j, k)*tau1a(i, j, k)
3986 END DO
3987 END DO
3988 END DO
3989 END IF
3990 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_laplace_rhoa])
3991 IF (ASSOCIATED(deriv_att)) THEN
3992 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
3993!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
3994!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1a,v_laplace,fac) COLLAPSE(3)
3995 DO k = bo(1, 3), bo(2, 3)
3996 DO j = bo(1, 2), bo(2, 2)
3997 DO i = bo(1, 1), bo(2, 1)
3998 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
3999 deriv_data(i, j, k)*laplace1a(i, j, k)
4000 END DO
4001 END DO
4002 END DO
4003 END IF
4004 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_rhob])
4005 IF (ASSOCIATED(deriv_att)) THEN
4006 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4007!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4008!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
4009 DO k = bo(1, 3), bo(2, 3)
4010 DO j = bo(1, 2), bo(2, 2)
4011 DO i = bo(1, 1), bo(2, 1)
4012 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4013 fac*deriv_data(i, j, k)*rho1b(i, j, k)
4014 END DO
4015 END DO
4016 END DO
4017 END IF
4018 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_norm_drhob])
4019 IF (ASSOCIATED(deriv_att)) THEN
4020 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4021!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4022!$OMP SHARED(bo,v_xc_tau,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
4023 DO k = bo(1, 3), bo(2, 3)
4024 DO j = bo(1, 2), bo(2, 2)
4025 DO i = bo(1, 1), bo(2, 1)
4026 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4027 fac*deriv_data(i, j, k)*drb1drb(i, j, k)
4028 END DO
4029 END DO
4030 END DO
4031 END IF
4032 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_tau_b])
4033 IF (ASSOCIATED(deriv_att)) THEN
4034 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4035!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4036!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1b,fac) COLLAPSE(3)
4037 DO k = bo(1, 3), bo(2, 3)
4038 DO j = bo(1, 2), bo(2, 2)
4039 DO i = bo(1, 1), bo(2, 1)
4040 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4041 fac*deriv_data(i, j, k)*tau1b(i, j, k)
4042 END DO
4043 END DO
4044 END DO
4045 END IF
4046 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau_a, deriv_laplace_rhob])
4047 IF (ASSOCIATED(deriv_att)) THEN
4048 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4049!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4050!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1b,v_laplace,fac) COLLAPSE(3)
4051 DO k = bo(1, 3), bo(2, 3)
4052 DO j = bo(1, 2), bo(2, 2)
4053 DO i = bo(1, 1), bo(2, 1)
4054 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4055 fac*deriv_data(i, j, k)*laplace1b(i, j, k)
4056 END DO
4057 END DO
4058 END DO
4059 END IF
4060
4061
4062 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_rhoa])
4063 IF (ASSOCIATED(deriv_att)) THEN
4064 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4065!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4066!$OMP SHARED(bo,v_laplace,deriv_data,rho1a,v_xc,fac) COLLAPSE(3)
4067 DO k = bo(1, 3), bo(2, 3)
4068 DO j = bo(1, 2), bo(2, 2)
4069 DO i = bo(1, 1), bo(2, 1)
4070 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4071 deriv_data(i, j, k)*rho1a(i, j, k)
4072 END DO
4073 END DO
4074 END DO
4075 END IF
4077 IF (ASSOCIATED(deriv_att)) THEN
4078 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4079!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4080!$OMP SHARED(bo,v_laplace,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
4081 DO k = bo(1, 3), bo(2, 3)
4082 DO j = bo(1, 2), bo(2, 2)
4083 DO i = bo(1, 1), bo(2, 1)
4084 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4085 deriv_data(i, j, k)*dr1dr(i, j, k)
4086 END DO
4087 END DO
4088 END DO
4089 END IF
4091 IF (ASSOCIATED(deriv_att)) THEN
4092 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4093!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4094!$OMP SHARED(bo,v_laplace,deriv_data,dra1dra,v_drhoa,fac) COLLAPSE(3)
4095 DO k = bo(1, 3), bo(2, 3)
4096 DO j = bo(1, 2), bo(2, 2)
4097 DO i = bo(1, 1), bo(2, 1)
4098 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4099 deriv_data(i, j, k)*dra1dra(i, j, k)
4100 END DO
4101 END DO
4102 END DO
4103 END IF
4104 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_tau_a])
4105 IF (ASSOCIATED(deriv_att)) THEN
4106 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4107!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4108!$OMP SHARED(bo,v_laplace,deriv_data,tau1a,v_xc_tau,fac) COLLAPSE(3)
4109 DO k = bo(1, 3), bo(2, 3)
4110 DO j = bo(1, 2), bo(2, 2)
4111 DO i = bo(1, 1), bo(2, 1)
4112 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4113 deriv_data(i, j, k)*tau1a(i, j, k)
4114 END DO
4115 END DO
4116 END DO
4117 END IF
4119 IF (ASSOCIATED(deriv_att)) THEN
4120 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4121!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4122!$OMP SHARED(bo,v_laplace,deriv_data,laplace1a,fac) COLLAPSE(3)
4123 DO k = bo(1, 3), bo(2, 3)
4124 DO j = bo(1, 2), bo(2, 2)
4125 DO i = bo(1, 1), bo(2, 1)
4126 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4127 deriv_data(i, j, k)*laplace1a(i, j, k)
4128 END DO
4129 END DO
4130 END DO
4131 END IF
4132 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_rhob])
4133 IF (ASSOCIATED(deriv_att)) THEN
4134 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4135!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4136!$OMP SHARED(bo,v_laplace,deriv_data,rho1b,v_xc,fac) COLLAPSE(3)
4137 DO k = bo(1, 3), bo(2, 3)
4138 DO j = bo(1, 2), bo(2, 2)
4139 DO i = bo(1, 1), bo(2, 1)
4140 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4141 fac*deriv_data(i, j, k)*rho1b(i, j, k)
4142 END DO
4143 END DO
4144 END DO
4145 END IF
4147 IF (ASSOCIATED(deriv_att)) THEN
4148 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4149!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4150!$OMP SHARED(bo,v_laplace,deriv_data,drb1drb,v_drhob,fac) COLLAPSE(3)
4151 DO k = bo(1, 3), bo(2, 3)
4152 DO j = bo(1, 2), bo(2, 2)
4153 DO i = bo(1, 1), bo(2, 1)
4154 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4155 fac*deriv_data(i, j, k)*drb1drb(i, j, k)
4156 END DO
4157 END DO
4158 END DO
4159 END IF
4160 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rhoa, deriv_tau_b])
4161 IF (ASSOCIATED(deriv_att)) THEN
4162 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4163!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4164!$OMP SHARED(bo,v_laplace,deriv_data,tau1b,v_xc_tau,fac) COLLAPSE(3)
4165 DO k = bo(1, 3), bo(2, 3)
4166 DO j = bo(1, 2), bo(2, 2)
4167 DO i = bo(1, 1), bo(2, 1)
4168 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4169 fac*deriv_data(i, j, k)*tau1b(i, j, k)
4170 END DO
4171 END DO
4172 END DO
4173 END IF
4175 IF (ASSOCIATED(deriv_att)) THEN
4176 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4177!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4178!$OMP SHARED(bo,v_laplace,deriv_data,laplace1b,fac) COLLAPSE(3)
4179 DO k = bo(1, 3), bo(2, 3)
4180 DO j = bo(1, 2), bo(2, 2)
4181 DO i = bo(1, 1), bo(2, 1)
4182 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + &
4183 fac*deriv_data(i, j, k)*laplace1b(i, j, k)
4184 END DO
4185 END DO
4186 END DO
4187 END IF
4188
4189
4190
4191
4192 END IF
4193
4194 IF (gradient_f) THEN
4195 IF (.NOT. do_spinflip) THEN
4196
4197 IF (my_compute_virial) THEN
4198 CALL virial_drho_drho(virial_pw, drhoa, v_drhoa(1), virial_xc)
4199 CALL virial_drho_drho(virial_pw, drhob, v_drhob(2), virial_xc)
4200 DO idir = 1, 3
4201!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drho,idir,v_drho,virial_pw)
4202 virial_pw%array(:, :, :) = drho(idir)%array(:, :, :)*(v_drho(1)%array(:, :, :) + v_drho(2)%array(:, :, :))
4203!$OMP END PARALLEL WORKSHARE
4204 DO jdir = 1, idir
4205 tmp = -0.5_dp*virial_pw%pw_grid%dvol*accurate_dot_product(virial_pw%array(:, :, :), &
4206 drho(jdir)%array(:, :, :))
4207 virial_xc(jdir, idir) = virial_xc(jdir, idir) + tmp
4208 virial_xc(idir, jdir) = virial_xc(jdir, idir)
4209 END DO
4210 END DO
4211 END IF ! my_compute_virial
4212
4213 IF (my_gapw) THEN
4214!$OMP PARALLEL DO DEFAULT(NONE) &
4215!$OMP PRIVATE(ia,idir,ispin,ir) &
4216!$OMP SHARED(bo,nspins,vxg,drhoa,drhob,v_drhoa,v_drhob,v_drho, &
4217!$OMP e_drhoa,e_drhob,e_drho,drho1a,drho1b,fac,drho,drho1) COLLAPSE(3)
4218 DO ir = bo(1, 2), bo(2, 2)
4219 DO ia = bo(1, 1), bo(2, 1)
4220 DO idir = 1, 3
4221 DO ispin = 1, nspins
4222 vxg(idir, ia, ir, ispin) = &
4223 -(v_drhoa(ispin)%array(ia, ir, 1)*drhoa(idir)%array(ia, ir, 1) + &
4224 v_drhob(ispin)%array(ia, ir, 1)*drhob(idir)%array(ia, ir, 1) + &
4225 v_drho(ispin)%array(ia, ir, 1)*drho(idir)%array(ia, ir, 1))
4226 END DO
4227 IF (ASSOCIATED(e_drhoa)) THEN
4228 vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1) + &
4229 e_drhoa(ia, ir, 1)*drho1a(idir)%array(ia, ir, 1)
4230 END IF
4231 IF (nspins /= 1 .AND. ASSOCIATED(e_drhob)) THEN
4232 vxg(idir, ia, ir, 2) = vxg(idir, ia, ir, 2) + &
4233 e_drhob(ia, ir, 1)*drho1b(idir)%array(ia, ir, 1)
4234 END IF
4235 IF (ASSOCIATED(e_drho)) THEN
4236 IF (nspins /= 1) THEN
4237 vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1) + &
4238 e_drho(ia, ir, 1)*drho1(idir)%array(ia, ir, 1)
4239 vxg(idir, ia, ir, 2) = vxg(idir, ia, ir, 2) + &
4240 e_drho(ia, ir, 1)*drho1(idir)%array(ia, ir, 1)
4241 ELSE
4242 vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1) + &
4243 e_drho(ia, ir, 1)*(drho1a(idir)%array(ia, ir, 1) + &
4244 fac*drho1b(idir)%array(ia, ir, 1))
4245 END IF
4246 END IF
4247 END DO
4248 END DO
4249 END DO
4250!$OMP END PARALLEL DO
4251 ELSE
4252
4253 ! partial integration
4254 DO idir = 1, 3
4255
4256 DO ispin = 1, nspins
4257!$OMP PARALLEL WORKSHARE DEFAULT(NONE) &
4258!$OMP SHARED(v_drho_r,v_drhoa,v_drhob,v_drho,drhoa,drhob,drho,ispin,idir)
4259 v_drho_r(idir, ispin)%array(:, :, :) = &
4260 v_drhoa(ispin)%array(:, :, :)*drhoa(idir)%array(:, :, :) + &
4261 v_drhob(ispin)%array(:, :, :)*drhob(idir)%array(:, :, :) + &
4262 v_drho(ispin)%array(:, :, :)*drho(idir)%array(:, :, :)
4263!$OMP END PARALLEL WORKSHARE
4264 END DO
4265 IF (ASSOCIATED(e_drhoa)) THEN
4266!$OMP PARALLEL WORKSHARE DEFAULT(NONE) &
4267!$OMP SHARED(v_drho_r,e_drhoa,drho1a,idir)
4268 v_drho_r(idir, 1)%array(:, :, :) = v_drho_r(idir, 1)%array(:, :, :) - &
4269 e_drhoa(:, :, :)*drho1a(idir)%array(:, :, :)
4270!$OMP END PARALLEL WORKSHARE
4271 END IF
4272 IF (nspins /= 1 .AND. ASSOCIATED(e_drhob)) THEN
4273!$OMP PARALLEL WORKSHARE DEFAULT(NONE)&
4274!$OMP SHARED(v_drho_r,e_drhob,drho1b,idir)
4275 v_drho_r(idir, 2)%array(:, :, :) = v_drho_r(idir, 2)%array(:, :, :) - &
4276 e_drhob(:, :, :)*drho1b(idir)%array(:, :, :)
4277!$OMP END PARALLEL WORKSHARE
4278 END IF
4279 IF (ASSOCIATED(e_drho)) THEN
4280!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4281!$OMP SHARED(bo,v_drho_r,e_drho,drho1a,drho1b,drho1,fac,idir,nspins) COLLAPSE(3)
4282 DO k = bo(1, 3), bo(2, 3)
4283 DO j = bo(1, 2), bo(2, 2)
4284 DO i = bo(1, 1), bo(2, 1)
4285 IF (nspins /= 1) THEN
4286 v_drho_r(idir, 1)%array(i, j, k) = v_drho_r(idir, 1)%array(i, j, k) - &
4287 e_drho(i, j, k)*drho1(idir)%array(i, j, k)
4288 v_drho_r(idir, 2)%array(i, j, k) = v_drho_r(idir, 2)%array(i, j, k) - &
4289 e_drho(i, j, k)*drho1(idir)%array(i, j, k)
4290 ELSE
4291 v_drho_r(idir, 1)%array(i, j, k) = v_drho_r(idir, 1)%array(i, j, k) - &
4292 e_drho(i, j, k)*(drho1a(idir)%array(i, j, k) + &
4293 fac*drho1b(idir)%array(i, j, k))
4294 END IF
4295 END DO
4296 END DO
4297 END DO
4298!$OMP END PARALLEL DO
4299 END IF
4300 END DO
4301
4302 ! partial integration
4303 DO ispin = 1, nspins
4304 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, ispin), tmp_g, vxc_g, v_xc(ispin))
4305 END DO ! ispin
4306
4307 END IF
4308
4309 END IF ! .NOT.do_spinflip
4310
4311 DO idir = 1, 3
4312 DEALLOCATE (drho(idir)%array)
4313 DEALLOCATE (drho1(idir)%array)
4314 END DO
4315
4316 DO ispin = 1, nspins
4317 CALL deallocate_pw(v_drhoa(ispin), pw_pool)
4318 CALL deallocate_pw(v_drhob(ispin), pw_pool)
4319 END DO
4320
4321 DEALLOCATE (v_drhoa, v_drhob)
4322
4323 END IF ! gradient_f
4324
4325 IF (laplace_f .AND. my_compute_virial) THEN
4326 virial_pw%array(:, :, :) = -rhoa(:, :, :)
4327 CALL virial_laplace(virial_pw, pw_pool, virial_xc, v_laplace(1)%array)
4328 virial_pw%array(:, :, :) = -rhob(:, :, :)
4329 CALL virial_laplace(virial_pw, pw_pool, virial_xc, v_laplace(2)%array)
4330 END IF
4331
4332 ELSE
4333
4334 !-----------------!
4335 ! restricted case !
4336 !-----------------!
4337
4338 CALL xc_rho_set_get(rho1_set, rho=rho1)
4339
4340 IF (gradient_f) THEN
4341 CALL xc_rho_set_get(rho_set, drho=drho, norm_drho=norm_drho)
4342 CALL xc_rho_set_get(rho1_set, drho=drho1)
4343 CALL prepare_dr1dr(dr1dr, drho, drho1)
4344 END IF
4345
4346 IF (laplace_f) THEN
4347 CALL xc_rho_set_get(rho1_set, laplace_rho=laplace1)
4348
4349 ALLOCATE (v_laplace(nspins))
4350 DO ispin = 1, nspins
4351 CALL allocate_pw(v_laplace(ispin), pw_pool, bo)
4352 END DO
4353
4354 IF (my_compute_virial) CALL xc_rho_set_get(rho_set, rho=rho)
4355 END IF
4356
4357 IF (tau_f) THEN
4358 CALL xc_rho_set_get(rho1_set, tau=tau1)
4359 END IF
4360
4361 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_rho])
4362 IF (ASSOCIATED(deriv_att)) THEN
4363 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4364!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4365!$OMP SHARED(bo,v_xc,deriv_data,rho1,fac) COLLAPSE(3)
4366 DO k = bo(1, 3), bo(2, 3)
4367 DO j = bo(1, 2), bo(2, 2)
4368 DO i = bo(1, 1), bo(2, 1)
4369 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
4370 deriv_data(i, j, k)*rho1(i, j, k)
4371 END DO
4372 END DO
4373 END DO
4374 END IF
4375 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_norm_drho])
4376 IF (ASSOCIATED(deriv_att)) THEN
4377 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4378!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4379!$OMP SHARED(bo,v_xc,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
4380 DO k = bo(1, 3), bo(2, 3)
4381 DO j = bo(1, 2), bo(2, 2)
4382 DO i = bo(1, 1), bo(2, 1)
4383 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
4384 deriv_data(i, j, k)*dr1dr(i, j, k)
4385 END DO
4386 END DO
4387 END DO
4388 END IF
4389 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_tau])
4390 IF (ASSOCIATED(deriv_att)) THEN
4391 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4392!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4393!$OMP SHARED(bo,v_xc,deriv_data,tau1,v_xc_tau,fac) COLLAPSE(3)
4394 DO k = bo(1, 3), bo(2, 3)
4395 DO j = bo(1, 2), bo(2, 2)
4396 DO i = bo(1, 1), bo(2, 1)
4397 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
4398 deriv_data(i, j, k)*tau1(i, j, k)
4399 END DO
4400 END DO
4401 END DO
4402 END IF
4403 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_laplace_rho])
4404 IF (ASSOCIATED(deriv_att)) THEN
4405 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4406!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4407!$OMP SHARED(bo,v_xc,deriv_data,laplace1,v_laplace,fac) COLLAPSE(3)
4408 DO k = bo(1, 3), bo(2, 3)
4409 DO j = bo(1, 2), bo(2, 2)
4410 DO i = bo(1, 1), bo(2, 1)
4411 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
4412 deriv_data(i, j, k)*laplace1(i, j, k)
4413 END DO
4414 END DO
4415 END DO
4416 END IF
4417
4418
4419 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rho])
4420 IF (ASSOCIATED(deriv_att)) THEN
4421 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4422!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4423!$OMP SHARED(bo,v_drho,deriv_data,rho1,v_xc,fac) COLLAPSE(3)
4424 DO k = bo(1, 3), bo(2, 3)
4425 DO j = bo(1, 2), bo(2, 2)
4426 DO i = bo(1, 1), bo(2, 1)
4427 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
4428 deriv_data(i, j, k)*rho1(i, j, k)
4429 END DO
4430 END DO
4431 END DO
4432 END IF
4433 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drho])
4434 IF (ASSOCIATED(deriv_att)) THEN
4435 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4436!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4437!$OMP SHARED(bo,v_drho,deriv_data,dr1dr,fac) COLLAPSE(3)
4438 DO k = bo(1, 3), bo(2, 3)
4439 DO j = bo(1, 2), bo(2, 2)
4440 DO i = bo(1, 1), bo(2, 1)
4441 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
4442 deriv_data(i, j, k)*dr1dr(i, j, k)
4443 END DO
4444 END DO
4445 END DO
4446 END IF
4447 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_tau])
4448 IF (ASSOCIATED(deriv_att)) THEN
4449 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4450!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4451!$OMP SHARED(bo,v_drho,deriv_data,tau1,v_xc_tau,fac) COLLAPSE(3)
4452 DO k = bo(1, 3), bo(2, 3)
4453 DO j = bo(1, 2), bo(2, 2)
4454 DO i = bo(1, 1), bo(2, 1)
4455 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
4456 deriv_data(i, j, k)*tau1(i, j, k)
4457 END DO
4458 END DO
4459 END DO
4460 END IF
4461 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_laplace_rho])
4462 IF (ASSOCIATED(deriv_att)) THEN
4463 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4464!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4465!$OMP SHARED(bo,v_drho,deriv_data,laplace1,v_laplace,fac) COLLAPSE(3)
4466 DO k = bo(1, 3), bo(2, 3)
4467 DO j = bo(1, 2), bo(2, 2)
4468 DO i = bo(1, 1), bo(2, 1)
4469 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
4470 deriv_data(i, j, k)*laplace1(i, j, k)
4471 END DO
4472 END DO
4473 END DO
4474 END IF
4475
4476 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho])
4477 IF (ASSOCIATED(deriv_att)) THEN
4478 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4479 CALL xc_derivative_get(deriv_att, deriv_data=e_drho)
4480
4481 IF (my_compute_virial) THEN
4482 CALL virial_drho_drho1(virial_pw, drho, drho1, deriv_data, virial_xc)
4483 END IF ! my_compute_virial
4484
4485!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dr1dr,gradient_cut,norm_drho,v_drho,deriv_data)
4486 v_drho(1)%array(:, :, :) = v_drho(1)%array(:, :, :) + &
4487 deriv_data(:, :, :)*dr1dr(:, :, :)/max(gradient_cut, norm_drho(:, :, :))**2
4488!$OMP END PARALLEL WORKSHARE
4489 END IF
4490
4491 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau, deriv_rho])
4492 IF (ASSOCIATED(deriv_att)) THEN
4493 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4494!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4495!$OMP SHARED(bo,v_xc_tau,deriv_data,rho1,v_xc,fac) COLLAPSE(3)
4496 DO k = bo(1, 3), bo(2, 3)
4497 DO j = bo(1, 2), bo(2, 2)
4498 DO i = bo(1, 1), bo(2, 1)
4499 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4500 deriv_data(i, j, k)*rho1(i, j, k)
4501 END DO
4502 END DO
4503 END DO
4504 END IF
4505 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau, deriv_norm_drho])
4506 IF (ASSOCIATED(deriv_att)) THEN
4507 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4508!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4509!$OMP SHARED(bo,v_xc_tau,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
4510 DO k = bo(1, 3), bo(2, 3)
4511 DO j = bo(1, 2), bo(2, 2)
4512 DO i = bo(1, 1), bo(2, 1)
4513 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4514 deriv_data(i, j, k)*dr1dr(i, j, k)
4515 END DO
4516 END DO
4517 END DO
4518 END IF
4519 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau, deriv_tau])
4520 IF (ASSOCIATED(deriv_att)) THEN
4521 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4522!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4523!$OMP SHARED(bo,v_xc_tau,deriv_data,tau1,fac) COLLAPSE(3)
4524 DO k = bo(1, 3), bo(2, 3)
4525 DO j = bo(1, 2), bo(2, 2)
4526 DO i = bo(1, 1), bo(2, 1)
4527 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4528 deriv_data(i, j, k)*tau1(i, j, k)
4529 END DO
4530 END DO
4531 END DO
4532 END IF
4533 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_tau, deriv_laplace_rho])
4534 IF (ASSOCIATED(deriv_att)) THEN
4535 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4536!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4537!$OMP SHARED(bo,v_xc_tau,deriv_data,laplace1,v_laplace,fac) COLLAPSE(3)
4538 DO k = bo(1, 3), bo(2, 3)
4539 DO j = bo(1, 2), bo(2, 2)
4540 DO i = bo(1, 1), bo(2, 1)
4541 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + &
4542 deriv_data(i, j, k)*laplace1(i, j, k)
4543 END DO
4544 END DO
4545 END DO
4546 END IF
4547
4548
4549 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rho, deriv_rho])
4550 IF (ASSOCIATED(deriv_att)) THEN
4551 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4552!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4553!$OMP SHARED(bo,v_laplace,deriv_data,rho1,v_xc,fac) COLLAPSE(3)
4554 DO k = bo(1, 3), bo(2, 3)
4555 DO j = bo(1, 2), bo(2, 2)
4556 DO i = bo(1, 1), bo(2, 1)
4557 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
4558 deriv_data(i, j, k)*rho1(i, j, k)
4559 END DO
4560 END DO
4561 END DO
4562 END IF
4563 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rho, deriv_norm_drho])
4564 IF (ASSOCIATED(deriv_att)) THEN
4565 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4566!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4567!$OMP SHARED(bo,v_laplace,deriv_data,dr1dr,v_drho,fac) COLLAPSE(3)
4568 DO k = bo(1, 3), bo(2, 3)
4569 DO j = bo(1, 2), bo(2, 2)
4570 DO i = bo(1, 1), bo(2, 1)
4571 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
4572 deriv_data(i, j, k)*dr1dr(i, j, k)
4573 END DO
4574 END DO
4575 END DO
4576 END IF
4577 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rho, deriv_tau])
4578 IF (ASSOCIATED(deriv_att)) THEN
4579 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4580!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4581!$OMP SHARED(bo,v_laplace,deriv_data,tau1,v_xc_tau,fac) COLLAPSE(3)
4582 DO k = bo(1, 3), bo(2, 3)
4583 DO j = bo(1, 2), bo(2, 2)
4584 DO i = bo(1, 1), bo(2, 1)
4585 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
4586 deriv_data(i, j, k)*tau1(i, j, k)
4587 END DO
4588 END DO
4589 END DO
4590 END IF
4592 IF (ASSOCIATED(deriv_att)) THEN
4593 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4594!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
4595!$OMP SHARED(bo,v_laplace,deriv_data,laplace1,fac) COLLAPSE(3)
4596 DO k = bo(1, 3), bo(2, 3)
4597 DO j = bo(1, 2), bo(2, 2)
4598 DO i = bo(1, 1), bo(2, 1)
4599 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + &
4600 deriv_data(i, j, k)*laplace1(i, j, k)
4601 END DO
4602 END DO
4603 END DO
4604 END IF
4605
4606
4607 IF (my_compute_virial) THEN
4608 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_laplace_rho])
4609 IF (ASSOCIATED(deriv_att)) THEN
4610 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
4611
4612 virial_pw%array(:, :, :) = -rho1(:, :, :)
4613 CALL virial_laplace(virial_pw, pw_pool, virial_xc, deriv_data)
4614 END IF
4615 END IF ! my_compute_virial
4616
4617
4618 IF (gradient_f) THEN
4619
4620 IF (my_compute_virial) THEN
4621 CALL virial_drho_drho(virial_pw, drho, v_drho(1), virial_xc)
4622 END IF ! my_compute_virial
4623
4624 IF (my_gapw) THEN
4625
4626 DO idir = 1, 3
4627!$OMP PARALLEL DO DEFAULT(NONE) &
4628!$OMP PRIVATE(ia,ir) &
4629!$OMP SHARED(bo,vxg,drho,v_drho,e_drho,drho1,idir,factor2) &
4630!$OMP COLLAPSE(2)
4631 DO ia = bo(1, 1), bo(2, 1)
4632 DO ir = bo(1, 2), bo(2, 2)
4633 vxg(idir, ia, ir, 1) = -drho(idir)%array(ia, ir, 1)*v_drho(1)%array(ia, ir, 1)
4634 IF (ASSOCIATED(e_drho)) THEN
4635 vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1) + factor2*drho1(idir)%array(ia, ir, 1)*e_drho(ia, ir, 1)
4636 END IF
4637 END DO
4638 END DO
4639!$OMP END PARALLEL DO
4640 END DO
4641
4642 ELSE
4643 ! partial integration
4644 DO idir = 1, 3
4645!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(v_drho_r,drho,v_drho,drho1,e_drho,idir)
4646 v_drho_r(idir, 1)%array(:, :, :) = drho(idir)%array(:, :, :)*v_drho(1)%array(:, :, :) - &
4647 drho1(idir)%array(:, :, :)*e_drho(:, :, :)
4648!$OMP END PARALLEL WORKSHARE
4649 END DO
4650
4651 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 1), tmp_g, vxc_g, v_xc(1))
4652 END IF
4653
4654 END IF
4655
4656 IF (laplace_f .AND. my_compute_virial) THEN
4657 virial_pw%array(:, :, :) = -rho(:, :, :)
4658 CALL virial_laplace(virial_pw, pw_pool, virial_xc, v_laplace(1)%array)
4659 END IF
4660
4661 END IF
4662
4663 IF (laplace_f) THEN
4664 DO ispin = 1, nspins
4665 CALL xc_pw_laplace(v_laplace(ispin), pw_pool, xc_deriv_method_id)
4666 CALL pw_axpy(v_laplace(ispin), v_xc(ispin))
4667 END DO
4668 END IF
4669
4670 IF (gradient_f) THEN
4671
4672 DO ispin = 1, nspins
4673 CALL deallocate_pw(v_drho(ispin), pw_pool)
4674 DO idir = 1, 3
4675 CALL deallocate_pw(v_drho_r(idir, ispin), pw_pool)
4676 END DO
4677 END DO
4678 DEALLOCATE (v_drho, v_drho_r)
4679
4680 END IF
4681
4682 IF (laplace_f) THEN
4683 DO ispin = 1, nspins
4684 CALL deallocate_pw(v_laplace(ispin), pw_pool)
4685 END DO
4686 DEALLOCATE (v_laplace)
4687 END IF
4688
4689 IF (ASSOCIATED(tmp_g%pw_grid) .AND. ASSOCIATED(pw_pool)) THEN
4690 CALL pw_pool%give_back_pw(tmp_g)
4691 END IF
4692
4693 IF (ASSOCIATED(vxc_g%pw_grid) .AND. ASSOCIATED(pw_pool)) THEN
4694 CALL pw_pool%give_back_pw(vxc_g)
4695 END IF
4696
4697 IF (my_compute_virial .AND. (gradient_f .OR. laplace_f)) THEN
4698 CALL deallocate_pw(virial_pw, pw_pool)
4699 END IF
4700
4701 CALL timestop(handle)
4702
4703 END SUBROUTINE xc_calc_2nd_deriv_analytical
4704
4705! **************************************************************************************************
4706!> \brief Calculates the third functional derivative of the exchange-correlation functional, E_xc.
4707!> Any GGA functional can be written as:
4708!>
4709!> E_xc[\rho] = \int e_xc(\rho,\nabla\rho)dr
4710!>
4711!> This routine gives you back the contraction of the derivatives of e_xc with respect to the
4712!> alpha or beta density or with respect to the norm of their gradients contracted with rho1.
4713!> For example, the alpha component would be (d stands for total derivative):
4714!>
4715!> d^3 e_xc
4716!> v_xc(1) = \sum_{s,s'}^{a,b} ---------------------\rhos1\rho1s'
4717!> d\rhoa d\rhos d\rhos'
4718!>
4719!> \param v_xc Third derivative of the exchange-correlation functional
4720!> \param v_xc_tau ...
4721!> \param deriv_set derivatives of the exchange-correlation potential, e_xc
4722!> \param rho_set object containing the density at which the derivatives were calculated, \rho
4723!> \param rho1_set object containing the density with which to fold, \rho1s
4724!> \param pw_pool the pool for the grids
4725!> \param xc_section XC parameters
4726!> \par History
4727!> * 07.2024 Created [LHS]
4728! **************************************************************************************************
4729 SUBROUTINE xc_calc_3rd_deriv_analytical(v_xc, v_xc_tau, deriv_set, rho_set, rho1_set, &
4730 pw_pool, xc_section, spinflip, gapw, vxg)
4731
4732 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: v_xc, v_xc_tau
4733 TYPE(xc_derivative_set_type) :: deriv_set
4734 TYPE(xc_rho_set_type), INTENT(IN) :: rho_set, rho1_set
4735 TYPE(pw_pool_type), POINTER :: pw_pool
4736 TYPE(section_vals_type), POINTER :: xc_section
4737 LOGICAL, INTENT(in), OPTIONAL :: spinflip
4738 LOGICAL, INTENT(IN), OPTIONAL :: gapw
4739 REAL(kind=dp), DIMENSION(:, :, :, :), OPTIONAL, POINTER :: vxg
4740
4741 CHARACTER(len=*), PARAMETER :: routinen = 'xc_calc_3rd_deriv_analytical'
4742
4743 INTEGER :: handle, i, idir, ispin, j, &
4744 k, nspins, xc_deriv_method_id
4745 INTEGER, DIMENSION(2, 3) :: bo
4746 LOGICAL :: my_gapw
4747 LOGICAL :: lsd, do_spinflip, alda0, &
4748 rho_f, gradient_f, tau_f, laplace_f
4749 REAL(kind=dp) :: s, s_thresh, s_thresh2, gradient_cut
4750 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: dr1dr, dra1dra, drb1drb, dr1dr1
4751 REAL(kind=dp) :: g1, g11, uu, aa, bb
4752 ! restricted meta-GGA (gamma formulation)
4753 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), TARGET :: zero_f
4754 TYPE(pw_r3d_rs_type), DIMENSION(:), ALLOCATABLE :: v_laplace
4755 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: tau1, laplace1
4756 ! open-shell meta-GGA
4757 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: tau1a, tau1b, laplace1a, laplace1b
4758 REAL(kind=dp) :: mp_rhoa, q_rhoa
4759 REAL(kind=dp) :: mp_rhob, q_rhob
4760 REAL(kind=dp) :: mp_gamma_aa, q_gamma_aa
4761 REAL(kind=dp) :: mp_gamma_ab, q_gamma_ab
4762 REAL(kind=dp) :: mp_gamma_bb, q_gamma_bb
4763 REAL(kind=dp) :: mp_laplace_rhoa, q_laplace_rhoa
4764 REAL(kind=dp) :: mp_laplace_rhob, q_laplace_rhob
4765 REAL(kind=dp) :: mp_tau_a, q_tau_a
4766 REAL(kind=dp) :: mp_tau_b, q_tau_b
4767 REAL(kind=dp) :: mpp_gamma_aa, nb_gamma_aa
4768 REAL(kind=dp) :: mpp_gamma_ab, nb_gamma_ab
4769 REAL(kind=dp) :: mpp_gamma_bb, nb_gamma_bb
4770 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa
4771 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob
4772 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa
4773 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab
4774 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_bb
4775 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhoa
4776 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhob
4777 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_tau_a
4778 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_tau_b
4779 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob
4780 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa
4781 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab
4782 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_bb
4783 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhoa
4784 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhob
4785 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_tau_a
4786 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_tau_b
4787 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa
4788 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab
4789 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_bb
4790 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhoa
4791 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhob
4792 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_tau_a
4793 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_tau_b
4794 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab
4795 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_bb
4796 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhoa
4797 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhob
4798 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_tau_a
4799 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_tau_b
4800 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_gamma_bb
4801 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhoa
4802 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhob
4803 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_tau_a
4804 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_tau_b
4805 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhoa
4806 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhob
4807 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_tau_a
4808 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_tau_b
4809 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_laplace_rhob
4810 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_tau_a
4811 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_tau_b
4812 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_a_tau_a
4813 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_a_tau_b
4814 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_b_tau_b
4815 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_rhoa
4816 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_rhob
4817 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_gamma_aa
4818 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_gamma_ab
4819 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_gamma_bb
4820 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_laplace_rhoa
4821 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_laplace_rhob
4822 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_tau_a
4823 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhoa_tau_b
4824 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_rhob
4825 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_gamma_aa
4826 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_gamma_ab
4827 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_gamma_bb
4828 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_laplace_rhoa
4829 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_laplace_rhob
4830 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_tau_a
4831 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_rhob_tau_b
4832 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_gamma_aa
4833 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_gamma_ab
4834 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_gamma_bb
4835 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_laplace_rhoa
4836 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_laplace_rhob
4837 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_tau_a
4838 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_aa_tau_b
4839 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab_gamma_ab
4840 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab_gamma_bb
4841 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab_laplace_rhoa
4842 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab_laplace_rhob
4843 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab_tau_a
4844 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_ab_tau_b
4845 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_bb_gamma_bb
4846 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_bb_laplace_rhoa
4847 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_bb_laplace_rhob
4848 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_bb_tau_a
4849 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_gamma_bb_tau_b
4850 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhoa_laplace_rhoa
4851 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhoa_laplace_rhob
4852 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhoa_tau_a
4853 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhoa_tau_b
4854 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhob_laplace_rhob
4855 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhob_tau_a
4856 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_laplace_rhob_tau_b
4857 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_tau_a_tau_a
4858 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_tau_a_tau_b
4859 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhoa_tau_b_tau_b
4860 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_rhob
4861 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_gamma_aa
4862 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_gamma_ab
4863 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_gamma_bb
4864 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_laplace_rhoa
4865 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_laplace_rhob
4866 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_tau_a
4867 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_rhob_tau_b
4868 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_gamma_aa
4869 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_gamma_ab
4870 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_gamma_bb
4871 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_laplace_rhoa
4872 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_laplace_rhob
4873 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_tau_a
4874 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_aa_tau_b
4875 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab_gamma_ab
4876 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab_gamma_bb
4877 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab_laplace_rhoa
4878 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab_laplace_rhob
4879 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab_tau_a
4880 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_ab_tau_b
4881 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_bb_gamma_bb
4882 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_bb_laplace_rhoa
4883 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_bb_laplace_rhob
4884 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_bb_tau_a
4885 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_gamma_bb_tau_b
4886 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhoa_laplace_rhoa
4887 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhoa_laplace_rhob
4888 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhoa_tau_a
4889 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhoa_tau_b
4890 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhob_laplace_rhob
4891 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhob_tau_a
4892 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_laplace_rhob_tau_b
4893 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_tau_a_tau_a
4894 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_tau_a_tau_b
4895 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_rhob_tau_b_tau_b
4896 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_gamma_aa
4897 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_gamma_ab
4898 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_gamma_bb
4899 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_laplace_rhoa
4900 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_laplace_rhob
4901 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_tau_a
4902 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_aa_tau_b
4903 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab_gamma_ab
4904 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab_gamma_bb
4905 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab_laplace_rhoa
4906 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab_laplace_rhob
4907 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab_tau_a
4908 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_ab_tau_b
4909 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_bb_gamma_bb
4910 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_bb_laplace_rhoa
4911 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_bb_laplace_rhob
4912 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_bb_tau_a
4913 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_gamma_bb_tau_b
4914 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhoa_laplace_rhoa
4915 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhoa_laplace_rhob
4916 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhoa_tau_a
4917 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhoa_tau_b
4918 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhob_laplace_rhob
4919 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhob_tau_a
4920 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_laplace_rhob_tau_b
4921 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_tau_a_tau_a
4922 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_tau_a_tau_b
4923 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_aa_tau_b_tau_b
4924 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab_gamma_ab
4925 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab_gamma_bb
4926 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab_laplace_rhoa
4927 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab_laplace_rhob
4928 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab_tau_a
4929 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_ab_tau_b
4930 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_bb_gamma_bb
4931 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_bb_laplace_rhoa
4932 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_bb_laplace_rhob
4933 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_bb_tau_a
4934 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_gamma_bb_tau_b
4935 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhoa_laplace_rhoa
4936 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhoa_laplace_rhob
4937 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhoa_tau_a
4938 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhoa_tau_b
4939 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhob_laplace_rhob
4940 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhob_tau_a
4941 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_laplace_rhob_tau_b
4942 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_tau_a_tau_a
4943 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_tau_a_tau_b
4944 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_ab_tau_b_tau_b
4945 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_gamma_bb_gamma_bb
4946 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_gamma_bb_laplace_rhoa
4947 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_gamma_bb_laplace_rhob
4948 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_gamma_bb_tau_a
4949 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_gamma_bb_tau_b
4950 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhoa_laplace_rhoa
4951 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhoa_laplace_rhob
4952 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhoa_tau_a
4953 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhoa_tau_b
4954 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhob_laplace_rhob
4955 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhob_tau_a
4956 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_laplace_rhob_tau_b
4957 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_tau_a_tau_a
4958 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_tau_a_tau_b
4959 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_gamma_bb_tau_b_tau_b
4960 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhoa_laplace_rhoa
4961 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhoa_laplace_rhob
4962 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhoa_tau_a
4963 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhoa_tau_b
4964 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhob_laplace_rhob
4965 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhob_tau_a
4966 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_laplace_rhob_tau_b
4967 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_tau_a_tau_a
4968 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_tau_a_tau_b
4969 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhoa_tau_b_tau_b
4970 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_laplace_rhob_laplace_rhob
4971 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_laplace_rhob_tau_a
4972 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_laplace_rhob_tau_b
4973 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_tau_a_tau_a
4974 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_tau_a_tau_b
4975 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_laplace_rhob_tau_b_tau_b
4976 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_a_tau_a_tau_a
4977 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_a_tau_a_tau_b
4978 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_a_tau_b_tau_b
4979 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: n_tau_b_tau_b_tau_b
4980 REAL(kind=dp) :: mp_rho, mp_gamma, mp_laplace_rho, mp_tau, mpp_gamma
4981 REAL(kind=dp) :: m_rho, m_gamma, m_laplace_rho, m_tau, m_b
4982 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_rho
4983 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_gamma
4984 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_laplace_rho
4985 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_tau
4986 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_gamma
4987 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_laplace_rho
4988 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_tau
4989 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_laplace_rho_laplace_rho
4990 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_laplace_rho_tau
4991 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_tau_tau
4992 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_rho_rho
4993 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_rho_gamma
4994 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_rho_laplace_rho
4995 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_rho_tau
4996 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_gamma_gamma
4997 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_gamma_laplace_rho
4998 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_gamma_tau
4999 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_laplace_rho_laplace_rho
5000 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_laplace_rho_tau
5001 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_rho_tau_tau
5002 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_gamma_gamma
5003 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_gamma_laplace_rho
5004 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_gamma_tau
5005 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_laplace_rho_laplace_rho
5006 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_laplace_rho_tau
5007 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_gamma_tau_tau
5008 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_laplace_rho_laplace_rho_laplace_rho
5009 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_laplace_rho_laplace_rho_tau
5010 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_laplace_rho_tau_tau
5011 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: m_tau_tau_tau
5012 ! open-shell gamma formulation
5013 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: gaa1, gab1, gbb1, gaa11, gab11, gbb11
5014 REAL(kind=dp) :: p_rhoa, p_rhob, p_gamma_aa, p_gamma_ab, p_gamma_bb
5015 REAL(kind=dp) :: pp_gamma_aa, pp_gamma_ab, pp_gamma_bb
5016 REAL(kind=dp) :: u_a, u_b, a_gamma_aa, a_gamma_ab, a_gamma_bb, &
5017 b_gamma_aa, b_gamma_ab, b_gamma_bb
5018 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhoa
5019 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhob
5020 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_aa
5021 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_ab
5022 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_bb
5023 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_rhob
5024 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_aa
5025 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_ab
5026 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_bb
5027 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_aa
5028 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_ab
5029 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_bb
5030 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_ab_gamma_ab
5031 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_ab_gamma_bb
5032 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_bb_gamma_bb
5033 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhoa_rhoa
5034 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhoa_rhob
5035 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhoa_gamma_aa
5036 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhoa_gamma_ab
5037 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhoa_gamma_bb
5038 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhob_rhob
5039 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhob_gamma_aa
5040 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhob_gamma_ab
5041 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_rhob_gamma_bb
5042 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_aa_gamma_aa
5043 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_aa_gamma_ab
5044 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_aa_gamma_bb
5045 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_ab_gamma_ab
5046 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_ab_gamma_bb
5047 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhoa_gamma_bb_gamma_bb
5048 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_rhob_rhob
5049 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_rhob_gamma_aa
5050 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_rhob_gamma_ab
5051 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_rhob_gamma_bb
5052 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_aa_gamma_aa
5053 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_aa_gamma_ab
5054 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_aa_gamma_bb
5055 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_ab_gamma_ab
5056 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_ab_gamma_bb
5057 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_rhob_gamma_bb_gamma_bb
5058 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_aa_gamma_aa
5059 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_aa_gamma_ab
5060 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_aa_gamma_bb
5061 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_ab_gamma_ab
5062 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_ab_gamma_bb
5063 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_aa_gamma_bb_gamma_bb
5064 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_ab_gamma_ab_gamma_ab
5065 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_ab_gamma_ab_gamma_bb
5066 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_ab_gamma_bb_gamma_bb
5067 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: g_gamma_bb_gamma_bb_gamma_bb
5068 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: deriv_data, deriv_data2, e_drhoa, e_drhob, &
5069 e_drho, norm_drho, norm_drhoa, &
5070 norm_drhob, rho1a, rho1b, &
5071 rhoa, rhob, rho1, &
5072 e_rrr, e_rrg, e_rgg, e_ggg, e_rg, e_gg
5073 TYPE(cp_3d_r_cp_type), DIMENSION(3) :: drho, drho1, drho1a, drho1b, drhoa, drhob
5074 TYPE(pw_r3d_rs_type), DIMENSION(:), ALLOCATABLE :: v_drhoa, v_drhob, v_drho
5075 TYPE(pw_r3d_rs_type), DIMENSION(:, :), ALLOCATABLE :: v_drho_r
5076 TYPE(pw_c1d_gs_type) :: tmp_g, vxc_g
5077 TYPE(xc_derivative_type), POINTER :: deriv_att
5078
5079 CALL timeset(routinen, handle)
5080
5081 NULLIFY (e_drhoa, e_drhob, e_drho)
5082
5083 cpassert(ASSOCIATED(v_xc))
5084 cpassert(ASSOCIATED(xc_section))
5085
5086 ! Initialize parameters
5087 CALL section_vals_val_get(xc_section, "XC_GRID%XC_DERIV", &
5088 i_val=xc_deriv_method_id)
5089 !
5090 nspins = SIZE(v_xc)
5091 lsd = ASSOCIATED(rho_set%rhoa)
5092 !
5093 do_spinflip = .false.
5094 IF (PRESENT(spinflip)) do_spinflip = spinflip
5095 my_gapw = .false.
5096 IF (PRESENT(gapw)) my_gapw = gapw
5097 IF (my_gapw) THEN
5098 cpassert(PRESENT(vxg))
5099 ! the atomic path integrates the gradient channel itself, and CP2K does
5100 ! not support Laplacian-dependent functionals in GAPW at all
5101 IF (laplace_f) cpabort("Laplace-dependent functional not implemented with GAPW!")
5102 END IF
5103 !
5104 bo = rho_set%local_bounds
5105 !
5106 CALL check_for_derivatives(deriv_set, lsd, rho_f, gradient_f, tau_f, laplace_f)
5107 !
5108 CALL xc_rho_set_get(rho_set, drho_cutoff=gradient_cut)
5109 !
5110 !S_THRESH has to be the same as S_THRESH in xc_calc_2nd_deriv_analytical
5111 alda0 = .false.
5112 s_thresh = 1.0e-04_dp
5113 s_thresh2 = 1.0e-07_dp
5114
5115 ! Initialize potential
5116 DO ispin = 1, nspins
5117 !CALL pw_zero(v_xc(ispin))
5118 v_xc(ispin)%array = 0.0_dp
5119 END DO
5120
5121 ! Create GGA fields
5122 IF (gradient_f) THEN
5123 ALLOCATE (v_drho_r(3, nspins), v_drho(nspins))
5124 DO ispin = 1, nspins
5125 DO idir = 1, 3
5126 CALL allocate_pw(v_drho_r(idir, ispin), pw_pool, bo)
5127 END DO
5128 CALL allocate_pw(v_drho(ispin), pw_pool, bo)
5129 END DO
5130
5131 IF (xc_requires_tmp_g(xc_deriv_method_id)) THEN
5132 IF (ASSOCIATED(pw_pool)) THEN
5133 CALL pw_pool%create_pw(tmp_g)
5134 CALL pw_pool%create_pw(vxc_g)
5135 ELSE
5136 ! remember to refix for gapw
5137 cpabort("XC_DERIV method is not implemented in GAPW")
5138 END IF
5139 END IF
5140
5141 END IF
5142
5143 ! Initialize mGGA potential
5144 IF (tau_f) THEN
5145 cpassert(ASSOCIATED(v_xc_tau))
5146 DO ispin = 1, nspins
5147 v_xc_tau(ispin)%array = 0.0_dp
5148 END DO
5149 END IF
5150
5151 IF (lsd) THEN
5152
5153 !-------------------!
5154 ! UNrestricted case !
5155 !-------------------!
5156
5157 IF (do_spinflip) THEN
5158 CALL xc_rho_set_get(rho1_set, rhoa=rho1a)
5159 CALL xc_rho_set_get(rho_set, rhoa=rhoa, rhob=rhob)
5160 ELSE
5161 CALL xc_rho_set_get(rho1_set, rhoa=rho1a, rhob=rho1b)
5162 END IF
5163
5164 IF (gradient_f) THEN
5165 CALL xc_rho_set_get(rho_set, drhoa=drhoa, drhob=drhob, &
5166 norm_drho=norm_drho, norm_drhoa=norm_drhoa, norm_drhob=norm_drhob)
5167 IF (do_spinflip) THEN
5168 CALL xc_rho_set_get(rho1_set, drhoa=drho1a)
5169 CALL calc_drho_from_a(drho1, drho1a)
5170 ELSE
5171 CALL xc_rho_set_get(rho1_set, drhoa=drho1a, drhob=drho1b)
5172 CALL calc_drho_from_ab(drho1, drho1a, drho1b)
5173 END IF
5174
5175 CALL calc_drho_from_ab(drho, drhoa, drhob)
5176
5177 CALL prepare_dr1dr(dra1dra, drhoa, drho1a)
5178 IF (do_spinflip) THEN
5179 CALL prepare_dr1dr(drb1drb, drhob, drho1a)
5180 CALL prepare_dr1dr(dr1dr, drho, drho1a)
5181 ELSE IF (nspins /= 1) THEN
5182 CALL prepare_dr1dr(drb1drb, drhob, drho1b)
5183 CALL prepare_dr1dr(dr1dr, drho, drho1)
5184 ELSE
5185 cpabort("Exchange-correlation's third derivative for closed-shell not yet implemented")
5186 END IF
5187
5188 ! Create vectors for partial integration term
5189 ALLOCATE (v_drhoa(nspins), v_drhob(nspins))
5190 DO ispin = 1, nspins
5191 CALL allocate_pw(v_drhoa(ispin), pw_pool, bo)
5192 CALL allocate_pw(v_drhob(ispin), pw_pool, bo)
5193 END DO
5194
5195 END IF
5196
5197 ! The gamma formulation below covers tau and the Laplacian for the
5198 ! ordinary unrestricted case; the spin-flip kernel and the closed-shell
5199 ! triplet path are still LDA/GGA only.
5200 IF (laplace_f .AND. (do_spinflip .OR. nspins == 1)) THEN
5201 cpabort("Exchange-correlation's laplace analytic third derivative not implemented")
5202 END IF
5203
5204 IF (tau_f .AND. (do_spinflip .OR. nspins == 1)) THEN
5205 cpabort("Exchange-correlation's mGGA analytic third derivative not implemented")
5206 END IF
5207
5208 IF (nspins /= 1) THEN
5209
5210 IF (.NOT. do_spinflip) THEN
5211
5212 ! Spin-polarized third derivative in the reduced-gradient variables
5213 ! gamma_ij = grad rho_i . grad rho_j, contracted twice with rho1:
5214 !
5215 ! u_s = sum_XY e_{rho_s X Y} X1 Y1 + sum_K e_{rho_s gK} gK11
5216 ! A_K = sum_XY e_{gK X Y} X1 Y1 + sum_L e_{gK gL} gL11
5217 ! B_K = sum_Y e_{gK Y} Y1
5218 ! v_a = 2 grad rhoa A_aa + grad rhob A_ab
5219 ! + 2 ( 2 grad rho1a B_aa + grad rho1b B_ab )
5220 !
5221 ! and g_xc,s = u_s - div(v_s). X, Y run over rhoa, rhob and the three
5222 ! gammas. Nothing here divides by |grad rho|.
5223
5224 IF (tau_f .OR. laplace_f) THEN
5225
5226 ! Spin-polarized meta-GGA. The same gamma formulation, with the
5227 ! variable set widened to nine: rhoa, rhob, the three gammas,
5228 ! the two Laplacians and the two taus. Only gamma is nonlinear
5229 ! in the density, so only it carries a second variation.
5230
5231 CALL xc_rho_set_get(rho_set, drhoa=drhoa, drhob=drhob)
5232 CALL xc_rho_set_get(rho1_set, drhoa=drho1a, drhob=drho1b)
5233 IF (tau_f) CALL xc_rho_set_get(rho1_set, tau_a=tau1a, tau_b=tau1b)
5234 IF (laplace_f) CALL xc_rho_set_get(rho1_set, laplace_rhoa=laplace1a, &
5235 laplace_rhob=laplace1b)
5236 CALL prepare_dr1dr(gaa1, drhoa, drho1a)
5237 CALL prepare_dr1dr(gbb1, drhob, drho1b)
5238 CALL prepare_dr1dr(gab1, drhoa, drho1b)
5239 CALL prepare_dr1dr(gaa11, drho1a, drho1a)
5240 CALL prepare_dr1dr(gbb11, drho1b, drho1b)
5241 CALL prepare_dr1dr(gab11, drho1a, drho1b)
5242 block
5243 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: tmp_ba
5244 CALL prepare_dr1dr(tmp_ba, drhob, drho1a)
5245 gab1(:, :, :) = gab1(:, :, :) + tmp_ba(:, :, :)
5246 END block
5247
5248 ALLOCATE (zero_f(bo(1, 1):bo(2, 1), bo(1, 2):bo(2, 2), bo(1, 3):bo(2, 3)))
5249 zero_f = 0.0_dp
5250 deriv_att => xc_dset_get_derivative(deriv_set, &
5252 IF (ASSOCIATED(deriv_att)) THEN
5253 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa)
5254 ELSE
5255 n_rhoa_rhoa => zero_f
5256 END IF
5257 deriv_att => xc_dset_get_derivative(deriv_set, &
5259 IF (ASSOCIATED(deriv_att)) THEN
5260 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob)
5261 ELSE
5262 n_rhoa_rhob => zero_f
5263 END IF
5264 deriv_att => xc_dset_get_derivative(deriv_set, &
5266 IF (ASSOCIATED(deriv_att)) THEN
5267 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa)
5268 ELSE
5269 n_rhoa_gamma_aa => zero_f
5270 END IF
5271 deriv_att => xc_dset_get_derivative(deriv_set, &
5273 IF (ASSOCIATED(deriv_att)) THEN
5274 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab)
5275 ELSE
5276 n_rhoa_gamma_ab => zero_f
5277 END IF
5278 deriv_att => xc_dset_get_derivative(deriv_set, &
5280 IF (ASSOCIATED(deriv_att)) THEN
5281 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_bb)
5282 ELSE
5283 n_rhoa_gamma_bb => zero_f
5284 END IF
5285 deriv_att => xc_dset_get_derivative(deriv_set, &
5287 IF (ASSOCIATED(deriv_att)) THEN
5288 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhoa)
5289 ELSE
5290 n_rhoa_laplace_rhoa => zero_f
5291 END IF
5292 deriv_att => xc_dset_get_derivative(deriv_set, &
5294 IF (ASSOCIATED(deriv_att)) THEN
5295 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhob)
5296 ELSE
5297 n_rhoa_laplace_rhob => zero_f
5298 END IF
5299 deriv_att => xc_dset_get_derivative(deriv_set, &
5301 IF (ASSOCIATED(deriv_att)) THEN
5302 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_tau_a)
5303 ELSE
5304 n_rhoa_tau_a => zero_f
5305 END IF
5306 deriv_att => xc_dset_get_derivative(deriv_set, &
5308 IF (ASSOCIATED(deriv_att)) THEN
5309 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_tau_b)
5310 ELSE
5311 n_rhoa_tau_b => zero_f
5312 END IF
5313 deriv_att => xc_dset_get_derivative(deriv_set, &
5315 IF (ASSOCIATED(deriv_att)) THEN
5316 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob)
5317 ELSE
5318 n_rhob_rhob => zero_f
5319 END IF
5320 deriv_att => xc_dset_get_derivative(deriv_set, &
5322 IF (ASSOCIATED(deriv_att)) THEN
5323 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa)
5324 ELSE
5325 n_rhob_gamma_aa => zero_f
5326 END IF
5327 deriv_att => xc_dset_get_derivative(deriv_set, &
5329 IF (ASSOCIATED(deriv_att)) THEN
5330 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab)
5331 ELSE
5332 n_rhob_gamma_ab => zero_f
5333 END IF
5334 deriv_att => xc_dset_get_derivative(deriv_set, &
5336 IF (ASSOCIATED(deriv_att)) THEN
5337 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_bb)
5338 ELSE
5339 n_rhob_gamma_bb => zero_f
5340 END IF
5341 deriv_att => xc_dset_get_derivative(deriv_set, &
5343 IF (ASSOCIATED(deriv_att)) THEN
5344 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhoa)
5345 ELSE
5346 n_rhob_laplace_rhoa => zero_f
5347 END IF
5348 deriv_att => xc_dset_get_derivative(deriv_set, &
5350 IF (ASSOCIATED(deriv_att)) THEN
5351 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhob)
5352 ELSE
5353 n_rhob_laplace_rhob => zero_f
5354 END IF
5355 deriv_att => xc_dset_get_derivative(deriv_set, &
5357 IF (ASSOCIATED(deriv_att)) THEN
5358 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_tau_a)
5359 ELSE
5360 n_rhob_tau_a => zero_f
5361 END IF
5362 deriv_att => xc_dset_get_derivative(deriv_set, &
5364 IF (ASSOCIATED(deriv_att)) THEN
5365 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_tau_b)
5366 ELSE
5367 n_rhob_tau_b => zero_f
5368 END IF
5369 deriv_att => xc_dset_get_derivative(deriv_set, &
5371 IF (ASSOCIATED(deriv_att)) THEN
5372 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa)
5373 ELSE
5374 n_gamma_aa_gamma_aa => zero_f
5375 END IF
5376 deriv_att => xc_dset_get_derivative(deriv_set, &
5378 IF (ASSOCIATED(deriv_att)) THEN
5379 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab)
5380 ELSE
5381 n_gamma_aa_gamma_ab => zero_f
5382 END IF
5383 deriv_att => xc_dset_get_derivative(deriv_set, &
5385 IF (ASSOCIATED(deriv_att)) THEN
5386 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_bb)
5387 ELSE
5388 n_gamma_aa_gamma_bb => zero_f
5389 END IF
5390 deriv_att => xc_dset_get_derivative(deriv_set, &
5392 IF (ASSOCIATED(deriv_att)) THEN
5393 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhoa)
5394 ELSE
5395 n_gamma_aa_laplace_rhoa => zero_f
5396 END IF
5397 deriv_att => xc_dset_get_derivative(deriv_set, &
5399 IF (ASSOCIATED(deriv_att)) THEN
5400 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhob)
5401 ELSE
5402 n_gamma_aa_laplace_rhob => zero_f
5403 END IF
5404 deriv_att => xc_dset_get_derivative(deriv_set, &
5406 IF (ASSOCIATED(deriv_att)) THEN
5407 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_tau_a)
5408 ELSE
5409 n_gamma_aa_tau_a => zero_f
5410 END IF
5411 deriv_att => xc_dset_get_derivative(deriv_set, &
5413 IF (ASSOCIATED(deriv_att)) THEN
5414 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_tau_b)
5415 ELSE
5416 n_gamma_aa_tau_b => zero_f
5417 END IF
5418 deriv_att => xc_dset_get_derivative(deriv_set, &
5420 IF (ASSOCIATED(deriv_att)) THEN
5421 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab)
5422 ELSE
5423 n_gamma_ab_gamma_ab => zero_f
5424 END IF
5425 deriv_att => xc_dset_get_derivative(deriv_set, &
5427 IF (ASSOCIATED(deriv_att)) THEN
5428 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_bb)
5429 ELSE
5430 n_gamma_ab_gamma_bb => zero_f
5431 END IF
5432 deriv_att => xc_dset_get_derivative(deriv_set, &
5434 IF (ASSOCIATED(deriv_att)) THEN
5435 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhoa)
5436 ELSE
5437 n_gamma_ab_laplace_rhoa => zero_f
5438 END IF
5439 deriv_att => xc_dset_get_derivative(deriv_set, &
5441 IF (ASSOCIATED(deriv_att)) THEN
5442 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhob)
5443 ELSE
5444 n_gamma_ab_laplace_rhob => zero_f
5445 END IF
5446 deriv_att => xc_dset_get_derivative(deriv_set, &
5448 IF (ASSOCIATED(deriv_att)) THEN
5449 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_tau_a)
5450 ELSE
5451 n_gamma_ab_tau_a => zero_f
5452 END IF
5453 deriv_att => xc_dset_get_derivative(deriv_set, &
5455 IF (ASSOCIATED(deriv_att)) THEN
5456 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_tau_b)
5457 ELSE
5458 n_gamma_ab_tau_b => zero_f
5459 END IF
5460 deriv_att => xc_dset_get_derivative(deriv_set, &
5462 IF (ASSOCIATED(deriv_att)) THEN
5463 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_gamma_bb)
5464 ELSE
5465 n_gamma_bb_gamma_bb => zero_f
5466 END IF
5467 deriv_att => xc_dset_get_derivative(deriv_set, &
5469 IF (ASSOCIATED(deriv_att)) THEN
5470 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhoa)
5471 ELSE
5472 n_gamma_bb_laplace_rhoa => zero_f
5473 END IF
5474 deriv_att => xc_dset_get_derivative(deriv_set, &
5476 IF (ASSOCIATED(deriv_att)) THEN
5477 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhob)
5478 ELSE
5479 n_gamma_bb_laplace_rhob => zero_f
5480 END IF
5481 deriv_att => xc_dset_get_derivative(deriv_set, &
5483 IF (ASSOCIATED(deriv_att)) THEN
5484 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_tau_a)
5485 ELSE
5486 n_gamma_bb_tau_a => zero_f
5487 END IF
5488 deriv_att => xc_dset_get_derivative(deriv_set, &
5490 IF (ASSOCIATED(deriv_att)) THEN
5491 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_tau_b)
5492 ELSE
5493 n_gamma_bb_tau_b => zero_f
5494 END IF
5495 deriv_att => xc_dset_get_derivative(deriv_set, &
5497 IF (ASSOCIATED(deriv_att)) THEN
5498 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhoa)
5499 ELSE
5500 n_laplace_rhoa_laplace_rhoa => zero_f
5501 END IF
5502 deriv_att => xc_dset_get_derivative(deriv_set, &
5504 IF (ASSOCIATED(deriv_att)) THEN
5505 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhob)
5506 ELSE
5507 n_laplace_rhoa_laplace_rhob => zero_f
5508 END IF
5509 deriv_att => xc_dset_get_derivative(deriv_set, &
5511 IF (ASSOCIATED(deriv_att)) THEN
5512 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_tau_a)
5513 ELSE
5514 n_laplace_rhoa_tau_a => zero_f
5515 END IF
5516 deriv_att => xc_dset_get_derivative(deriv_set, &
5518 IF (ASSOCIATED(deriv_att)) THEN
5519 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_tau_b)
5520 ELSE
5521 n_laplace_rhoa_tau_b => zero_f
5522 END IF
5523 deriv_att => xc_dset_get_derivative(deriv_set, &
5525 IF (ASSOCIATED(deriv_att)) THEN
5526 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_laplace_rhob)
5527 ELSE
5528 n_laplace_rhob_laplace_rhob => zero_f
5529 END IF
5530 deriv_att => xc_dset_get_derivative(deriv_set, &
5532 IF (ASSOCIATED(deriv_att)) THEN
5533 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_tau_a)
5534 ELSE
5535 n_laplace_rhob_tau_a => zero_f
5536 END IF
5537 deriv_att => xc_dset_get_derivative(deriv_set, &
5539 IF (ASSOCIATED(deriv_att)) THEN
5540 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_tau_b)
5541 ELSE
5542 n_laplace_rhob_tau_b => zero_f
5543 END IF
5544 deriv_att => xc_dset_get_derivative(deriv_set, &
5546 IF (ASSOCIATED(deriv_att)) THEN
5547 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_a_tau_a)
5548 ELSE
5549 n_tau_a_tau_a => zero_f
5550 END IF
5551 deriv_att => xc_dset_get_derivative(deriv_set, &
5553 IF (ASSOCIATED(deriv_att)) THEN
5554 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_a_tau_b)
5555 ELSE
5556 n_tau_a_tau_b => zero_f
5557 END IF
5558 deriv_att => xc_dset_get_derivative(deriv_set, &
5560 IF (ASSOCIATED(deriv_att)) THEN
5561 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_b_tau_b)
5562 ELSE
5563 n_tau_b_tau_b => zero_f
5564 END IF
5565 deriv_att => xc_dset_get_derivative(deriv_set, &
5567 IF (ASSOCIATED(deriv_att)) THEN
5568 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_rhoa)
5569 ELSE
5570 n_rhoa_rhoa_rhoa => zero_f
5571 END IF
5572 deriv_att => xc_dset_get_derivative(deriv_set, &
5574 IF (ASSOCIATED(deriv_att)) THEN
5575 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_rhob)
5576 ELSE
5577 n_rhoa_rhoa_rhob => zero_f
5578 END IF
5579 deriv_att => xc_dset_get_derivative(deriv_set, &
5581 IF (ASSOCIATED(deriv_att)) THEN
5582 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_gamma_aa)
5583 ELSE
5584 n_rhoa_rhoa_gamma_aa => zero_f
5585 END IF
5586 deriv_att => xc_dset_get_derivative(deriv_set, &
5588 IF (ASSOCIATED(deriv_att)) THEN
5589 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_gamma_ab)
5590 ELSE
5591 n_rhoa_rhoa_gamma_ab => zero_f
5592 END IF
5593 deriv_att => xc_dset_get_derivative(deriv_set, &
5595 IF (ASSOCIATED(deriv_att)) THEN
5596 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_gamma_bb)
5597 ELSE
5598 n_rhoa_rhoa_gamma_bb => zero_f
5599 END IF
5600 deriv_att => xc_dset_get_derivative(deriv_set, &
5602 IF (ASSOCIATED(deriv_att)) THEN
5603 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_laplace_rhoa)
5604 ELSE
5605 n_rhoa_rhoa_laplace_rhoa => zero_f
5606 END IF
5607 deriv_att => xc_dset_get_derivative(deriv_set, &
5609 IF (ASSOCIATED(deriv_att)) THEN
5610 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_laplace_rhob)
5611 ELSE
5612 n_rhoa_rhoa_laplace_rhob => zero_f
5613 END IF
5614 deriv_att => xc_dset_get_derivative(deriv_set, &
5616 IF (ASSOCIATED(deriv_att)) THEN
5617 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_tau_a)
5618 ELSE
5619 n_rhoa_rhoa_tau_a => zero_f
5620 END IF
5621 deriv_att => xc_dset_get_derivative(deriv_set, &
5623 IF (ASSOCIATED(deriv_att)) THEN
5624 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhoa_tau_b)
5625 ELSE
5626 n_rhoa_rhoa_tau_b => zero_f
5627 END IF
5628 deriv_att => xc_dset_get_derivative(deriv_set, &
5630 IF (ASSOCIATED(deriv_att)) THEN
5631 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_rhob)
5632 ELSE
5633 n_rhoa_rhob_rhob => zero_f
5634 END IF
5635 deriv_att => xc_dset_get_derivative(deriv_set, &
5637 IF (ASSOCIATED(deriv_att)) THEN
5638 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_gamma_aa)
5639 ELSE
5640 n_rhoa_rhob_gamma_aa => zero_f
5641 END IF
5642 deriv_att => xc_dset_get_derivative(deriv_set, &
5644 IF (ASSOCIATED(deriv_att)) THEN
5645 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_gamma_ab)
5646 ELSE
5647 n_rhoa_rhob_gamma_ab => zero_f
5648 END IF
5649 deriv_att => xc_dset_get_derivative(deriv_set, &
5651 IF (ASSOCIATED(deriv_att)) THEN
5652 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_gamma_bb)
5653 ELSE
5654 n_rhoa_rhob_gamma_bb => zero_f
5655 END IF
5656 deriv_att => xc_dset_get_derivative(deriv_set, &
5658 IF (ASSOCIATED(deriv_att)) THEN
5659 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_laplace_rhoa)
5660 ELSE
5661 n_rhoa_rhob_laplace_rhoa => zero_f
5662 END IF
5663 deriv_att => xc_dset_get_derivative(deriv_set, &
5665 IF (ASSOCIATED(deriv_att)) THEN
5666 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_laplace_rhob)
5667 ELSE
5668 n_rhoa_rhob_laplace_rhob => zero_f
5669 END IF
5670 deriv_att => xc_dset_get_derivative(deriv_set, &
5672 IF (ASSOCIATED(deriv_att)) THEN
5673 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_tau_a)
5674 ELSE
5675 n_rhoa_rhob_tau_a => zero_f
5676 END IF
5677 deriv_att => xc_dset_get_derivative(deriv_set, &
5679 IF (ASSOCIATED(deriv_att)) THEN
5680 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_rhob_tau_b)
5681 ELSE
5682 n_rhoa_rhob_tau_b => zero_f
5683 END IF
5684 deriv_att => xc_dset_get_derivative(deriv_set, &
5686 IF (ASSOCIATED(deriv_att)) THEN
5687 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_gamma_aa)
5688 ELSE
5689 n_rhoa_gamma_aa_gamma_aa => zero_f
5690 END IF
5691 deriv_att => xc_dset_get_derivative(deriv_set, &
5693 IF (ASSOCIATED(deriv_att)) THEN
5694 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_gamma_ab)
5695 ELSE
5696 n_rhoa_gamma_aa_gamma_ab => zero_f
5697 END IF
5698 deriv_att => xc_dset_get_derivative(deriv_set, &
5700 IF (ASSOCIATED(deriv_att)) THEN
5701 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_gamma_bb)
5702 ELSE
5703 n_rhoa_gamma_aa_gamma_bb => zero_f
5704 END IF
5705 deriv_att => xc_dset_get_derivative(deriv_set, &
5707 IF (ASSOCIATED(deriv_att)) THEN
5708 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_laplace_rhoa)
5709 ELSE
5710 n_rhoa_gamma_aa_laplace_rhoa => zero_f
5711 END IF
5712 deriv_att => xc_dset_get_derivative(deriv_set, &
5714 IF (ASSOCIATED(deriv_att)) THEN
5715 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_laplace_rhob)
5716 ELSE
5717 n_rhoa_gamma_aa_laplace_rhob => zero_f
5718 END IF
5719 deriv_att => xc_dset_get_derivative(deriv_set, &
5721 IF (ASSOCIATED(deriv_att)) THEN
5722 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_tau_a)
5723 ELSE
5724 n_rhoa_gamma_aa_tau_a => zero_f
5725 END IF
5726 deriv_att => xc_dset_get_derivative(deriv_set, &
5728 IF (ASSOCIATED(deriv_att)) THEN
5729 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_aa_tau_b)
5730 ELSE
5731 n_rhoa_gamma_aa_tau_b => zero_f
5732 END IF
5733 deriv_att => xc_dset_get_derivative(deriv_set, &
5735 IF (ASSOCIATED(deriv_att)) THEN
5736 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab_gamma_ab)
5737 ELSE
5738 n_rhoa_gamma_ab_gamma_ab => zero_f
5739 END IF
5740 deriv_att => xc_dset_get_derivative(deriv_set, &
5742 IF (ASSOCIATED(deriv_att)) THEN
5743 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab_gamma_bb)
5744 ELSE
5745 n_rhoa_gamma_ab_gamma_bb => zero_f
5746 END IF
5747 deriv_att => xc_dset_get_derivative(deriv_set, &
5749 IF (ASSOCIATED(deriv_att)) THEN
5750 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab_laplace_rhoa)
5751 ELSE
5752 n_rhoa_gamma_ab_laplace_rhoa => zero_f
5753 END IF
5754 deriv_att => xc_dset_get_derivative(deriv_set, &
5756 IF (ASSOCIATED(deriv_att)) THEN
5757 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab_laplace_rhob)
5758 ELSE
5759 n_rhoa_gamma_ab_laplace_rhob => zero_f
5760 END IF
5761 deriv_att => xc_dset_get_derivative(deriv_set, &
5763 IF (ASSOCIATED(deriv_att)) THEN
5764 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab_tau_a)
5765 ELSE
5766 n_rhoa_gamma_ab_tau_a => zero_f
5767 END IF
5768 deriv_att => xc_dset_get_derivative(deriv_set, &
5770 IF (ASSOCIATED(deriv_att)) THEN
5771 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_ab_tau_b)
5772 ELSE
5773 n_rhoa_gamma_ab_tau_b => zero_f
5774 END IF
5775 deriv_att => xc_dset_get_derivative(deriv_set, &
5777 IF (ASSOCIATED(deriv_att)) THEN
5778 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_bb_gamma_bb)
5779 ELSE
5780 n_rhoa_gamma_bb_gamma_bb => zero_f
5781 END IF
5782 deriv_att => xc_dset_get_derivative(deriv_set, &
5784 IF (ASSOCIATED(deriv_att)) THEN
5785 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_bb_laplace_rhoa)
5786 ELSE
5787 n_rhoa_gamma_bb_laplace_rhoa => zero_f
5788 END IF
5789 deriv_att => xc_dset_get_derivative(deriv_set, &
5791 IF (ASSOCIATED(deriv_att)) THEN
5792 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_bb_laplace_rhob)
5793 ELSE
5794 n_rhoa_gamma_bb_laplace_rhob => zero_f
5795 END IF
5796 deriv_att => xc_dset_get_derivative(deriv_set, &
5798 IF (ASSOCIATED(deriv_att)) THEN
5799 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_bb_tau_a)
5800 ELSE
5801 n_rhoa_gamma_bb_tau_a => zero_f
5802 END IF
5803 deriv_att => xc_dset_get_derivative(deriv_set, &
5805 IF (ASSOCIATED(deriv_att)) THEN
5806 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_gamma_bb_tau_b)
5807 ELSE
5808 n_rhoa_gamma_bb_tau_b => zero_f
5809 END IF
5810 deriv_att => xc_dset_get_derivative(deriv_set, &
5812 IF (ASSOCIATED(deriv_att)) THEN
5813 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhoa_laplace_rhoa)
5814 ELSE
5815 n_rhoa_laplace_rhoa_laplace_rhoa => zero_f
5816 END IF
5817 deriv_att => xc_dset_get_derivative(deriv_set, &
5819 IF (ASSOCIATED(deriv_att)) THEN
5820 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhoa_laplace_rhob)
5821 ELSE
5822 n_rhoa_laplace_rhoa_laplace_rhob => zero_f
5823 END IF
5824 deriv_att => xc_dset_get_derivative(deriv_set, &
5826 IF (ASSOCIATED(deriv_att)) THEN
5827 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhoa_tau_a)
5828 ELSE
5829 n_rhoa_laplace_rhoa_tau_a => zero_f
5830 END IF
5831 deriv_att => xc_dset_get_derivative(deriv_set, &
5833 IF (ASSOCIATED(deriv_att)) THEN
5834 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhoa_tau_b)
5835 ELSE
5836 n_rhoa_laplace_rhoa_tau_b => zero_f
5837 END IF
5838 deriv_att => xc_dset_get_derivative(deriv_set, &
5840 IF (ASSOCIATED(deriv_att)) THEN
5841 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhob_laplace_rhob)
5842 ELSE
5843 n_rhoa_laplace_rhob_laplace_rhob => zero_f
5844 END IF
5845 deriv_att => xc_dset_get_derivative(deriv_set, &
5847 IF (ASSOCIATED(deriv_att)) THEN
5848 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhob_tau_a)
5849 ELSE
5850 n_rhoa_laplace_rhob_tau_a => zero_f
5851 END IF
5852 deriv_att => xc_dset_get_derivative(deriv_set, &
5854 IF (ASSOCIATED(deriv_att)) THEN
5855 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_laplace_rhob_tau_b)
5856 ELSE
5857 n_rhoa_laplace_rhob_tau_b => zero_f
5858 END IF
5859 deriv_att => xc_dset_get_derivative(deriv_set, &
5861 IF (ASSOCIATED(deriv_att)) THEN
5862 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_tau_a_tau_a)
5863 ELSE
5864 n_rhoa_tau_a_tau_a => zero_f
5865 END IF
5866 deriv_att => xc_dset_get_derivative(deriv_set, &
5868 IF (ASSOCIATED(deriv_att)) THEN
5869 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_tau_a_tau_b)
5870 ELSE
5871 n_rhoa_tau_a_tau_b => zero_f
5872 END IF
5873 deriv_att => xc_dset_get_derivative(deriv_set, &
5875 IF (ASSOCIATED(deriv_att)) THEN
5876 CALL xc_derivative_get(deriv_att, deriv_data=n_rhoa_tau_b_tau_b)
5877 ELSE
5878 n_rhoa_tau_b_tau_b => zero_f
5879 END IF
5880 deriv_att => xc_dset_get_derivative(deriv_set, &
5882 IF (ASSOCIATED(deriv_att)) THEN
5883 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_rhob)
5884 ELSE
5885 n_rhob_rhob_rhob => zero_f
5886 END IF
5887 deriv_att => xc_dset_get_derivative(deriv_set, &
5889 IF (ASSOCIATED(deriv_att)) THEN
5890 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_gamma_aa)
5891 ELSE
5892 n_rhob_rhob_gamma_aa => zero_f
5893 END IF
5894 deriv_att => xc_dset_get_derivative(deriv_set, &
5896 IF (ASSOCIATED(deriv_att)) THEN
5897 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_gamma_ab)
5898 ELSE
5899 n_rhob_rhob_gamma_ab => zero_f
5900 END IF
5901 deriv_att => xc_dset_get_derivative(deriv_set, &
5903 IF (ASSOCIATED(deriv_att)) THEN
5904 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_gamma_bb)
5905 ELSE
5906 n_rhob_rhob_gamma_bb => zero_f
5907 END IF
5908 deriv_att => xc_dset_get_derivative(deriv_set, &
5910 IF (ASSOCIATED(deriv_att)) THEN
5911 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_laplace_rhoa)
5912 ELSE
5913 n_rhob_rhob_laplace_rhoa => zero_f
5914 END IF
5915 deriv_att => xc_dset_get_derivative(deriv_set, &
5917 IF (ASSOCIATED(deriv_att)) THEN
5918 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_laplace_rhob)
5919 ELSE
5920 n_rhob_rhob_laplace_rhob => zero_f
5921 END IF
5922 deriv_att => xc_dset_get_derivative(deriv_set, &
5924 IF (ASSOCIATED(deriv_att)) THEN
5925 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_tau_a)
5926 ELSE
5927 n_rhob_rhob_tau_a => zero_f
5928 END IF
5929 deriv_att => xc_dset_get_derivative(deriv_set, &
5931 IF (ASSOCIATED(deriv_att)) THEN
5932 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_rhob_tau_b)
5933 ELSE
5934 n_rhob_rhob_tau_b => zero_f
5935 END IF
5936 deriv_att => xc_dset_get_derivative(deriv_set, &
5938 IF (ASSOCIATED(deriv_att)) THEN
5939 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_gamma_aa)
5940 ELSE
5941 n_rhob_gamma_aa_gamma_aa => zero_f
5942 END IF
5943 deriv_att => xc_dset_get_derivative(deriv_set, &
5945 IF (ASSOCIATED(deriv_att)) THEN
5946 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_gamma_ab)
5947 ELSE
5948 n_rhob_gamma_aa_gamma_ab => zero_f
5949 END IF
5950 deriv_att => xc_dset_get_derivative(deriv_set, &
5952 IF (ASSOCIATED(deriv_att)) THEN
5953 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_gamma_bb)
5954 ELSE
5955 n_rhob_gamma_aa_gamma_bb => zero_f
5956 END IF
5957 deriv_att => xc_dset_get_derivative(deriv_set, &
5959 IF (ASSOCIATED(deriv_att)) THEN
5960 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_laplace_rhoa)
5961 ELSE
5962 n_rhob_gamma_aa_laplace_rhoa => zero_f
5963 END IF
5964 deriv_att => xc_dset_get_derivative(deriv_set, &
5966 IF (ASSOCIATED(deriv_att)) THEN
5967 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_laplace_rhob)
5968 ELSE
5969 n_rhob_gamma_aa_laplace_rhob => zero_f
5970 END IF
5971 deriv_att => xc_dset_get_derivative(deriv_set, &
5973 IF (ASSOCIATED(deriv_att)) THEN
5974 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_tau_a)
5975 ELSE
5976 n_rhob_gamma_aa_tau_a => zero_f
5977 END IF
5978 deriv_att => xc_dset_get_derivative(deriv_set, &
5980 IF (ASSOCIATED(deriv_att)) THEN
5981 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_aa_tau_b)
5982 ELSE
5983 n_rhob_gamma_aa_tau_b => zero_f
5984 END IF
5985 deriv_att => xc_dset_get_derivative(deriv_set, &
5987 IF (ASSOCIATED(deriv_att)) THEN
5988 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab_gamma_ab)
5989 ELSE
5990 n_rhob_gamma_ab_gamma_ab => zero_f
5991 END IF
5992 deriv_att => xc_dset_get_derivative(deriv_set, &
5994 IF (ASSOCIATED(deriv_att)) THEN
5995 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab_gamma_bb)
5996 ELSE
5997 n_rhob_gamma_ab_gamma_bb => zero_f
5998 END IF
5999 deriv_att => xc_dset_get_derivative(deriv_set, &
6001 IF (ASSOCIATED(deriv_att)) THEN
6002 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab_laplace_rhoa)
6003 ELSE
6004 n_rhob_gamma_ab_laplace_rhoa => zero_f
6005 END IF
6006 deriv_att => xc_dset_get_derivative(deriv_set, &
6008 IF (ASSOCIATED(deriv_att)) THEN
6009 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab_laplace_rhob)
6010 ELSE
6011 n_rhob_gamma_ab_laplace_rhob => zero_f
6012 END IF
6013 deriv_att => xc_dset_get_derivative(deriv_set, &
6015 IF (ASSOCIATED(deriv_att)) THEN
6016 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab_tau_a)
6017 ELSE
6018 n_rhob_gamma_ab_tau_a => zero_f
6019 END IF
6020 deriv_att => xc_dset_get_derivative(deriv_set, &
6022 IF (ASSOCIATED(deriv_att)) THEN
6023 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_ab_tau_b)
6024 ELSE
6025 n_rhob_gamma_ab_tau_b => zero_f
6026 END IF
6027 deriv_att => xc_dset_get_derivative(deriv_set, &
6029 IF (ASSOCIATED(deriv_att)) THEN
6030 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_bb_gamma_bb)
6031 ELSE
6032 n_rhob_gamma_bb_gamma_bb => zero_f
6033 END IF
6034 deriv_att => xc_dset_get_derivative(deriv_set, &
6036 IF (ASSOCIATED(deriv_att)) THEN
6037 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_bb_laplace_rhoa)
6038 ELSE
6039 n_rhob_gamma_bb_laplace_rhoa => zero_f
6040 END IF
6041 deriv_att => xc_dset_get_derivative(deriv_set, &
6043 IF (ASSOCIATED(deriv_att)) THEN
6044 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_bb_laplace_rhob)
6045 ELSE
6046 n_rhob_gamma_bb_laplace_rhob => zero_f
6047 END IF
6048 deriv_att => xc_dset_get_derivative(deriv_set, &
6050 IF (ASSOCIATED(deriv_att)) THEN
6051 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_bb_tau_a)
6052 ELSE
6053 n_rhob_gamma_bb_tau_a => zero_f
6054 END IF
6055 deriv_att => xc_dset_get_derivative(deriv_set, &
6057 IF (ASSOCIATED(deriv_att)) THEN
6058 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_gamma_bb_tau_b)
6059 ELSE
6060 n_rhob_gamma_bb_tau_b => zero_f
6061 END IF
6062 deriv_att => xc_dset_get_derivative(deriv_set, &
6064 IF (ASSOCIATED(deriv_att)) THEN
6065 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhoa_laplace_rhoa)
6066 ELSE
6067 n_rhob_laplace_rhoa_laplace_rhoa => zero_f
6068 END IF
6069 deriv_att => xc_dset_get_derivative(deriv_set, &
6071 IF (ASSOCIATED(deriv_att)) THEN
6072 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhoa_laplace_rhob)
6073 ELSE
6074 n_rhob_laplace_rhoa_laplace_rhob => zero_f
6075 END IF
6076 deriv_att => xc_dset_get_derivative(deriv_set, &
6078 IF (ASSOCIATED(deriv_att)) THEN
6079 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhoa_tau_a)
6080 ELSE
6081 n_rhob_laplace_rhoa_tau_a => zero_f
6082 END IF
6083 deriv_att => xc_dset_get_derivative(deriv_set, &
6085 IF (ASSOCIATED(deriv_att)) THEN
6086 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhoa_tau_b)
6087 ELSE
6088 n_rhob_laplace_rhoa_tau_b => zero_f
6089 END IF
6090 deriv_att => xc_dset_get_derivative(deriv_set, &
6092 IF (ASSOCIATED(deriv_att)) THEN
6093 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhob_laplace_rhob)
6094 ELSE
6095 n_rhob_laplace_rhob_laplace_rhob => zero_f
6096 END IF
6097 deriv_att => xc_dset_get_derivative(deriv_set, &
6099 IF (ASSOCIATED(deriv_att)) THEN
6100 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhob_tau_a)
6101 ELSE
6102 n_rhob_laplace_rhob_tau_a => zero_f
6103 END IF
6104 deriv_att => xc_dset_get_derivative(deriv_set, &
6106 IF (ASSOCIATED(deriv_att)) THEN
6107 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_laplace_rhob_tau_b)
6108 ELSE
6109 n_rhob_laplace_rhob_tau_b => zero_f
6110 END IF
6111 deriv_att => xc_dset_get_derivative(deriv_set, &
6113 IF (ASSOCIATED(deriv_att)) THEN
6114 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_tau_a_tau_a)
6115 ELSE
6116 n_rhob_tau_a_tau_a => zero_f
6117 END IF
6118 deriv_att => xc_dset_get_derivative(deriv_set, &
6120 IF (ASSOCIATED(deriv_att)) THEN
6121 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_tau_a_tau_b)
6122 ELSE
6123 n_rhob_tau_a_tau_b => zero_f
6124 END IF
6125 deriv_att => xc_dset_get_derivative(deriv_set, &
6127 IF (ASSOCIATED(deriv_att)) THEN
6128 CALL xc_derivative_get(deriv_att, deriv_data=n_rhob_tau_b_tau_b)
6129 ELSE
6130 n_rhob_tau_b_tau_b => zero_f
6131 END IF
6132 deriv_att => xc_dset_get_derivative(deriv_set, &
6134 IF (ASSOCIATED(deriv_att)) THEN
6135 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_gamma_aa)
6136 ELSE
6137 n_gamma_aa_gamma_aa_gamma_aa => zero_f
6138 END IF
6139 deriv_att => xc_dset_get_derivative(deriv_set, &
6141 IF (ASSOCIATED(deriv_att)) THEN
6142 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_gamma_ab)
6143 ELSE
6144 n_gamma_aa_gamma_aa_gamma_ab => zero_f
6145 END IF
6146 deriv_att => xc_dset_get_derivative(deriv_set, &
6148 IF (ASSOCIATED(deriv_att)) THEN
6149 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_gamma_bb)
6150 ELSE
6151 n_gamma_aa_gamma_aa_gamma_bb => zero_f
6152 END IF
6153 deriv_att => xc_dset_get_derivative(deriv_set, &
6155 IF (ASSOCIATED(deriv_att)) THEN
6156 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_laplace_rhoa)
6157 ELSE
6158 n_gamma_aa_gamma_aa_laplace_rhoa => zero_f
6159 END IF
6160 deriv_att => xc_dset_get_derivative(deriv_set, &
6162 IF (ASSOCIATED(deriv_att)) THEN
6163 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_laplace_rhob)
6164 ELSE
6165 n_gamma_aa_gamma_aa_laplace_rhob => zero_f
6166 END IF
6167 deriv_att => xc_dset_get_derivative(deriv_set, &
6169 IF (ASSOCIATED(deriv_att)) THEN
6170 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_tau_a)
6171 ELSE
6172 n_gamma_aa_gamma_aa_tau_a => zero_f
6173 END IF
6174 deriv_att => xc_dset_get_derivative(deriv_set, &
6176 IF (ASSOCIATED(deriv_att)) THEN
6177 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_aa_tau_b)
6178 ELSE
6179 n_gamma_aa_gamma_aa_tau_b => zero_f
6180 END IF
6181 deriv_att => xc_dset_get_derivative(deriv_set, &
6183 IF (ASSOCIATED(deriv_att)) THEN
6184 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab_gamma_ab)
6185 ELSE
6186 n_gamma_aa_gamma_ab_gamma_ab => zero_f
6187 END IF
6188 deriv_att => xc_dset_get_derivative(deriv_set, &
6190 IF (ASSOCIATED(deriv_att)) THEN
6191 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab_gamma_bb)
6192 ELSE
6193 n_gamma_aa_gamma_ab_gamma_bb => zero_f
6194 END IF
6195 deriv_att => xc_dset_get_derivative(deriv_set, &
6197 IF (ASSOCIATED(deriv_att)) THEN
6198 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab_laplace_rhoa)
6199 ELSE
6200 n_gamma_aa_gamma_ab_laplace_rhoa => zero_f
6201 END IF
6202 deriv_att => xc_dset_get_derivative(deriv_set, &
6204 IF (ASSOCIATED(deriv_att)) THEN
6205 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab_laplace_rhob)
6206 ELSE
6207 n_gamma_aa_gamma_ab_laplace_rhob => zero_f
6208 END IF
6209 deriv_att => xc_dset_get_derivative(deriv_set, &
6211 IF (ASSOCIATED(deriv_att)) THEN
6212 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab_tau_a)
6213 ELSE
6214 n_gamma_aa_gamma_ab_tau_a => zero_f
6215 END IF
6216 deriv_att => xc_dset_get_derivative(deriv_set, &
6218 IF (ASSOCIATED(deriv_att)) THEN
6219 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_ab_tau_b)
6220 ELSE
6221 n_gamma_aa_gamma_ab_tau_b => zero_f
6222 END IF
6223 deriv_att => xc_dset_get_derivative(deriv_set, &
6225 IF (ASSOCIATED(deriv_att)) THEN
6226 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_bb_gamma_bb)
6227 ELSE
6228 n_gamma_aa_gamma_bb_gamma_bb => zero_f
6229 END IF
6230 deriv_att => xc_dset_get_derivative(deriv_set, &
6232 IF (ASSOCIATED(deriv_att)) THEN
6233 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_bb_laplace_rhoa)
6234 ELSE
6235 n_gamma_aa_gamma_bb_laplace_rhoa => zero_f
6236 END IF
6237 deriv_att => xc_dset_get_derivative(deriv_set, &
6239 IF (ASSOCIATED(deriv_att)) THEN
6240 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_bb_laplace_rhob)
6241 ELSE
6242 n_gamma_aa_gamma_bb_laplace_rhob => zero_f
6243 END IF
6244 deriv_att => xc_dset_get_derivative(deriv_set, &
6246 IF (ASSOCIATED(deriv_att)) THEN
6247 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_bb_tau_a)
6248 ELSE
6249 n_gamma_aa_gamma_bb_tau_a => zero_f
6250 END IF
6251 deriv_att => xc_dset_get_derivative(deriv_set, &
6253 IF (ASSOCIATED(deriv_att)) THEN
6254 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_gamma_bb_tau_b)
6255 ELSE
6256 n_gamma_aa_gamma_bb_tau_b => zero_f
6257 END IF
6258 deriv_att => xc_dset_get_derivative(deriv_set, &
6260 IF (ASSOCIATED(deriv_att)) THEN
6261 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhoa_laplace_rhoa)
6262 ELSE
6263 n_gamma_aa_laplace_rhoa_laplace_rhoa => zero_f
6264 END IF
6265 deriv_att => xc_dset_get_derivative(deriv_set, &
6267 IF (ASSOCIATED(deriv_att)) THEN
6268 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhoa_laplace_rhob)
6269 ELSE
6270 n_gamma_aa_laplace_rhoa_laplace_rhob => zero_f
6271 END IF
6272 deriv_att => xc_dset_get_derivative(deriv_set, &
6274 IF (ASSOCIATED(deriv_att)) THEN
6275 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhoa_tau_a)
6276 ELSE
6277 n_gamma_aa_laplace_rhoa_tau_a => zero_f
6278 END IF
6279 deriv_att => xc_dset_get_derivative(deriv_set, &
6281 IF (ASSOCIATED(deriv_att)) THEN
6282 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhoa_tau_b)
6283 ELSE
6284 n_gamma_aa_laplace_rhoa_tau_b => zero_f
6285 END IF
6286 deriv_att => xc_dset_get_derivative(deriv_set, &
6288 IF (ASSOCIATED(deriv_att)) THEN
6289 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhob_laplace_rhob)
6290 ELSE
6291 n_gamma_aa_laplace_rhob_laplace_rhob => zero_f
6292 END IF
6293 deriv_att => xc_dset_get_derivative(deriv_set, &
6295 IF (ASSOCIATED(deriv_att)) THEN
6296 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhob_tau_a)
6297 ELSE
6298 n_gamma_aa_laplace_rhob_tau_a => zero_f
6299 END IF
6300 deriv_att => xc_dset_get_derivative(deriv_set, &
6302 IF (ASSOCIATED(deriv_att)) THEN
6303 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_laplace_rhob_tau_b)
6304 ELSE
6305 n_gamma_aa_laplace_rhob_tau_b => zero_f
6306 END IF
6307 deriv_att => xc_dset_get_derivative(deriv_set, &
6309 IF (ASSOCIATED(deriv_att)) THEN
6310 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_tau_a_tau_a)
6311 ELSE
6312 n_gamma_aa_tau_a_tau_a => zero_f
6313 END IF
6314 deriv_att => xc_dset_get_derivative(deriv_set, &
6316 IF (ASSOCIATED(deriv_att)) THEN
6317 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_tau_a_tau_b)
6318 ELSE
6319 n_gamma_aa_tau_a_tau_b => zero_f
6320 END IF
6321 deriv_att => xc_dset_get_derivative(deriv_set, &
6323 IF (ASSOCIATED(deriv_att)) THEN
6324 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_aa_tau_b_tau_b)
6325 ELSE
6326 n_gamma_aa_tau_b_tau_b => zero_f
6327 END IF
6328 deriv_att => xc_dset_get_derivative(deriv_set, &
6330 IF (ASSOCIATED(deriv_att)) THEN
6331 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab_gamma_ab)
6332 ELSE
6333 n_gamma_ab_gamma_ab_gamma_ab => zero_f
6334 END IF
6335 deriv_att => xc_dset_get_derivative(deriv_set, &
6337 IF (ASSOCIATED(deriv_att)) THEN
6338 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab_gamma_bb)
6339 ELSE
6340 n_gamma_ab_gamma_ab_gamma_bb => zero_f
6341 END IF
6342 deriv_att => xc_dset_get_derivative(deriv_set, &
6344 IF (ASSOCIATED(deriv_att)) THEN
6345 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab_laplace_rhoa)
6346 ELSE
6347 n_gamma_ab_gamma_ab_laplace_rhoa => zero_f
6348 END IF
6349 deriv_att => xc_dset_get_derivative(deriv_set, &
6351 IF (ASSOCIATED(deriv_att)) THEN
6352 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab_laplace_rhob)
6353 ELSE
6354 n_gamma_ab_gamma_ab_laplace_rhob => zero_f
6355 END IF
6356 deriv_att => xc_dset_get_derivative(deriv_set, &
6358 IF (ASSOCIATED(deriv_att)) THEN
6359 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab_tau_a)
6360 ELSE
6361 n_gamma_ab_gamma_ab_tau_a => zero_f
6362 END IF
6363 deriv_att => xc_dset_get_derivative(deriv_set, &
6365 IF (ASSOCIATED(deriv_att)) THEN
6366 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_ab_tau_b)
6367 ELSE
6368 n_gamma_ab_gamma_ab_tau_b => zero_f
6369 END IF
6370 deriv_att => xc_dset_get_derivative(deriv_set, &
6372 IF (ASSOCIATED(deriv_att)) THEN
6373 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_bb_gamma_bb)
6374 ELSE
6375 n_gamma_ab_gamma_bb_gamma_bb => zero_f
6376 END IF
6377 deriv_att => xc_dset_get_derivative(deriv_set, &
6379 IF (ASSOCIATED(deriv_att)) THEN
6380 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_bb_laplace_rhoa)
6381 ELSE
6382 n_gamma_ab_gamma_bb_laplace_rhoa => zero_f
6383 END IF
6384 deriv_att => xc_dset_get_derivative(deriv_set, &
6386 IF (ASSOCIATED(deriv_att)) THEN
6387 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_bb_laplace_rhob)
6388 ELSE
6389 n_gamma_ab_gamma_bb_laplace_rhob => zero_f
6390 END IF
6391 deriv_att => xc_dset_get_derivative(deriv_set, &
6393 IF (ASSOCIATED(deriv_att)) THEN
6394 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_bb_tau_a)
6395 ELSE
6396 n_gamma_ab_gamma_bb_tau_a => zero_f
6397 END IF
6398 deriv_att => xc_dset_get_derivative(deriv_set, &
6400 IF (ASSOCIATED(deriv_att)) THEN
6401 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_gamma_bb_tau_b)
6402 ELSE
6403 n_gamma_ab_gamma_bb_tau_b => zero_f
6404 END IF
6405 deriv_att => xc_dset_get_derivative(deriv_set, &
6407 IF (ASSOCIATED(deriv_att)) THEN
6408 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhoa_laplace_rhoa)
6409 ELSE
6410 n_gamma_ab_laplace_rhoa_laplace_rhoa => zero_f
6411 END IF
6412 deriv_att => xc_dset_get_derivative(deriv_set, &
6414 IF (ASSOCIATED(deriv_att)) THEN
6415 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhoa_laplace_rhob)
6416 ELSE
6417 n_gamma_ab_laplace_rhoa_laplace_rhob => zero_f
6418 END IF
6419 deriv_att => xc_dset_get_derivative(deriv_set, &
6421 IF (ASSOCIATED(deriv_att)) THEN
6422 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhoa_tau_a)
6423 ELSE
6424 n_gamma_ab_laplace_rhoa_tau_a => zero_f
6425 END IF
6426 deriv_att => xc_dset_get_derivative(deriv_set, &
6428 IF (ASSOCIATED(deriv_att)) THEN
6429 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhoa_tau_b)
6430 ELSE
6431 n_gamma_ab_laplace_rhoa_tau_b => zero_f
6432 END IF
6433 deriv_att => xc_dset_get_derivative(deriv_set, &
6435 IF (ASSOCIATED(deriv_att)) THEN
6436 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhob_laplace_rhob)
6437 ELSE
6438 n_gamma_ab_laplace_rhob_laplace_rhob => zero_f
6439 END IF
6440 deriv_att => xc_dset_get_derivative(deriv_set, &
6442 IF (ASSOCIATED(deriv_att)) THEN
6443 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhob_tau_a)
6444 ELSE
6445 n_gamma_ab_laplace_rhob_tau_a => zero_f
6446 END IF
6447 deriv_att => xc_dset_get_derivative(deriv_set, &
6449 IF (ASSOCIATED(deriv_att)) THEN
6450 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_laplace_rhob_tau_b)
6451 ELSE
6452 n_gamma_ab_laplace_rhob_tau_b => zero_f
6453 END IF
6454 deriv_att => xc_dset_get_derivative(deriv_set, &
6456 IF (ASSOCIATED(deriv_att)) THEN
6457 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_tau_a_tau_a)
6458 ELSE
6459 n_gamma_ab_tau_a_tau_a => zero_f
6460 END IF
6461 deriv_att => xc_dset_get_derivative(deriv_set, &
6463 IF (ASSOCIATED(deriv_att)) THEN
6464 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_tau_a_tau_b)
6465 ELSE
6466 n_gamma_ab_tau_a_tau_b => zero_f
6467 END IF
6468 deriv_att => xc_dset_get_derivative(deriv_set, &
6470 IF (ASSOCIATED(deriv_att)) THEN
6471 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_ab_tau_b_tau_b)
6472 ELSE
6473 n_gamma_ab_tau_b_tau_b => zero_f
6474 END IF
6475 deriv_att => xc_dset_get_derivative(deriv_set, &
6477 IF (ASSOCIATED(deriv_att)) THEN
6478 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_gamma_bb_gamma_bb)
6479 ELSE
6480 n_gamma_bb_gamma_bb_gamma_bb => zero_f
6481 END IF
6482 deriv_att => xc_dset_get_derivative(deriv_set, &
6484 IF (ASSOCIATED(deriv_att)) THEN
6485 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_gamma_bb_laplace_rhoa)
6486 ELSE
6487 n_gamma_bb_gamma_bb_laplace_rhoa => zero_f
6488 END IF
6489 deriv_att => xc_dset_get_derivative(deriv_set, &
6491 IF (ASSOCIATED(deriv_att)) THEN
6492 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_gamma_bb_laplace_rhob)
6493 ELSE
6494 n_gamma_bb_gamma_bb_laplace_rhob => zero_f
6495 END IF
6496 deriv_att => xc_dset_get_derivative(deriv_set, &
6498 IF (ASSOCIATED(deriv_att)) THEN
6499 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_gamma_bb_tau_a)
6500 ELSE
6501 n_gamma_bb_gamma_bb_tau_a => zero_f
6502 END IF
6503 deriv_att => xc_dset_get_derivative(deriv_set, &
6505 IF (ASSOCIATED(deriv_att)) THEN
6506 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_gamma_bb_tau_b)
6507 ELSE
6508 n_gamma_bb_gamma_bb_tau_b => zero_f
6509 END IF
6510 deriv_att => xc_dset_get_derivative(deriv_set, &
6512 IF (ASSOCIATED(deriv_att)) THEN
6513 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhoa_laplace_rhoa)
6514 ELSE
6515 n_gamma_bb_laplace_rhoa_laplace_rhoa => zero_f
6516 END IF
6517 deriv_att => xc_dset_get_derivative(deriv_set, &
6519 IF (ASSOCIATED(deriv_att)) THEN
6520 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhoa_laplace_rhob)
6521 ELSE
6522 n_gamma_bb_laplace_rhoa_laplace_rhob => zero_f
6523 END IF
6524 deriv_att => xc_dset_get_derivative(deriv_set, &
6526 IF (ASSOCIATED(deriv_att)) THEN
6527 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhoa_tau_a)
6528 ELSE
6529 n_gamma_bb_laplace_rhoa_tau_a => zero_f
6530 END IF
6531 deriv_att => xc_dset_get_derivative(deriv_set, &
6533 IF (ASSOCIATED(deriv_att)) THEN
6534 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhoa_tau_b)
6535 ELSE
6536 n_gamma_bb_laplace_rhoa_tau_b => zero_f
6537 END IF
6538 deriv_att => xc_dset_get_derivative(deriv_set, &
6540 IF (ASSOCIATED(deriv_att)) THEN
6541 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhob_laplace_rhob)
6542 ELSE
6543 n_gamma_bb_laplace_rhob_laplace_rhob => zero_f
6544 END IF
6545 deriv_att => xc_dset_get_derivative(deriv_set, &
6547 IF (ASSOCIATED(deriv_att)) THEN
6548 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhob_tau_a)
6549 ELSE
6550 n_gamma_bb_laplace_rhob_tau_a => zero_f
6551 END IF
6552 deriv_att => xc_dset_get_derivative(deriv_set, &
6554 IF (ASSOCIATED(deriv_att)) THEN
6555 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_laplace_rhob_tau_b)
6556 ELSE
6557 n_gamma_bb_laplace_rhob_tau_b => zero_f
6558 END IF
6559 deriv_att => xc_dset_get_derivative(deriv_set, &
6561 IF (ASSOCIATED(deriv_att)) THEN
6562 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_tau_a_tau_a)
6563 ELSE
6564 n_gamma_bb_tau_a_tau_a => zero_f
6565 END IF
6566 deriv_att => xc_dset_get_derivative(deriv_set, &
6568 IF (ASSOCIATED(deriv_att)) THEN
6569 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_tau_a_tau_b)
6570 ELSE
6571 n_gamma_bb_tau_a_tau_b => zero_f
6572 END IF
6573 deriv_att => xc_dset_get_derivative(deriv_set, &
6575 IF (ASSOCIATED(deriv_att)) THEN
6576 CALL xc_derivative_get(deriv_att, deriv_data=n_gamma_bb_tau_b_tau_b)
6577 ELSE
6578 n_gamma_bb_tau_b_tau_b => zero_f
6579 END IF
6580 deriv_att => xc_dset_get_derivative(deriv_set, &
6582 IF (ASSOCIATED(deriv_att)) THEN
6583 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhoa_laplace_rhoa)
6584 ELSE
6585 n_laplace_rhoa_laplace_rhoa_laplace_rhoa => zero_f
6586 END IF
6587 deriv_att => xc_dset_get_derivative(deriv_set, &
6589 IF (ASSOCIATED(deriv_att)) THEN
6590 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhoa_laplace_rhob)
6591 ELSE
6592 n_laplace_rhoa_laplace_rhoa_laplace_rhob => zero_f
6593 END IF
6594 deriv_att => xc_dset_get_derivative(deriv_set, &
6596 IF (ASSOCIATED(deriv_att)) THEN
6597 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhoa_tau_a)
6598 ELSE
6599 n_laplace_rhoa_laplace_rhoa_tau_a => zero_f
6600 END IF
6601 deriv_att => xc_dset_get_derivative(deriv_set, &
6603 IF (ASSOCIATED(deriv_att)) THEN
6604 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhoa_tau_b)
6605 ELSE
6606 n_laplace_rhoa_laplace_rhoa_tau_b => zero_f
6607 END IF
6608 deriv_att => xc_dset_get_derivative(deriv_set, &
6610 IF (ASSOCIATED(deriv_att)) THEN
6611 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhob_laplace_rhob)
6612 ELSE
6613 n_laplace_rhoa_laplace_rhob_laplace_rhob => zero_f
6614 END IF
6615 deriv_att => xc_dset_get_derivative(deriv_set, &
6617 IF (ASSOCIATED(deriv_att)) THEN
6618 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhob_tau_a)
6619 ELSE
6620 n_laplace_rhoa_laplace_rhob_tau_a => zero_f
6621 END IF
6622 deriv_att => xc_dset_get_derivative(deriv_set, &
6624 IF (ASSOCIATED(deriv_att)) THEN
6625 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_laplace_rhob_tau_b)
6626 ELSE
6627 n_laplace_rhoa_laplace_rhob_tau_b => zero_f
6628 END IF
6629 deriv_att => xc_dset_get_derivative(deriv_set, &
6631 IF (ASSOCIATED(deriv_att)) THEN
6632 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_tau_a_tau_a)
6633 ELSE
6634 n_laplace_rhoa_tau_a_tau_a => zero_f
6635 END IF
6636 deriv_att => xc_dset_get_derivative(deriv_set, &
6638 IF (ASSOCIATED(deriv_att)) THEN
6639 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_tau_a_tau_b)
6640 ELSE
6641 n_laplace_rhoa_tau_a_tau_b => zero_f
6642 END IF
6643 deriv_att => xc_dset_get_derivative(deriv_set, &
6645 IF (ASSOCIATED(deriv_att)) THEN
6646 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhoa_tau_b_tau_b)
6647 ELSE
6648 n_laplace_rhoa_tau_b_tau_b => zero_f
6649 END IF
6650 deriv_att => xc_dset_get_derivative(deriv_set, &
6652 IF (ASSOCIATED(deriv_att)) THEN
6653 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_laplace_rhob_laplace_rhob)
6654 ELSE
6655 n_laplace_rhob_laplace_rhob_laplace_rhob => zero_f
6656 END IF
6657 deriv_att => xc_dset_get_derivative(deriv_set, &
6659 IF (ASSOCIATED(deriv_att)) THEN
6660 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_laplace_rhob_tau_a)
6661 ELSE
6662 n_laplace_rhob_laplace_rhob_tau_a => zero_f
6663 END IF
6664 deriv_att => xc_dset_get_derivative(deriv_set, &
6666 IF (ASSOCIATED(deriv_att)) THEN
6667 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_laplace_rhob_tau_b)
6668 ELSE
6669 n_laplace_rhob_laplace_rhob_tau_b => zero_f
6670 END IF
6671 deriv_att => xc_dset_get_derivative(deriv_set, &
6673 IF (ASSOCIATED(deriv_att)) THEN
6674 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_tau_a_tau_a)
6675 ELSE
6676 n_laplace_rhob_tau_a_tau_a => zero_f
6677 END IF
6678 deriv_att => xc_dset_get_derivative(deriv_set, &
6680 IF (ASSOCIATED(deriv_att)) THEN
6681 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_tau_a_tau_b)
6682 ELSE
6683 n_laplace_rhob_tau_a_tau_b => zero_f
6684 END IF
6685 deriv_att => xc_dset_get_derivative(deriv_set, &
6687 IF (ASSOCIATED(deriv_att)) THEN
6688 CALL xc_derivative_get(deriv_att, deriv_data=n_laplace_rhob_tau_b_tau_b)
6689 ELSE
6690 n_laplace_rhob_tau_b_tau_b => zero_f
6691 END IF
6692 deriv_att => xc_dset_get_derivative(deriv_set, &
6694 IF (ASSOCIATED(deriv_att)) THEN
6695 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_a_tau_a_tau_a)
6696 ELSE
6697 n_tau_a_tau_a_tau_a => zero_f
6698 END IF
6699 deriv_att => xc_dset_get_derivative(deriv_set, &
6701 IF (ASSOCIATED(deriv_att)) THEN
6702 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_a_tau_a_tau_b)
6703 ELSE
6704 n_tau_a_tau_a_tau_b => zero_f
6705 END IF
6706 deriv_att => xc_dset_get_derivative(deriv_set, &
6708 IF (ASSOCIATED(deriv_att)) THEN
6709 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_a_tau_b_tau_b)
6710 ELSE
6711 n_tau_a_tau_b_tau_b => zero_f
6712 END IF
6713 deriv_att => xc_dset_get_derivative(deriv_set, &
6715 IF (ASSOCIATED(deriv_att)) THEN
6716 CALL xc_derivative_get(deriv_att, deriv_data=n_tau_b_tau_b_tau_b)
6717 ELSE
6718 n_tau_b_tau_b_tau_b => zero_f
6719 END IF
6720 IF (laplace_f) THEN
6721 ALLOCATE (v_laplace(nspins))
6722 DO ispin = 1, nspins
6723 CALL allocate_pw(v_laplace(ispin), pw_pool, bo)
6724 END DO
6725 END IF
6726
6727!$OMP PARALLEL DO DEFAULT(NONE) COLLAPSE(3) &
6728!$OMP PRIVATE(k, j, i) &
6729!$OMP PRIVATE(mp_rhoa, q_rhoa) &
6730!$OMP PRIVATE(mp_rhob, q_rhob) &
6731!$OMP PRIVATE(mp_gamma_aa, q_gamma_aa) &
6732!$OMP PRIVATE(mp_gamma_ab, q_gamma_ab) &
6733!$OMP PRIVATE(mp_gamma_bb, q_gamma_bb) &
6734!$OMP PRIVATE(mp_laplace_rhoa, q_laplace_rhoa) &
6735!$OMP PRIVATE(mp_laplace_rhob, q_laplace_rhob) &
6736!$OMP PRIVATE(mp_tau_a, q_tau_a) &
6737!$OMP PRIVATE(mp_tau_b, q_tau_b) &
6738!$OMP PRIVATE(mpp_gamma_aa, nB_gamma_aa) &
6739!$OMP PRIVATE(mpp_gamma_ab, nB_gamma_ab) &
6740!$OMP PRIVATE(mpp_gamma_bb, nB_gamma_bb) &
6741!$OMP SHARED(n_rhoa_rhoa) &
6742!$OMP SHARED(n_rhoa_rhob) &
6743!$OMP SHARED(n_rhoa_gamma_aa) &
6744!$OMP SHARED(n_rhoa_gamma_ab) &
6745!$OMP SHARED(n_rhoa_gamma_bb) &
6746!$OMP SHARED(n_rhoa_laplace_rhoa) &
6747!$OMP SHARED(n_rhoa_laplace_rhob) &
6748!$OMP SHARED(n_rhoa_tau_a) &
6749!$OMP SHARED(n_rhoa_tau_b) &
6750!$OMP SHARED(n_rhob_rhob) &
6751!$OMP SHARED(n_rhob_gamma_aa) &
6752!$OMP SHARED(n_rhob_gamma_ab) &
6753!$OMP SHARED(n_rhob_gamma_bb) &
6754!$OMP SHARED(n_rhob_laplace_rhoa) &
6755!$OMP SHARED(n_rhob_laplace_rhob) &
6756!$OMP SHARED(n_rhob_tau_a) &
6757!$OMP SHARED(n_rhob_tau_b) &
6758!$OMP SHARED(n_gamma_aa_gamma_aa) &
6759!$OMP SHARED(n_gamma_aa_gamma_ab) &
6760!$OMP SHARED(n_gamma_aa_gamma_bb) &
6761!$OMP SHARED(n_gamma_aa_laplace_rhoa) &
6762!$OMP SHARED(n_gamma_aa_laplace_rhob) &
6763!$OMP SHARED(n_gamma_aa_tau_a) &
6764!$OMP SHARED(n_gamma_aa_tau_b) &
6765!$OMP SHARED(n_gamma_ab_gamma_ab) &
6766!$OMP SHARED(n_gamma_ab_gamma_bb) &
6767!$OMP SHARED(n_gamma_ab_laplace_rhoa) &
6768!$OMP SHARED(n_gamma_ab_laplace_rhob) &
6769!$OMP SHARED(n_gamma_ab_tau_a) &
6770!$OMP SHARED(n_gamma_ab_tau_b) &
6771!$OMP SHARED(n_gamma_bb_gamma_bb) &
6772!$OMP SHARED(n_gamma_bb_laplace_rhoa) &
6773!$OMP SHARED(n_gamma_bb_laplace_rhob) &
6774!$OMP SHARED(n_gamma_bb_tau_a) &
6775!$OMP SHARED(n_gamma_bb_tau_b) &
6776!$OMP SHARED(n_laplace_rhoa_laplace_rhoa) &
6777!$OMP SHARED(n_laplace_rhoa_laplace_rhob) &
6778!$OMP SHARED(n_laplace_rhoa_tau_a) &
6779!$OMP SHARED(n_laplace_rhoa_tau_b) &
6780!$OMP SHARED(n_laplace_rhob_laplace_rhob) &
6781!$OMP SHARED(n_laplace_rhob_tau_a) &
6782!$OMP SHARED(n_laplace_rhob_tau_b) &
6783!$OMP SHARED(n_tau_a_tau_a) &
6784!$OMP SHARED(n_tau_a_tau_b) &
6785!$OMP SHARED(n_tau_b_tau_b) &
6786!$OMP SHARED(n_rhoa_rhoa_rhoa) &
6787!$OMP SHARED(n_rhoa_rhoa_rhob) &
6788!$OMP SHARED(n_rhoa_rhoa_gamma_aa) &
6789!$OMP SHARED(n_rhoa_rhoa_gamma_ab) &
6790!$OMP SHARED(n_rhoa_rhoa_gamma_bb) &
6791!$OMP SHARED(n_rhoa_rhoa_laplace_rhoa) &
6792!$OMP SHARED(n_rhoa_rhoa_laplace_rhob) &
6793!$OMP SHARED(n_rhoa_rhoa_tau_a) &
6794!$OMP SHARED(n_rhoa_rhoa_tau_b) &
6795!$OMP SHARED(n_rhoa_rhob_rhob) &
6796!$OMP SHARED(n_rhoa_rhob_gamma_aa) &
6797!$OMP SHARED(n_rhoa_rhob_gamma_ab) &
6798!$OMP SHARED(n_rhoa_rhob_gamma_bb) &
6799!$OMP SHARED(n_rhoa_rhob_laplace_rhoa) &
6800!$OMP SHARED(n_rhoa_rhob_laplace_rhob) &
6801!$OMP SHARED(n_rhoa_rhob_tau_a) &
6802!$OMP SHARED(n_rhoa_rhob_tau_b) &
6803!$OMP SHARED(n_rhoa_gamma_aa_gamma_aa) &
6804!$OMP SHARED(n_rhoa_gamma_aa_gamma_ab) &
6805!$OMP SHARED(n_rhoa_gamma_aa_gamma_bb) &
6806!$OMP SHARED(n_rhoa_gamma_aa_laplace_rhoa) &
6807!$OMP SHARED(n_rhoa_gamma_aa_laplace_rhob) &
6808!$OMP SHARED(n_rhoa_gamma_aa_tau_a) &
6809!$OMP SHARED(n_rhoa_gamma_aa_tau_b) &
6810!$OMP SHARED(n_rhoa_gamma_ab_gamma_ab) &
6811!$OMP SHARED(n_rhoa_gamma_ab_gamma_bb) &
6812!$OMP SHARED(n_rhoa_gamma_ab_laplace_rhoa) &
6813!$OMP SHARED(n_rhoa_gamma_ab_laplace_rhob) &
6814!$OMP SHARED(n_rhoa_gamma_ab_tau_a) &
6815!$OMP SHARED(n_rhoa_gamma_ab_tau_b) &
6816!$OMP SHARED(n_rhoa_gamma_bb_gamma_bb) &
6817!$OMP SHARED(n_rhoa_gamma_bb_laplace_rhoa) &
6818!$OMP SHARED(n_rhoa_gamma_bb_laplace_rhob) &
6819!$OMP SHARED(n_rhoa_gamma_bb_tau_a) &
6820!$OMP SHARED(n_rhoa_gamma_bb_tau_b) &
6821!$OMP SHARED(n_rhoa_laplace_rhoa_laplace_rhoa) &
6822!$OMP SHARED(n_rhoa_laplace_rhoa_laplace_rhob) &
6823!$OMP SHARED(n_rhoa_laplace_rhoa_tau_a) &
6824!$OMP SHARED(n_rhoa_laplace_rhoa_tau_b) &
6825!$OMP SHARED(n_rhoa_laplace_rhob_laplace_rhob) &
6826!$OMP SHARED(n_rhoa_laplace_rhob_tau_a) &
6827!$OMP SHARED(n_rhoa_laplace_rhob_tau_b) &
6828!$OMP SHARED(n_rhoa_tau_a_tau_a) &
6829!$OMP SHARED(n_rhoa_tau_a_tau_b) &
6830!$OMP SHARED(n_rhoa_tau_b_tau_b) &
6831!$OMP SHARED(n_rhob_rhob_rhob) &
6832!$OMP SHARED(n_rhob_rhob_gamma_aa) &
6833!$OMP SHARED(n_rhob_rhob_gamma_ab) &
6834!$OMP SHARED(n_rhob_rhob_gamma_bb) &
6835!$OMP SHARED(n_rhob_rhob_laplace_rhoa) &
6836!$OMP SHARED(n_rhob_rhob_laplace_rhob) &
6837!$OMP SHARED(n_rhob_rhob_tau_a) &
6838!$OMP SHARED(n_rhob_rhob_tau_b) &
6839!$OMP SHARED(n_rhob_gamma_aa_gamma_aa) &
6840!$OMP SHARED(n_rhob_gamma_aa_gamma_ab) &
6841!$OMP SHARED(n_rhob_gamma_aa_gamma_bb) &
6842!$OMP SHARED(n_rhob_gamma_aa_laplace_rhoa) &
6843!$OMP SHARED(n_rhob_gamma_aa_laplace_rhob) &
6844!$OMP SHARED(n_rhob_gamma_aa_tau_a) &
6845!$OMP SHARED(n_rhob_gamma_aa_tau_b) &
6846!$OMP SHARED(n_rhob_gamma_ab_gamma_ab) &
6847!$OMP SHARED(n_rhob_gamma_ab_gamma_bb) &
6848!$OMP SHARED(n_rhob_gamma_ab_laplace_rhoa) &
6849!$OMP SHARED(n_rhob_gamma_ab_laplace_rhob) &
6850!$OMP SHARED(n_rhob_gamma_ab_tau_a) &
6851!$OMP SHARED(n_rhob_gamma_ab_tau_b) &
6852!$OMP SHARED(n_rhob_gamma_bb_gamma_bb) &
6853!$OMP SHARED(n_rhob_gamma_bb_laplace_rhoa) &
6854!$OMP SHARED(n_rhob_gamma_bb_laplace_rhob) &
6855!$OMP SHARED(n_rhob_gamma_bb_tau_a) &
6856!$OMP SHARED(n_rhob_gamma_bb_tau_b) &
6857!$OMP SHARED(n_rhob_laplace_rhoa_laplace_rhoa) &
6858!$OMP SHARED(n_rhob_laplace_rhoa_laplace_rhob) &
6859!$OMP SHARED(n_rhob_laplace_rhoa_tau_a) &
6860!$OMP SHARED(n_rhob_laplace_rhoa_tau_b) &
6861!$OMP SHARED(n_rhob_laplace_rhob_laplace_rhob) &
6862!$OMP SHARED(n_rhob_laplace_rhob_tau_a) &
6863!$OMP SHARED(n_rhob_laplace_rhob_tau_b) &
6864!$OMP SHARED(n_rhob_tau_a_tau_a) &
6865!$OMP SHARED(n_rhob_tau_a_tau_b) &
6866!$OMP SHARED(n_rhob_tau_b_tau_b) &
6867!$OMP SHARED(n_gamma_aa_gamma_aa_gamma_aa) &
6868!$OMP SHARED(n_gamma_aa_gamma_aa_gamma_ab) &
6869!$OMP SHARED(n_gamma_aa_gamma_aa_gamma_bb) &
6870!$OMP SHARED(n_gamma_aa_gamma_aa_laplace_rhoa) &
6871!$OMP SHARED(n_gamma_aa_gamma_aa_laplace_rhob) &
6872!$OMP SHARED(n_gamma_aa_gamma_aa_tau_a) &
6873!$OMP SHARED(n_gamma_aa_gamma_aa_tau_b) &
6874!$OMP SHARED(n_gamma_aa_gamma_ab_gamma_ab) &
6875!$OMP SHARED(n_gamma_aa_gamma_ab_gamma_bb) &
6876!$OMP SHARED(n_gamma_aa_gamma_ab_laplace_rhoa) &
6877!$OMP SHARED(n_gamma_aa_gamma_ab_laplace_rhob) &
6878!$OMP SHARED(n_gamma_aa_gamma_ab_tau_a) &
6879!$OMP SHARED(n_gamma_aa_gamma_ab_tau_b) &
6880!$OMP SHARED(n_gamma_aa_gamma_bb_gamma_bb) &
6881!$OMP SHARED(n_gamma_aa_gamma_bb_laplace_rhoa) &
6882!$OMP SHARED(n_gamma_aa_gamma_bb_laplace_rhob) &
6883!$OMP SHARED(n_gamma_aa_gamma_bb_tau_a) &
6884!$OMP SHARED(n_gamma_aa_gamma_bb_tau_b) &
6885!$OMP SHARED(n_gamma_aa_laplace_rhoa_laplace_rhoa) &
6886!$OMP SHARED(n_gamma_aa_laplace_rhoa_laplace_rhob) &
6887!$OMP SHARED(n_gamma_aa_laplace_rhoa_tau_a) &
6888!$OMP SHARED(n_gamma_aa_laplace_rhoa_tau_b) &
6889!$OMP SHARED(n_gamma_aa_laplace_rhob_laplace_rhob) &
6890!$OMP SHARED(n_gamma_aa_laplace_rhob_tau_a) &
6891!$OMP SHARED(n_gamma_aa_laplace_rhob_tau_b) &
6892!$OMP SHARED(n_gamma_aa_tau_a_tau_a) &
6893!$OMP SHARED(n_gamma_aa_tau_a_tau_b) &
6894!$OMP SHARED(n_gamma_aa_tau_b_tau_b) &
6895!$OMP SHARED(n_gamma_ab_gamma_ab_gamma_ab) &
6896!$OMP SHARED(n_gamma_ab_gamma_ab_gamma_bb) &
6897!$OMP SHARED(n_gamma_ab_gamma_ab_laplace_rhoa) &
6898!$OMP SHARED(n_gamma_ab_gamma_ab_laplace_rhob) &
6899!$OMP SHARED(n_gamma_ab_gamma_ab_tau_a) &
6900!$OMP SHARED(n_gamma_ab_gamma_ab_tau_b) &
6901!$OMP SHARED(n_gamma_ab_gamma_bb_gamma_bb) &
6902!$OMP SHARED(n_gamma_ab_gamma_bb_laplace_rhoa) &
6903!$OMP SHARED(n_gamma_ab_gamma_bb_laplace_rhob) &
6904!$OMP SHARED(n_gamma_ab_gamma_bb_tau_a) &
6905!$OMP SHARED(n_gamma_ab_gamma_bb_tau_b) &
6906!$OMP SHARED(n_gamma_ab_laplace_rhoa_laplace_rhoa) &
6907!$OMP SHARED(n_gamma_ab_laplace_rhoa_laplace_rhob) &
6908!$OMP SHARED(n_gamma_ab_laplace_rhoa_tau_a) &
6909!$OMP SHARED(n_gamma_ab_laplace_rhoa_tau_b) &
6910!$OMP SHARED(n_gamma_ab_laplace_rhob_laplace_rhob) &
6911!$OMP SHARED(n_gamma_ab_laplace_rhob_tau_a) &
6912!$OMP SHARED(n_gamma_ab_laplace_rhob_tau_b) &
6913!$OMP SHARED(n_gamma_ab_tau_a_tau_a) &
6914!$OMP SHARED(n_gamma_ab_tau_a_tau_b) &
6915!$OMP SHARED(n_gamma_ab_tau_b_tau_b) &
6916!$OMP SHARED(n_gamma_bb_gamma_bb_gamma_bb) &
6917!$OMP SHARED(n_gamma_bb_gamma_bb_laplace_rhoa) &
6918!$OMP SHARED(n_gamma_bb_gamma_bb_laplace_rhob) &
6919!$OMP SHARED(n_gamma_bb_gamma_bb_tau_a) &
6920!$OMP SHARED(n_gamma_bb_gamma_bb_tau_b) &
6921!$OMP SHARED(n_gamma_bb_laplace_rhoa_laplace_rhoa) &
6922!$OMP SHARED(n_gamma_bb_laplace_rhoa_laplace_rhob) &
6923!$OMP SHARED(n_gamma_bb_laplace_rhoa_tau_a) &
6924!$OMP SHARED(n_gamma_bb_laplace_rhoa_tau_b) &
6925!$OMP SHARED(n_gamma_bb_laplace_rhob_laplace_rhob) &
6926!$OMP SHARED(n_gamma_bb_laplace_rhob_tau_a) &
6927!$OMP SHARED(n_gamma_bb_laplace_rhob_tau_b) &
6928!$OMP SHARED(n_gamma_bb_tau_a_tau_a) &
6929!$OMP SHARED(n_gamma_bb_tau_a_tau_b) &
6930!$OMP SHARED(n_gamma_bb_tau_b_tau_b) &
6931!$OMP SHARED(n_laplace_rhoa_laplace_rhoa_laplace_rhoa) &
6932!$OMP SHARED(n_laplace_rhoa_laplace_rhoa_laplace_rhob) &
6933!$OMP SHARED(n_laplace_rhoa_laplace_rhoa_tau_a) &
6934!$OMP SHARED(n_laplace_rhoa_laplace_rhoa_tau_b) &
6935!$OMP SHARED(n_laplace_rhoa_laplace_rhob_laplace_rhob) &
6936!$OMP SHARED(n_laplace_rhoa_laplace_rhob_tau_a) &
6937!$OMP SHARED(n_laplace_rhoa_laplace_rhob_tau_b) &
6938!$OMP SHARED(n_laplace_rhoa_tau_a_tau_a) &
6939!$OMP SHARED(n_laplace_rhoa_tau_a_tau_b) &
6940!$OMP SHARED(n_laplace_rhoa_tau_b_tau_b) &
6941!$OMP SHARED(n_laplace_rhob_laplace_rhob_laplace_rhob) &
6942!$OMP SHARED(n_laplace_rhob_laplace_rhob_tau_a) &
6943!$OMP SHARED(n_laplace_rhob_laplace_rhob_tau_b) &
6944!$OMP SHARED(n_laplace_rhob_tau_a_tau_a) &
6945!$OMP SHARED(n_laplace_rhob_tau_a_tau_b) &
6946!$OMP SHARED(n_laplace_rhob_tau_b_tau_b) &
6947!$OMP SHARED(n_tau_a_tau_a_tau_a) &
6948!$OMP SHARED(n_tau_a_tau_a_tau_b) &
6949!$OMP SHARED(n_tau_a_tau_b_tau_b) &
6950!$OMP SHARED(n_tau_b_tau_b_tau_b) &
6951!$OMP SHARED(bo,rho1a,rho1b,gaa1,gab1,gbb1,gaa11,gab11,gbb11, &
6952!$OMP tau_f,tau1a,tau1b,laplace_f,laplace1a,laplace1b, &
6953!$OMP v_xc,v_xc_tau,v_laplace,v_drho_r,drhoa,drhob,drho1a,drho1b)
6954 DO k = bo(1, 3), bo(2, 3)
6955 DO j = bo(1, 2), bo(2, 2)
6956 DO i = bo(1, 1), bo(2, 1)
6957 mp_rhoa = rho1a(i, j, k)
6958 mp_rhob = rho1b(i, j, k)
6959 mp_gamma_aa = 2.0_dp*gaa1(i, j, k)
6960 mp_gamma_ab = gab1(i, j, k)
6961 mp_gamma_bb = 2.0_dp*gbb1(i, j, k)
6962 mpp_gamma_aa = 2.0_dp*gaa11(i, j, k)
6963 mpp_gamma_ab = 2.0_dp*gab11(i, j, k)
6964 mpp_gamma_bb = 2.0_dp*gbb11(i, j, k)
6965 mp_tau_a = 0.0_dp
6966 mp_tau_b = 0.0_dp
6967 IF (tau_f) mp_tau_a = tau1a(i, j, k)
6968 IF (tau_f) mp_tau_b = tau1b(i, j, k)
6969 mp_laplace_rhoa = 0.0_dp
6970 mp_laplace_rhob = 0.0_dp
6971 IF (laplace_f) mp_laplace_rhoa = laplace1a(i, j, k)
6972 IF (laplace_f) mp_laplace_rhob = laplace1b(i, j, k)
6973
6974 q_rhoa = 0.0_dp
6975 q_rhoa = q_rhoa + 1.0_dp* &
6976 n_rhoa_rhoa_rhoa(i, j, k)*mp_rhoa*mp_rhoa
6977 q_rhoa = q_rhoa + 2.0_dp* &
6978 n_rhoa_rhoa_rhob(i, j, k)*mp_rhoa*mp_rhob
6979 q_rhoa = q_rhoa + 2.0_dp* &
6980 n_rhoa_rhoa_gamma_aa(i, j, k)*mp_rhoa*mp_gamma_aa
6981 q_rhoa = q_rhoa + 2.0_dp* &
6982 n_rhoa_rhoa_gamma_ab(i, j, k)*mp_rhoa*mp_gamma_ab
6983 q_rhoa = q_rhoa + 2.0_dp* &
6984 n_rhoa_rhoa_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_bb
6985 q_rhoa = q_rhoa + 2.0_dp* &
6986 n_rhoa_rhoa_laplace_rhoa(i, j, k)*mp_rhoa*mp_laplace_rhoa
6987 q_rhoa = q_rhoa + 2.0_dp* &
6988 n_rhoa_rhoa_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
6989 q_rhoa = q_rhoa + 2.0_dp* &
6990 n_rhoa_rhoa_tau_a(i, j, k)*mp_rhoa*mp_tau_a
6991 q_rhoa = q_rhoa + 2.0_dp* &
6992 n_rhoa_rhoa_tau_b(i, j, k)*mp_rhoa*mp_tau_b
6993 q_rhoa = q_rhoa + 1.0_dp* &
6994 n_rhoa_rhob_rhob(i, j, k)*mp_rhob*mp_rhob
6995 q_rhoa = q_rhoa + 2.0_dp* &
6996 n_rhoa_rhob_gamma_aa(i, j, k)*mp_rhob*mp_gamma_aa
6997 q_rhoa = q_rhoa + 2.0_dp* &
6998 n_rhoa_rhob_gamma_ab(i, j, k)*mp_rhob*mp_gamma_ab
6999 q_rhoa = q_rhoa + 2.0_dp* &
7000 n_rhoa_rhob_gamma_bb(i, j, k)*mp_rhob*mp_gamma_bb
7001 q_rhoa = q_rhoa + 2.0_dp* &
7002 n_rhoa_rhob_laplace_rhoa(i, j, k)*mp_rhob*mp_laplace_rhoa
7003 q_rhoa = q_rhoa + 2.0_dp* &
7004 n_rhoa_rhob_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7005 q_rhoa = q_rhoa + 2.0_dp* &
7006 n_rhoa_rhob_tau_a(i, j, k)*mp_rhob*mp_tau_a
7007 q_rhoa = q_rhoa + 2.0_dp* &
7008 n_rhoa_rhob_tau_b(i, j, k)*mp_rhob*mp_tau_b
7009 q_rhoa = q_rhoa + 1.0_dp* &
7010 n_rhoa_gamma_aa_gamma_aa(i, j, k)*mp_gamma_aa*mp_gamma_aa
7011 q_rhoa = q_rhoa + 2.0_dp* &
7012 n_rhoa_gamma_aa_gamma_ab(i, j, k)*mp_gamma_aa*mp_gamma_ab
7013 q_rhoa = q_rhoa + 2.0_dp* &
7014 n_rhoa_gamma_aa_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_bb
7015 q_rhoa = q_rhoa + 2.0_dp* &
7016 n_rhoa_gamma_aa_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7017 q_rhoa = q_rhoa + 2.0_dp* &
7018 n_rhoa_gamma_aa_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7019 q_rhoa = q_rhoa + 2.0_dp* &
7020 n_rhoa_gamma_aa_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7021 q_rhoa = q_rhoa + 2.0_dp* &
7022 n_rhoa_gamma_aa_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7023 q_rhoa = q_rhoa + 1.0_dp* &
7024 n_rhoa_gamma_ab_gamma_ab(i, j, k)*mp_gamma_ab*mp_gamma_ab
7025 q_rhoa = q_rhoa + 2.0_dp* &
7026 n_rhoa_gamma_ab_gamma_bb(i, j, k)*mp_gamma_ab*mp_gamma_bb
7027 q_rhoa = q_rhoa + 2.0_dp* &
7028 n_rhoa_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7029 q_rhoa = q_rhoa + 2.0_dp* &
7030 n_rhoa_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7031 q_rhoa = q_rhoa + 2.0_dp* &
7032 n_rhoa_gamma_ab_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7033 q_rhoa = q_rhoa + 2.0_dp* &
7034 n_rhoa_gamma_ab_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7035 q_rhoa = q_rhoa + 1.0_dp* &
7036 n_rhoa_gamma_bb_gamma_bb(i, j, k)*mp_gamma_bb*mp_gamma_bb
7037 q_rhoa = q_rhoa + 2.0_dp* &
7038 n_rhoa_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7039 q_rhoa = q_rhoa + 2.0_dp* &
7040 n_rhoa_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7041 q_rhoa = q_rhoa + 2.0_dp* &
7042 n_rhoa_gamma_bb_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7043 q_rhoa = q_rhoa + 2.0_dp* &
7044 n_rhoa_gamma_bb_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7045 q_rhoa = q_rhoa + 1.0_dp* &
7046 n_rhoa_laplace_rhoa_laplace_rhoa(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7047 q_rhoa = q_rhoa + 2.0_dp* &
7048 n_rhoa_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7049 q_rhoa = q_rhoa + 2.0_dp* &
7050 n_rhoa_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7051 q_rhoa = q_rhoa + 2.0_dp* &
7052 n_rhoa_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7053 q_rhoa = q_rhoa + 1.0_dp* &
7054 n_rhoa_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7055 q_rhoa = q_rhoa + 2.0_dp* &
7056 n_rhoa_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7057 q_rhoa = q_rhoa + 2.0_dp* &
7058 n_rhoa_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7059 q_rhoa = q_rhoa + 1.0_dp* &
7060 n_rhoa_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7061 q_rhoa = q_rhoa + 2.0_dp* &
7062 n_rhoa_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7063 q_rhoa = q_rhoa + 1.0_dp* &
7064 n_rhoa_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7065 q_rhoa = q_rhoa + n_rhoa_gamma_aa(i, j, k)*mpp_gamma_aa
7066 q_rhoa = q_rhoa + n_rhoa_gamma_ab(i, j, k)*mpp_gamma_ab
7067 q_rhoa = q_rhoa + n_rhoa_gamma_bb(i, j, k)*mpp_gamma_bb
7068 q_rhob = 0.0_dp
7069 q_rhob = q_rhob + 1.0_dp* &
7070 n_rhoa_rhoa_rhob(i, j, k)*mp_rhoa*mp_rhoa
7071 q_rhob = q_rhob + 2.0_dp* &
7072 n_rhoa_rhob_rhob(i, j, k)*mp_rhoa*mp_rhob
7073 q_rhob = q_rhob + 2.0_dp* &
7074 n_rhoa_rhob_gamma_aa(i, j, k)*mp_rhoa*mp_gamma_aa
7075 q_rhob = q_rhob + 2.0_dp* &
7076 n_rhoa_rhob_gamma_ab(i, j, k)*mp_rhoa*mp_gamma_ab
7077 q_rhob = q_rhob + 2.0_dp* &
7078 n_rhoa_rhob_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_bb
7079 q_rhob = q_rhob + 2.0_dp* &
7080 n_rhoa_rhob_laplace_rhoa(i, j, k)*mp_rhoa*mp_laplace_rhoa
7081 q_rhob = q_rhob + 2.0_dp* &
7082 n_rhoa_rhob_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
7083 q_rhob = q_rhob + 2.0_dp* &
7084 n_rhoa_rhob_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7085 q_rhob = q_rhob + 2.0_dp* &
7086 n_rhoa_rhob_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7087 q_rhob = q_rhob + 1.0_dp* &
7088 n_rhob_rhob_rhob(i, j, k)*mp_rhob*mp_rhob
7089 q_rhob = q_rhob + 2.0_dp* &
7090 n_rhob_rhob_gamma_aa(i, j, k)*mp_rhob*mp_gamma_aa
7091 q_rhob = q_rhob + 2.0_dp* &
7092 n_rhob_rhob_gamma_ab(i, j, k)*mp_rhob*mp_gamma_ab
7093 q_rhob = q_rhob + 2.0_dp* &
7094 n_rhob_rhob_gamma_bb(i, j, k)*mp_rhob*mp_gamma_bb
7095 q_rhob = q_rhob + 2.0_dp* &
7096 n_rhob_rhob_laplace_rhoa(i, j, k)*mp_rhob*mp_laplace_rhoa
7097 q_rhob = q_rhob + 2.0_dp* &
7098 n_rhob_rhob_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7099 q_rhob = q_rhob + 2.0_dp* &
7100 n_rhob_rhob_tau_a(i, j, k)*mp_rhob*mp_tau_a
7101 q_rhob = q_rhob + 2.0_dp* &
7102 n_rhob_rhob_tau_b(i, j, k)*mp_rhob*mp_tau_b
7103 q_rhob = q_rhob + 1.0_dp* &
7104 n_rhob_gamma_aa_gamma_aa(i, j, k)*mp_gamma_aa*mp_gamma_aa
7105 q_rhob = q_rhob + 2.0_dp* &
7106 n_rhob_gamma_aa_gamma_ab(i, j, k)*mp_gamma_aa*mp_gamma_ab
7107 q_rhob = q_rhob + 2.0_dp* &
7108 n_rhob_gamma_aa_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_bb
7109 q_rhob = q_rhob + 2.0_dp* &
7110 n_rhob_gamma_aa_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7111 q_rhob = q_rhob + 2.0_dp* &
7112 n_rhob_gamma_aa_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7113 q_rhob = q_rhob + 2.0_dp* &
7114 n_rhob_gamma_aa_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7115 q_rhob = q_rhob + 2.0_dp* &
7116 n_rhob_gamma_aa_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7117 q_rhob = q_rhob + 1.0_dp* &
7118 n_rhob_gamma_ab_gamma_ab(i, j, k)*mp_gamma_ab*mp_gamma_ab
7119 q_rhob = q_rhob + 2.0_dp* &
7120 n_rhob_gamma_ab_gamma_bb(i, j, k)*mp_gamma_ab*mp_gamma_bb
7121 q_rhob = q_rhob + 2.0_dp* &
7122 n_rhob_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7123 q_rhob = q_rhob + 2.0_dp* &
7124 n_rhob_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7125 q_rhob = q_rhob + 2.0_dp* &
7126 n_rhob_gamma_ab_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7127 q_rhob = q_rhob + 2.0_dp* &
7128 n_rhob_gamma_ab_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7129 q_rhob = q_rhob + 1.0_dp* &
7130 n_rhob_gamma_bb_gamma_bb(i, j, k)*mp_gamma_bb*mp_gamma_bb
7131 q_rhob = q_rhob + 2.0_dp* &
7132 n_rhob_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7133 q_rhob = q_rhob + 2.0_dp* &
7134 n_rhob_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7135 q_rhob = q_rhob + 2.0_dp* &
7136 n_rhob_gamma_bb_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7137 q_rhob = q_rhob + 2.0_dp* &
7138 n_rhob_gamma_bb_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7139 q_rhob = q_rhob + 1.0_dp* &
7140 n_rhob_laplace_rhoa_laplace_rhoa(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7141 q_rhob = q_rhob + 2.0_dp* &
7142 n_rhob_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7143 q_rhob = q_rhob + 2.0_dp* &
7144 n_rhob_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7145 q_rhob = q_rhob + 2.0_dp* &
7146 n_rhob_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7147 q_rhob = q_rhob + 1.0_dp* &
7148 n_rhob_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7149 q_rhob = q_rhob + 2.0_dp* &
7150 n_rhob_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7151 q_rhob = q_rhob + 2.0_dp* &
7152 n_rhob_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7153 q_rhob = q_rhob + 1.0_dp* &
7154 n_rhob_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7155 q_rhob = q_rhob + 2.0_dp* &
7156 n_rhob_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7157 q_rhob = q_rhob + 1.0_dp* &
7158 n_rhob_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7159 q_rhob = q_rhob + n_rhob_gamma_aa(i, j, k)*mpp_gamma_aa
7160 q_rhob = q_rhob + n_rhob_gamma_ab(i, j, k)*mpp_gamma_ab
7161 q_rhob = q_rhob + n_rhob_gamma_bb(i, j, k)*mpp_gamma_bb
7162 q_gamma_aa = 0.0_dp
7163 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7164 n_rhoa_rhoa_gamma_aa(i, j, k)*mp_rhoa*mp_rhoa
7165 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7166 n_rhoa_rhob_gamma_aa(i, j, k)*mp_rhoa*mp_rhob
7167 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7168 n_rhoa_gamma_aa_gamma_aa(i, j, k)*mp_rhoa*mp_gamma_aa
7169 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7170 n_rhoa_gamma_aa_gamma_ab(i, j, k)*mp_rhoa*mp_gamma_ab
7171 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7172 n_rhoa_gamma_aa_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_bb
7173 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7174 n_rhoa_gamma_aa_laplace_rhoa(i, j, k)*mp_rhoa*mp_laplace_rhoa
7175 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7176 n_rhoa_gamma_aa_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
7177 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7178 n_rhoa_gamma_aa_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7179 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7180 n_rhoa_gamma_aa_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7181 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7182 n_rhob_rhob_gamma_aa(i, j, k)*mp_rhob*mp_rhob
7183 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7184 n_rhob_gamma_aa_gamma_aa(i, j, k)*mp_rhob*mp_gamma_aa
7185 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7186 n_rhob_gamma_aa_gamma_ab(i, j, k)*mp_rhob*mp_gamma_ab
7187 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7188 n_rhob_gamma_aa_gamma_bb(i, j, k)*mp_rhob*mp_gamma_bb
7189 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7190 n_rhob_gamma_aa_laplace_rhoa(i, j, k)*mp_rhob*mp_laplace_rhoa
7191 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7192 n_rhob_gamma_aa_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7193 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7194 n_rhob_gamma_aa_tau_a(i, j, k)*mp_rhob*mp_tau_a
7195 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7196 n_rhob_gamma_aa_tau_b(i, j, k)*mp_rhob*mp_tau_b
7197 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7198 n_gamma_aa_gamma_aa_gamma_aa(i, j, k)*mp_gamma_aa*mp_gamma_aa
7199 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7200 n_gamma_aa_gamma_aa_gamma_ab(i, j, k)*mp_gamma_aa*mp_gamma_ab
7201 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7202 n_gamma_aa_gamma_aa_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_bb
7203 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7204 n_gamma_aa_gamma_aa_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7205 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7206 n_gamma_aa_gamma_aa_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7207 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7208 n_gamma_aa_gamma_aa_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7209 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7210 n_gamma_aa_gamma_aa_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7211 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7212 n_gamma_aa_gamma_ab_gamma_ab(i, j, k)*mp_gamma_ab*mp_gamma_ab
7213 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7214 n_gamma_aa_gamma_ab_gamma_bb(i, j, k)*mp_gamma_ab*mp_gamma_bb
7215 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7216 n_gamma_aa_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7217 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7218 n_gamma_aa_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7219 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7220 n_gamma_aa_gamma_ab_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7221 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7222 n_gamma_aa_gamma_ab_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7223 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7224 n_gamma_aa_gamma_bb_gamma_bb(i, j, k)*mp_gamma_bb*mp_gamma_bb
7225 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7226 n_gamma_aa_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7227 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7228 n_gamma_aa_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7229 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7230 n_gamma_aa_gamma_bb_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7231 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7232 n_gamma_aa_gamma_bb_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7233 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7234 n_gamma_aa_laplace_rhoa_laplace_rhoa(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7235 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7236 n_gamma_aa_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7237 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7238 n_gamma_aa_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7239 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7240 n_gamma_aa_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7241 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7242 n_gamma_aa_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7243 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7244 n_gamma_aa_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7245 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7246 n_gamma_aa_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7247 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7248 n_gamma_aa_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7249 q_gamma_aa = q_gamma_aa + 2.0_dp* &
7250 n_gamma_aa_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7251 q_gamma_aa = q_gamma_aa + 1.0_dp* &
7252 n_gamma_aa_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7253 q_gamma_aa = q_gamma_aa + n_gamma_aa_gamma_aa(i, j, k)*mpp_gamma_aa
7254 q_gamma_aa = q_gamma_aa + n_gamma_aa_gamma_ab(i, j, k)*mpp_gamma_ab
7255 q_gamma_aa = q_gamma_aa + n_gamma_aa_gamma_bb(i, j, k)*mpp_gamma_bb
7256 q_gamma_ab = 0.0_dp
7257 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7258 n_rhoa_rhoa_gamma_ab(i, j, k)*mp_rhoa*mp_rhoa
7259 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7260 n_rhoa_rhob_gamma_ab(i, j, k)*mp_rhoa*mp_rhob
7261 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7262 n_rhoa_gamma_aa_gamma_ab(i, j, k)*mp_rhoa*mp_gamma_aa
7263 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7264 n_rhoa_gamma_ab_gamma_ab(i, j, k)*mp_rhoa*mp_gamma_ab
7265 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7266 n_rhoa_gamma_ab_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_bb
7267 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7268 n_rhoa_gamma_ab_laplace_rhoa(i, j, k)*mp_rhoa*mp_laplace_rhoa
7269 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7270 n_rhoa_gamma_ab_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
7271 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7272 n_rhoa_gamma_ab_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7273 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7274 n_rhoa_gamma_ab_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7275 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7276 n_rhob_rhob_gamma_ab(i, j, k)*mp_rhob*mp_rhob
7277 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7278 n_rhob_gamma_aa_gamma_ab(i, j, k)*mp_rhob*mp_gamma_aa
7279 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7280 n_rhob_gamma_ab_gamma_ab(i, j, k)*mp_rhob*mp_gamma_ab
7281 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7282 n_rhob_gamma_ab_gamma_bb(i, j, k)*mp_rhob*mp_gamma_bb
7283 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7284 n_rhob_gamma_ab_laplace_rhoa(i, j, k)*mp_rhob*mp_laplace_rhoa
7285 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7286 n_rhob_gamma_ab_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7287 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7288 n_rhob_gamma_ab_tau_a(i, j, k)*mp_rhob*mp_tau_a
7289 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7290 n_rhob_gamma_ab_tau_b(i, j, k)*mp_rhob*mp_tau_b
7291 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7292 n_gamma_aa_gamma_aa_gamma_ab(i, j, k)*mp_gamma_aa*mp_gamma_aa
7293 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7294 n_gamma_aa_gamma_ab_gamma_ab(i, j, k)*mp_gamma_aa*mp_gamma_ab
7295 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7296 n_gamma_aa_gamma_ab_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_bb
7297 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7298 n_gamma_aa_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7299 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7300 n_gamma_aa_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7301 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7302 n_gamma_aa_gamma_ab_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7303 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7304 n_gamma_aa_gamma_ab_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7305 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7306 n_gamma_ab_gamma_ab_gamma_ab(i, j, k)*mp_gamma_ab*mp_gamma_ab
7307 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7308 n_gamma_ab_gamma_ab_gamma_bb(i, j, k)*mp_gamma_ab*mp_gamma_bb
7309 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7310 n_gamma_ab_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7311 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7312 n_gamma_ab_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7313 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7314 n_gamma_ab_gamma_ab_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7315 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7316 n_gamma_ab_gamma_ab_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7317 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7318 n_gamma_ab_gamma_bb_gamma_bb(i, j, k)*mp_gamma_bb*mp_gamma_bb
7319 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7320 n_gamma_ab_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7321 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7322 n_gamma_ab_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7323 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7324 n_gamma_ab_gamma_bb_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7325 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7326 n_gamma_ab_gamma_bb_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7327 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7328 n_gamma_ab_laplace_rhoa_laplace_rhoa(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7329 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7330 n_gamma_ab_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7331 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7332 n_gamma_ab_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7333 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7334 n_gamma_ab_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7335 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7336 n_gamma_ab_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7337 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7338 n_gamma_ab_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7339 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7340 n_gamma_ab_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7341 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7342 n_gamma_ab_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7343 q_gamma_ab = q_gamma_ab + 2.0_dp* &
7344 n_gamma_ab_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7345 q_gamma_ab = q_gamma_ab + 1.0_dp* &
7346 n_gamma_ab_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7347 q_gamma_ab = q_gamma_ab + n_gamma_aa_gamma_ab(i, j, k)*mpp_gamma_aa
7348 q_gamma_ab = q_gamma_ab + n_gamma_ab_gamma_ab(i, j, k)*mpp_gamma_ab
7349 q_gamma_ab = q_gamma_ab + n_gamma_ab_gamma_bb(i, j, k)*mpp_gamma_bb
7350 q_gamma_bb = 0.0_dp
7351 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7352 n_rhoa_rhoa_gamma_bb(i, j, k)*mp_rhoa*mp_rhoa
7353 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7354 n_rhoa_rhob_gamma_bb(i, j, k)*mp_rhoa*mp_rhob
7355 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7356 n_rhoa_gamma_aa_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_aa
7357 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7358 n_rhoa_gamma_ab_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_ab
7359 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7360 n_rhoa_gamma_bb_gamma_bb(i, j, k)*mp_rhoa*mp_gamma_bb
7361 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7362 n_rhoa_gamma_bb_laplace_rhoa(i, j, k)*mp_rhoa*mp_laplace_rhoa
7363 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7364 n_rhoa_gamma_bb_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
7365 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7366 n_rhoa_gamma_bb_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7367 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7368 n_rhoa_gamma_bb_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7369 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7370 n_rhob_rhob_gamma_bb(i, j, k)*mp_rhob*mp_rhob
7371 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7372 n_rhob_gamma_aa_gamma_bb(i, j, k)*mp_rhob*mp_gamma_aa
7373 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7374 n_rhob_gamma_ab_gamma_bb(i, j, k)*mp_rhob*mp_gamma_ab
7375 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7376 n_rhob_gamma_bb_gamma_bb(i, j, k)*mp_rhob*mp_gamma_bb
7377 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7378 n_rhob_gamma_bb_laplace_rhoa(i, j, k)*mp_rhob*mp_laplace_rhoa
7379 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7380 n_rhob_gamma_bb_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7381 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7382 n_rhob_gamma_bb_tau_a(i, j, k)*mp_rhob*mp_tau_a
7383 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7384 n_rhob_gamma_bb_tau_b(i, j, k)*mp_rhob*mp_tau_b
7385 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7386 n_gamma_aa_gamma_aa_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_aa
7387 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7388 n_gamma_aa_gamma_ab_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_ab
7389 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7390 n_gamma_aa_gamma_bb_gamma_bb(i, j, k)*mp_gamma_aa*mp_gamma_bb
7391 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7392 n_gamma_aa_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7393 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7394 n_gamma_aa_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7395 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7396 n_gamma_aa_gamma_bb_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7397 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7398 n_gamma_aa_gamma_bb_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7399 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7400 n_gamma_ab_gamma_ab_gamma_bb(i, j, k)*mp_gamma_ab*mp_gamma_ab
7401 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7402 n_gamma_ab_gamma_bb_gamma_bb(i, j, k)*mp_gamma_ab*mp_gamma_bb
7403 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7404 n_gamma_ab_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7405 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7406 n_gamma_ab_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7407 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7408 n_gamma_ab_gamma_bb_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7409 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7410 n_gamma_ab_gamma_bb_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7411 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7412 n_gamma_bb_gamma_bb_gamma_bb(i, j, k)*mp_gamma_bb*mp_gamma_bb
7413 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7414 n_gamma_bb_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7415 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7416 n_gamma_bb_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7417 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7418 n_gamma_bb_gamma_bb_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7419 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7420 n_gamma_bb_gamma_bb_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7421 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7422 n_gamma_bb_laplace_rhoa_laplace_rhoa(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7423 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7424 n_gamma_bb_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7425 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7426 n_gamma_bb_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7427 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7428 n_gamma_bb_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7429 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7430 n_gamma_bb_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7431 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7432 n_gamma_bb_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7433 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7434 n_gamma_bb_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7435 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7436 n_gamma_bb_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7437 q_gamma_bb = q_gamma_bb + 2.0_dp* &
7438 n_gamma_bb_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7439 q_gamma_bb = q_gamma_bb + 1.0_dp* &
7440 n_gamma_bb_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7441 q_gamma_bb = q_gamma_bb + n_gamma_aa_gamma_bb(i, j, k)*mpp_gamma_aa
7442 q_gamma_bb = q_gamma_bb + n_gamma_ab_gamma_bb(i, j, k)*mpp_gamma_ab
7443 q_gamma_bb = q_gamma_bb + n_gamma_bb_gamma_bb(i, j, k)*mpp_gamma_bb
7444 q_laplace_rhoa = 0.0_dp
7445 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7446 n_rhoa_rhoa_laplace_rhoa(i, j, k)*mp_rhoa*mp_rhoa
7447 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7448 n_rhoa_rhob_laplace_rhoa(i, j, k)*mp_rhoa*mp_rhob
7449 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7450 n_rhoa_gamma_aa_laplace_rhoa(i, j, k)*mp_rhoa*mp_gamma_aa
7451 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7452 n_rhoa_gamma_ab_laplace_rhoa(i, j, k)*mp_rhoa*mp_gamma_ab
7453 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7454 n_rhoa_gamma_bb_laplace_rhoa(i, j, k)*mp_rhoa*mp_gamma_bb
7455 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7456 n_rhoa_laplace_rhoa_laplace_rhoa(i, j, k)*mp_rhoa*mp_laplace_rhoa
7457 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7458 n_rhoa_laplace_rhoa_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
7459 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7460 n_rhoa_laplace_rhoa_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7461 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7462 n_rhoa_laplace_rhoa_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7463 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7464 n_rhob_rhob_laplace_rhoa(i, j, k)*mp_rhob*mp_rhob
7465 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7466 n_rhob_gamma_aa_laplace_rhoa(i, j, k)*mp_rhob*mp_gamma_aa
7467 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7468 n_rhob_gamma_ab_laplace_rhoa(i, j, k)*mp_rhob*mp_gamma_ab
7469 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7470 n_rhob_gamma_bb_laplace_rhoa(i, j, k)*mp_rhob*mp_gamma_bb
7471 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7472 n_rhob_laplace_rhoa_laplace_rhoa(i, j, k)*mp_rhob*mp_laplace_rhoa
7473 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7474 n_rhob_laplace_rhoa_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7475 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7476 n_rhob_laplace_rhoa_tau_a(i, j, k)*mp_rhob*mp_tau_a
7477 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7478 n_rhob_laplace_rhoa_tau_b(i, j, k)*mp_rhob*mp_tau_b
7479 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7480 n_gamma_aa_gamma_aa_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_gamma_aa
7481 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7482 n_gamma_aa_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_gamma_ab
7483 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7484 n_gamma_aa_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_gamma_bb
7485 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7486 n_gamma_aa_laplace_rhoa_laplace_rhoa(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7487 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7488 n_gamma_aa_laplace_rhoa_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7489 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7490 n_gamma_aa_laplace_rhoa_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7491 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7492 n_gamma_aa_laplace_rhoa_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7493 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7494 n_gamma_ab_gamma_ab_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_gamma_ab
7495 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7496 n_gamma_ab_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_gamma_bb
7497 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7498 n_gamma_ab_laplace_rhoa_laplace_rhoa(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7499 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7500 n_gamma_ab_laplace_rhoa_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7501 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7502 n_gamma_ab_laplace_rhoa_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7503 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7504 n_gamma_ab_laplace_rhoa_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7505 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7506 n_gamma_bb_gamma_bb_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_gamma_bb
7507 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7508 n_gamma_bb_laplace_rhoa_laplace_rhoa(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7509 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7510 n_gamma_bb_laplace_rhoa_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7511 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7512 n_gamma_bb_laplace_rhoa_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7513 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7514 n_gamma_bb_laplace_rhoa_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7515 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7516 n_laplace_rhoa_laplace_rhoa_laplace_rhoa(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7517 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7518 n_laplace_rhoa_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7519 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7520 n_laplace_rhoa_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7521 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7522 n_laplace_rhoa_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7523 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7524 n_laplace_rhoa_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7525 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7526 n_laplace_rhoa_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7527 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7528 n_laplace_rhoa_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7529 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7530 n_laplace_rhoa_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7531 q_laplace_rhoa = q_laplace_rhoa + 2.0_dp* &
7532 n_laplace_rhoa_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7533 q_laplace_rhoa = q_laplace_rhoa + 1.0_dp* &
7534 n_laplace_rhoa_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7535 q_laplace_rhoa = q_laplace_rhoa + n_gamma_aa_laplace_rhoa(i, j, k)*mpp_gamma_aa
7536 q_laplace_rhoa = q_laplace_rhoa + n_gamma_ab_laplace_rhoa(i, j, k)*mpp_gamma_ab
7537 q_laplace_rhoa = q_laplace_rhoa + n_gamma_bb_laplace_rhoa(i, j, k)*mpp_gamma_bb
7538 q_laplace_rhob = 0.0_dp
7539 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7540 n_rhoa_rhoa_laplace_rhob(i, j, k)*mp_rhoa*mp_rhoa
7541 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7542 n_rhoa_rhob_laplace_rhob(i, j, k)*mp_rhoa*mp_rhob
7543 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7544 n_rhoa_gamma_aa_laplace_rhob(i, j, k)*mp_rhoa*mp_gamma_aa
7545 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7546 n_rhoa_gamma_ab_laplace_rhob(i, j, k)*mp_rhoa*mp_gamma_ab
7547 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7548 n_rhoa_gamma_bb_laplace_rhob(i, j, k)*mp_rhoa*mp_gamma_bb
7549 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7550 n_rhoa_laplace_rhoa_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhoa
7551 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7552 n_rhoa_laplace_rhob_laplace_rhob(i, j, k)*mp_rhoa*mp_laplace_rhob
7553 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7554 n_rhoa_laplace_rhob_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7555 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7556 n_rhoa_laplace_rhob_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7557 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7558 n_rhob_rhob_laplace_rhob(i, j, k)*mp_rhob*mp_rhob
7559 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7560 n_rhob_gamma_aa_laplace_rhob(i, j, k)*mp_rhob*mp_gamma_aa
7561 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7562 n_rhob_gamma_ab_laplace_rhob(i, j, k)*mp_rhob*mp_gamma_ab
7563 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7564 n_rhob_gamma_bb_laplace_rhob(i, j, k)*mp_rhob*mp_gamma_bb
7565 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7566 n_rhob_laplace_rhoa_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhoa
7567 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7568 n_rhob_laplace_rhob_laplace_rhob(i, j, k)*mp_rhob*mp_laplace_rhob
7569 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7570 n_rhob_laplace_rhob_tau_a(i, j, k)*mp_rhob*mp_tau_a
7571 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7572 n_rhob_laplace_rhob_tau_b(i, j, k)*mp_rhob*mp_tau_b
7573 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7574 n_gamma_aa_gamma_aa_laplace_rhob(i, j, k)*mp_gamma_aa*mp_gamma_aa
7575 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7576 n_gamma_aa_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_aa*mp_gamma_ab
7577 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7578 n_gamma_aa_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_aa*mp_gamma_bb
7579 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7580 n_gamma_aa_laplace_rhoa_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7581 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7582 n_gamma_aa_laplace_rhob_laplace_rhob(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7583 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7584 n_gamma_aa_laplace_rhob_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7585 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7586 n_gamma_aa_laplace_rhob_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7587 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7588 n_gamma_ab_gamma_ab_laplace_rhob(i, j, k)*mp_gamma_ab*mp_gamma_ab
7589 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7590 n_gamma_ab_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_ab*mp_gamma_bb
7591 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7592 n_gamma_ab_laplace_rhoa_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7593 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7594 n_gamma_ab_laplace_rhob_laplace_rhob(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7595 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7596 n_gamma_ab_laplace_rhob_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7597 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7598 n_gamma_ab_laplace_rhob_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7599 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7600 n_gamma_bb_gamma_bb_laplace_rhob(i, j, k)*mp_gamma_bb*mp_gamma_bb
7601 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7602 n_gamma_bb_laplace_rhoa_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7603 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7604 n_gamma_bb_laplace_rhob_laplace_rhob(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7605 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7606 n_gamma_bb_laplace_rhob_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7607 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7608 n_gamma_bb_laplace_rhob_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7609 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7610 n_laplace_rhoa_laplace_rhoa_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7611 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7612 n_laplace_rhoa_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7613 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7614 n_laplace_rhoa_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7615 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7616 n_laplace_rhoa_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7617 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7618 n_laplace_rhob_laplace_rhob_laplace_rhob(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7619 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7620 n_laplace_rhob_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7621 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7622 n_laplace_rhob_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7623 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7624 n_laplace_rhob_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7625 q_laplace_rhob = q_laplace_rhob + 2.0_dp* &
7626 n_laplace_rhob_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7627 q_laplace_rhob = q_laplace_rhob + 1.0_dp* &
7628 n_laplace_rhob_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7629 q_laplace_rhob = q_laplace_rhob + n_gamma_aa_laplace_rhob(i, j, k)*mpp_gamma_aa
7630 q_laplace_rhob = q_laplace_rhob + n_gamma_ab_laplace_rhob(i, j, k)*mpp_gamma_ab
7631 q_laplace_rhob = q_laplace_rhob + n_gamma_bb_laplace_rhob(i, j, k)*mpp_gamma_bb
7632 q_tau_a = 0.0_dp
7633 q_tau_a = q_tau_a + 1.0_dp* &
7634 n_rhoa_rhoa_tau_a(i, j, k)*mp_rhoa*mp_rhoa
7635 q_tau_a = q_tau_a + 2.0_dp* &
7636 n_rhoa_rhob_tau_a(i, j, k)*mp_rhoa*mp_rhob
7637 q_tau_a = q_tau_a + 2.0_dp* &
7638 n_rhoa_gamma_aa_tau_a(i, j, k)*mp_rhoa*mp_gamma_aa
7639 q_tau_a = q_tau_a + 2.0_dp* &
7640 n_rhoa_gamma_ab_tau_a(i, j, k)*mp_rhoa*mp_gamma_ab
7641 q_tau_a = q_tau_a + 2.0_dp* &
7642 n_rhoa_gamma_bb_tau_a(i, j, k)*mp_rhoa*mp_gamma_bb
7643 q_tau_a = q_tau_a + 2.0_dp* &
7644 n_rhoa_laplace_rhoa_tau_a(i, j, k)*mp_rhoa*mp_laplace_rhoa
7645 q_tau_a = q_tau_a + 2.0_dp* &
7646 n_rhoa_laplace_rhob_tau_a(i, j, k)*mp_rhoa*mp_laplace_rhob
7647 q_tau_a = q_tau_a + 2.0_dp* &
7648 n_rhoa_tau_a_tau_a(i, j, k)*mp_rhoa*mp_tau_a
7649 q_tau_a = q_tau_a + 2.0_dp* &
7650 n_rhoa_tau_a_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7651 q_tau_a = q_tau_a + 1.0_dp* &
7652 n_rhob_rhob_tau_a(i, j, k)*mp_rhob*mp_rhob
7653 q_tau_a = q_tau_a + 2.0_dp* &
7654 n_rhob_gamma_aa_tau_a(i, j, k)*mp_rhob*mp_gamma_aa
7655 q_tau_a = q_tau_a + 2.0_dp* &
7656 n_rhob_gamma_ab_tau_a(i, j, k)*mp_rhob*mp_gamma_ab
7657 q_tau_a = q_tau_a + 2.0_dp* &
7658 n_rhob_gamma_bb_tau_a(i, j, k)*mp_rhob*mp_gamma_bb
7659 q_tau_a = q_tau_a + 2.0_dp* &
7660 n_rhob_laplace_rhoa_tau_a(i, j, k)*mp_rhob*mp_laplace_rhoa
7661 q_tau_a = q_tau_a + 2.0_dp* &
7662 n_rhob_laplace_rhob_tau_a(i, j, k)*mp_rhob*mp_laplace_rhob
7663 q_tau_a = q_tau_a + 2.0_dp* &
7664 n_rhob_tau_a_tau_a(i, j, k)*mp_rhob*mp_tau_a
7665 q_tau_a = q_tau_a + 2.0_dp* &
7666 n_rhob_tau_a_tau_b(i, j, k)*mp_rhob*mp_tau_b
7667 q_tau_a = q_tau_a + 1.0_dp* &
7668 n_gamma_aa_gamma_aa_tau_a(i, j, k)*mp_gamma_aa*mp_gamma_aa
7669 q_tau_a = q_tau_a + 2.0_dp* &
7670 n_gamma_aa_gamma_ab_tau_a(i, j, k)*mp_gamma_aa*mp_gamma_ab
7671 q_tau_a = q_tau_a + 2.0_dp* &
7672 n_gamma_aa_gamma_bb_tau_a(i, j, k)*mp_gamma_aa*mp_gamma_bb
7673 q_tau_a = q_tau_a + 2.0_dp* &
7674 n_gamma_aa_laplace_rhoa_tau_a(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7675 q_tau_a = q_tau_a + 2.0_dp* &
7676 n_gamma_aa_laplace_rhob_tau_a(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7677 q_tau_a = q_tau_a + 2.0_dp* &
7678 n_gamma_aa_tau_a_tau_a(i, j, k)*mp_gamma_aa*mp_tau_a
7679 q_tau_a = q_tau_a + 2.0_dp* &
7680 n_gamma_aa_tau_a_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7681 q_tau_a = q_tau_a + 1.0_dp* &
7682 n_gamma_ab_gamma_ab_tau_a(i, j, k)*mp_gamma_ab*mp_gamma_ab
7683 q_tau_a = q_tau_a + 2.0_dp* &
7684 n_gamma_ab_gamma_bb_tau_a(i, j, k)*mp_gamma_ab*mp_gamma_bb
7685 q_tau_a = q_tau_a + 2.0_dp* &
7686 n_gamma_ab_laplace_rhoa_tau_a(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7687 q_tau_a = q_tau_a + 2.0_dp* &
7688 n_gamma_ab_laplace_rhob_tau_a(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7689 q_tau_a = q_tau_a + 2.0_dp* &
7690 n_gamma_ab_tau_a_tau_a(i, j, k)*mp_gamma_ab*mp_tau_a
7691 q_tau_a = q_tau_a + 2.0_dp* &
7692 n_gamma_ab_tau_a_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7693 q_tau_a = q_tau_a + 1.0_dp* &
7694 n_gamma_bb_gamma_bb_tau_a(i, j, k)*mp_gamma_bb*mp_gamma_bb
7695 q_tau_a = q_tau_a + 2.0_dp* &
7696 n_gamma_bb_laplace_rhoa_tau_a(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7697 q_tau_a = q_tau_a + 2.0_dp* &
7698 n_gamma_bb_laplace_rhob_tau_a(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7699 q_tau_a = q_tau_a + 2.0_dp* &
7700 n_gamma_bb_tau_a_tau_a(i, j, k)*mp_gamma_bb*mp_tau_a
7701 q_tau_a = q_tau_a + 2.0_dp* &
7702 n_gamma_bb_tau_a_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7703 q_tau_a = q_tau_a + 1.0_dp* &
7704 n_laplace_rhoa_laplace_rhoa_tau_a(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7705 q_tau_a = q_tau_a + 2.0_dp* &
7706 n_laplace_rhoa_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7707 q_tau_a = q_tau_a + 2.0_dp* &
7708 n_laplace_rhoa_tau_a_tau_a(i, j, k)*mp_laplace_rhoa*mp_tau_a
7709 q_tau_a = q_tau_a + 2.0_dp* &
7710 n_laplace_rhoa_tau_a_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7711 q_tau_a = q_tau_a + 1.0_dp* &
7712 n_laplace_rhob_laplace_rhob_tau_a(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7713 q_tau_a = q_tau_a + 2.0_dp* &
7714 n_laplace_rhob_tau_a_tau_a(i, j, k)*mp_laplace_rhob*mp_tau_a
7715 q_tau_a = q_tau_a + 2.0_dp* &
7716 n_laplace_rhob_tau_a_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7717 q_tau_a = q_tau_a + 1.0_dp* &
7718 n_tau_a_tau_a_tau_a(i, j, k)*mp_tau_a*mp_tau_a
7719 q_tau_a = q_tau_a + 2.0_dp* &
7720 n_tau_a_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7721 q_tau_a = q_tau_a + 1.0_dp* &
7722 n_tau_a_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7723 q_tau_a = q_tau_a + n_gamma_aa_tau_a(i, j, k)*mpp_gamma_aa
7724 q_tau_a = q_tau_a + n_gamma_ab_tau_a(i, j, k)*mpp_gamma_ab
7725 q_tau_a = q_tau_a + n_gamma_bb_tau_a(i, j, k)*mpp_gamma_bb
7726 q_tau_b = 0.0_dp
7727 q_tau_b = q_tau_b + 1.0_dp* &
7728 n_rhoa_rhoa_tau_b(i, j, k)*mp_rhoa*mp_rhoa
7729 q_tau_b = q_tau_b + 2.0_dp* &
7730 n_rhoa_rhob_tau_b(i, j, k)*mp_rhoa*mp_rhob
7731 q_tau_b = q_tau_b + 2.0_dp* &
7732 n_rhoa_gamma_aa_tau_b(i, j, k)*mp_rhoa*mp_gamma_aa
7733 q_tau_b = q_tau_b + 2.0_dp* &
7734 n_rhoa_gamma_ab_tau_b(i, j, k)*mp_rhoa*mp_gamma_ab
7735 q_tau_b = q_tau_b + 2.0_dp* &
7736 n_rhoa_gamma_bb_tau_b(i, j, k)*mp_rhoa*mp_gamma_bb
7737 q_tau_b = q_tau_b + 2.0_dp* &
7738 n_rhoa_laplace_rhoa_tau_b(i, j, k)*mp_rhoa*mp_laplace_rhoa
7739 q_tau_b = q_tau_b + 2.0_dp* &
7740 n_rhoa_laplace_rhob_tau_b(i, j, k)*mp_rhoa*mp_laplace_rhob
7741 q_tau_b = q_tau_b + 2.0_dp* &
7742 n_rhoa_tau_a_tau_b(i, j, k)*mp_rhoa*mp_tau_a
7743 q_tau_b = q_tau_b + 2.0_dp* &
7744 n_rhoa_tau_b_tau_b(i, j, k)*mp_rhoa*mp_tau_b
7745 q_tau_b = q_tau_b + 1.0_dp* &
7746 n_rhob_rhob_tau_b(i, j, k)*mp_rhob*mp_rhob
7747 q_tau_b = q_tau_b + 2.0_dp* &
7748 n_rhob_gamma_aa_tau_b(i, j, k)*mp_rhob*mp_gamma_aa
7749 q_tau_b = q_tau_b + 2.0_dp* &
7750 n_rhob_gamma_ab_tau_b(i, j, k)*mp_rhob*mp_gamma_ab
7751 q_tau_b = q_tau_b + 2.0_dp* &
7752 n_rhob_gamma_bb_tau_b(i, j, k)*mp_rhob*mp_gamma_bb
7753 q_tau_b = q_tau_b + 2.0_dp* &
7754 n_rhob_laplace_rhoa_tau_b(i, j, k)*mp_rhob*mp_laplace_rhoa
7755 q_tau_b = q_tau_b + 2.0_dp* &
7756 n_rhob_laplace_rhob_tau_b(i, j, k)*mp_rhob*mp_laplace_rhob
7757 q_tau_b = q_tau_b + 2.0_dp* &
7758 n_rhob_tau_a_tau_b(i, j, k)*mp_rhob*mp_tau_a
7759 q_tau_b = q_tau_b + 2.0_dp* &
7760 n_rhob_tau_b_tau_b(i, j, k)*mp_rhob*mp_tau_b
7761 q_tau_b = q_tau_b + 1.0_dp* &
7762 n_gamma_aa_gamma_aa_tau_b(i, j, k)*mp_gamma_aa*mp_gamma_aa
7763 q_tau_b = q_tau_b + 2.0_dp* &
7764 n_gamma_aa_gamma_ab_tau_b(i, j, k)*mp_gamma_aa*mp_gamma_ab
7765 q_tau_b = q_tau_b + 2.0_dp* &
7766 n_gamma_aa_gamma_bb_tau_b(i, j, k)*mp_gamma_aa*mp_gamma_bb
7767 q_tau_b = q_tau_b + 2.0_dp* &
7768 n_gamma_aa_laplace_rhoa_tau_b(i, j, k)*mp_gamma_aa*mp_laplace_rhoa
7769 q_tau_b = q_tau_b + 2.0_dp* &
7770 n_gamma_aa_laplace_rhob_tau_b(i, j, k)*mp_gamma_aa*mp_laplace_rhob
7771 q_tau_b = q_tau_b + 2.0_dp* &
7772 n_gamma_aa_tau_a_tau_b(i, j, k)*mp_gamma_aa*mp_tau_a
7773 q_tau_b = q_tau_b + 2.0_dp* &
7774 n_gamma_aa_tau_b_tau_b(i, j, k)*mp_gamma_aa*mp_tau_b
7775 q_tau_b = q_tau_b + 1.0_dp* &
7776 n_gamma_ab_gamma_ab_tau_b(i, j, k)*mp_gamma_ab*mp_gamma_ab
7777 q_tau_b = q_tau_b + 2.0_dp* &
7778 n_gamma_ab_gamma_bb_tau_b(i, j, k)*mp_gamma_ab*mp_gamma_bb
7779 q_tau_b = q_tau_b + 2.0_dp* &
7780 n_gamma_ab_laplace_rhoa_tau_b(i, j, k)*mp_gamma_ab*mp_laplace_rhoa
7781 q_tau_b = q_tau_b + 2.0_dp* &
7782 n_gamma_ab_laplace_rhob_tau_b(i, j, k)*mp_gamma_ab*mp_laplace_rhob
7783 q_tau_b = q_tau_b + 2.0_dp* &
7784 n_gamma_ab_tau_a_tau_b(i, j, k)*mp_gamma_ab*mp_tau_a
7785 q_tau_b = q_tau_b + 2.0_dp* &
7786 n_gamma_ab_tau_b_tau_b(i, j, k)*mp_gamma_ab*mp_tau_b
7787 q_tau_b = q_tau_b + 1.0_dp* &
7788 n_gamma_bb_gamma_bb_tau_b(i, j, k)*mp_gamma_bb*mp_gamma_bb
7789 q_tau_b = q_tau_b + 2.0_dp* &
7790 n_gamma_bb_laplace_rhoa_tau_b(i, j, k)*mp_gamma_bb*mp_laplace_rhoa
7791 q_tau_b = q_tau_b + 2.0_dp* &
7792 n_gamma_bb_laplace_rhob_tau_b(i, j, k)*mp_gamma_bb*mp_laplace_rhob
7793 q_tau_b = q_tau_b + 2.0_dp* &
7794 n_gamma_bb_tau_a_tau_b(i, j, k)*mp_gamma_bb*mp_tau_a
7795 q_tau_b = q_tau_b + 2.0_dp* &
7796 n_gamma_bb_tau_b_tau_b(i, j, k)*mp_gamma_bb*mp_tau_b
7797 q_tau_b = q_tau_b + 1.0_dp* &
7798 n_laplace_rhoa_laplace_rhoa_tau_b(i, j, k)*mp_laplace_rhoa*mp_laplace_rhoa
7799 q_tau_b = q_tau_b + 2.0_dp* &
7800 n_laplace_rhoa_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhoa*mp_laplace_rhob
7801 q_tau_b = q_tau_b + 2.0_dp* &
7802 n_laplace_rhoa_tau_a_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_a
7803 q_tau_b = q_tau_b + 2.0_dp* &
7804 n_laplace_rhoa_tau_b_tau_b(i, j, k)*mp_laplace_rhoa*mp_tau_b
7805 q_tau_b = q_tau_b + 1.0_dp* &
7806 n_laplace_rhob_laplace_rhob_tau_b(i, j, k)*mp_laplace_rhob*mp_laplace_rhob
7807 q_tau_b = q_tau_b + 2.0_dp* &
7808 n_laplace_rhob_tau_a_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_a
7809 q_tau_b = q_tau_b + 2.0_dp* &
7810 n_laplace_rhob_tau_b_tau_b(i, j, k)*mp_laplace_rhob*mp_tau_b
7811 q_tau_b = q_tau_b + 1.0_dp* &
7812 n_tau_a_tau_a_tau_b(i, j, k)*mp_tau_a*mp_tau_a
7813 q_tau_b = q_tau_b + 2.0_dp* &
7814 n_tau_a_tau_b_tau_b(i, j, k)*mp_tau_a*mp_tau_b
7815 q_tau_b = q_tau_b + 1.0_dp* &
7816 n_tau_b_tau_b_tau_b(i, j, k)*mp_tau_b*mp_tau_b
7817 q_tau_b = q_tau_b + n_gamma_aa_tau_b(i, j, k)*mpp_gamma_aa
7818 q_tau_b = q_tau_b + n_gamma_ab_tau_b(i, j, k)*mpp_gamma_ab
7819 q_tau_b = q_tau_b + n_gamma_bb_tau_b(i, j, k)*mpp_gamma_bb
7820 nb_gamma_aa = 0.0_dp
7821 nb_gamma_aa = nb_gamma_aa + n_rhoa_gamma_aa(i, j, k)*mp_rhoa
7822 nb_gamma_aa = nb_gamma_aa + n_rhob_gamma_aa(i, j, k)*mp_rhob
7823 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_gamma_aa(i, j, k)*mp_gamma_aa
7824 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_gamma_ab(i, j, k)*mp_gamma_ab
7825 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_gamma_bb(i, j, k)*mp_gamma_bb
7826 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_laplace_rhoa(i, j, k)*mp_laplace_rhoa
7827 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_laplace_rhob(i, j, k)*mp_laplace_rhob
7828 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_tau_a(i, j, k)*mp_tau_a
7829 nb_gamma_aa = nb_gamma_aa + n_gamma_aa_tau_b(i, j, k)*mp_tau_b
7830 nb_gamma_ab = 0.0_dp
7831 nb_gamma_ab = nb_gamma_ab + n_rhoa_gamma_ab(i, j, k)*mp_rhoa
7832 nb_gamma_ab = nb_gamma_ab + n_rhob_gamma_ab(i, j, k)*mp_rhob
7833 nb_gamma_ab = nb_gamma_ab + n_gamma_aa_gamma_ab(i, j, k)*mp_gamma_aa
7834 nb_gamma_ab = nb_gamma_ab + n_gamma_ab_gamma_ab(i, j, k)*mp_gamma_ab
7835 nb_gamma_ab = nb_gamma_ab + n_gamma_ab_gamma_bb(i, j, k)*mp_gamma_bb
7836 nb_gamma_ab = nb_gamma_ab + n_gamma_ab_laplace_rhoa(i, j, k)*mp_laplace_rhoa
7837 nb_gamma_ab = nb_gamma_ab + n_gamma_ab_laplace_rhob(i, j, k)*mp_laplace_rhob
7838 nb_gamma_ab = nb_gamma_ab + n_gamma_ab_tau_a(i, j, k)*mp_tau_a
7839 nb_gamma_ab = nb_gamma_ab + n_gamma_ab_tau_b(i, j, k)*mp_tau_b
7840 nb_gamma_bb = 0.0_dp
7841 nb_gamma_bb = nb_gamma_bb + n_rhoa_gamma_bb(i, j, k)*mp_rhoa
7842 nb_gamma_bb = nb_gamma_bb + n_rhob_gamma_bb(i, j, k)*mp_rhob
7843 nb_gamma_bb = nb_gamma_bb + n_gamma_aa_gamma_bb(i, j, k)*mp_gamma_aa
7844 nb_gamma_bb = nb_gamma_bb + n_gamma_ab_gamma_bb(i, j, k)*mp_gamma_ab
7845 nb_gamma_bb = nb_gamma_bb + n_gamma_bb_gamma_bb(i, j, k)*mp_gamma_bb
7846 nb_gamma_bb = nb_gamma_bb + n_gamma_bb_laplace_rhoa(i, j, k)*mp_laplace_rhoa
7847 nb_gamma_bb = nb_gamma_bb + n_gamma_bb_laplace_rhob(i, j, k)*mp_laplace_rhob
7848 nb_gamma_bb = nb_gamma_bb + n_gamma_bb_tau_a(i, j, k)*mp_tau_a
7849 nb_gamma_bb = nb_gamma_bb + n_gamma_bb_tau_b(i, j, k)*mp_tau_b
7850
7851 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + q_rhoa
7852 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + q_rhob
7853 IF (tau_f) THEN
7854 v_xc_tau(1)%array(i, j, k) = v_xc_tau(1)%array(i, j, k) + q_tau_a
7855 v_xc_tau(2)%array(i, j, k) = v_xc_tau(2)%array(i, j, k) + q_tau_b
7856 END IF
7857 IF (laplace_f) THEN
7858 v_laplace(1)%array(i, j, k) = v_laplace(1)%array(i, j, k) + q_laplace_rhoa
7859 v_laplace(2)%array(i, j, k) = v_laplace(2)%array(i, j, k) + q_laplace_rhob
7860 END IF
7861
7862 ! xc_pw_divergence ADDS div(field), and g_xc = u - div(v)
7863 v_drho_r(1, 1)%array(i, j, k) = &
7864 -(2.0_dp*drhoa(1)%array(i, j, k)*q_gamma_aa &
7865 + drhob(1)%array(i, j, k)*q_gamma_ab &
7866 + 2.0_dp*(2.0_dp*drho1a(1)%array(i, j, k)*nb_gamma_aa &
7867 + drho1b(1)%array(i, j, k)*nb_gamma_ab))
7868 v_drho_r(1, 2)%array(i, j, k) = &
7869 -(2.0_dp*drhob(1)%array(i, j, k)*q_gamma_bb &
7870 + drhoa(1)%array(i, j, k)*q_gamma_ab &
7871 + 2.0_dp*(2.0_dp*drho1b(1)%array(i, j, k)*nb_gamma_bb &
7872 + drho1a(1)%array(i, j, k)*nb_gamma_ab))
7873 v_drho_r(2, 1)%array(i, j, k) = &
7874 -(2.0_dp*drhoa(2)%array(i, j, k)*q_gamma_aa &
7875 + drhob(2)%array(i, j, k)*q_gamma_ab &
7876 + 2.0_dp*(2.0_dp*drho1a(2)%array(i, j, k)*nb_gamma_aa &
7877 + drho1b(2)%array(i, j, k)*nb_gamma_ab))
7878 v_drho_r(2, 2)%array(i, j, k) = &
7879 -(2.0_dp*drhob(2)%array(i, j, k)*q_gamma_bb &
7880 + drhoa(2)%array(i, j, k)*q_gamma_ab &
7881 + 2.0_dp*(2.0_dp*drho1b(2)%array(i, j, k)*nb_gamma_bb &
7882 + drho1a(2)%array(i, j, k)*nb_gamma_ab))
7883 v_drho_r(3, 1)%array(i, j, k) = &
7884 -(2.0_dp*drhoa(3)%array(i, j, k)*q_gamma_aa &
7885 + drhob(3)%array(i, j, k)*q_gamma_ab &
7886 + 2.0_dp*(2.0_dp*drho1a(3)%array(i, j, k)*nb_gamma_aa &
7887 + drho1b(3)%array(i, j, k)*nb_gamma_ab))
7888 v_drho_r(3, 2)%array(i, j, k) = &
7889 -(2.0_dp*drhob(3)%array(i, j, k)*q_gamma_bb &
7890 + drhoa(3)%array(i, j, k)*q_gamma_ab &
7891 + 2.0_dp*(2.0_dp*drho1b(3)%array(i, j, k)*nb_gamma_bb &
7892 + drho1a(3)%array(i, j, k)*nb_gamma_ab))
7893 END DO
7894 END DO
7895 END DO
7896
7897 IF (my_gapw) THEN
7898 ! vxg carries +V; the plane-wave field above is -V
7899 DO idir = 1, 3
7900 vxg(idir, :, :, 1) = -v_drho_r(idir, 1)%array(:, :, 1)
7901 END DO
7902 ELSE
7903 IF (my_gapw) THEN
7904 DO idir = 1, 3
7905 vxg(idir, :, :, 1) = -v_drho_r(idir, 1)%array(:, :, 1)
7906 END DO
7907 ELSE
7908 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 1), tmp_g, vxc_g, v_xc(1))
7909 END IF
7910 END IF
7911 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 2), tmp_g, vxc_g, v_xc(2))
7912 IF (laplace_f) THEN
7913 DO ispin = 1, nspins
7914 CALL xc_pw_laplace(v_laplace(ispin), pw_pool, xc_deriv_method_id)
7915 CALL pw_axpy(v_laplace(ispin), v_xc(ispin))
7916 CALL deallocate_pw(v_laplace(ispin), pw_pool)
7917 END DO
7918 DEALLOCATE (v_laplace)
7919 END IF
7920 DEALLOCATE (zero_f)
7921
7922 ELSE
7923
7924 IF (.NOT. gradient_f) THEN
7925 ! LDA: only the pure-density third derivatives contribute
7926 deriv_att => xc_dset_get_derivative(deriv_set, &
7928 cpassert(ASSOCIATED(deriv_att))
7929 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_rhoa)
7930 deriv_att => xc_dset_get_derivative(deriv_set, &
7932 cpassert(ASSOCIATED(deriv_att))
7933 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_rhob)
7934 deriv_att => xc_dset_get_derivative(deriv_set, &
7936 cpassert(ASSOCIATED(deriv_att))
7937 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhob_rhob)
7938 deriv_att => xc_dset_get_derivative(deriv_set, &
7940 cpassert(ASSOCIATED(deriv_att))
7941 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_rhob_rhob)
7942!$OMP PARALLEL DO PRIVATE(k,j,i,p_rhoa,p_rhob,u_a,u_b) DEFAULT(NONE) COLLAPSE(3) &
7943!$OMP SHARED(g_rhoa_rhoa_rhoa) &
7944!$OMP SHARED(g_rhoa_rhoa_rhob) &
7945!$OMP SHARED(g_rhoa_rhob_rhob) &
7946!$OMP SHARED(g_rhob_rhob_rhob) &
7947!$OMP SHARED(bo,rho1a,rho1b,v_xc)
7948 DO k = bo(1, 3), bo(2, 3)
7949 DO j = bo(1, 2), bo(2, 2)
7950 DO i = bo(1, 1), bo(2, 1)
7951 p_rhoa = rho1a(i, j, k)
7952 p_rhob = rho1b(i, j, k)
7953 u_a = 0.0_dp
7954 u_a = u_a + g_rhoa_rhoa_rhoa(i, j, k)*p_rhoa*p_rhoa
7955 u_a = u_a + g_rhoa_rhoa_rhob(i, j, k)*p_rhoa*p_rhob
7956 u_a = u_a + g_rhoa_rhoa_rhob(i, j, k)*p_rhob*p_rhoa
7957 u_a = u_a + g_rhoa_rhob_rhob(i, j, k)*p_rhob*p_rhob
7958 u_b = 0.0_dp
7959 u_b = u_b + g_rhoa_rhoa_rhob(i, j, k)*p_rhoa*p_rhoa
7960 u_b = u_b + g_rhoa_rhob_rhob(i, j, k)*p_rhoa*p_rhob
7961 u_b = u_b + g_rhoa_rhob_rhob(i, j, k)*p_rhob*p_rhoa
7962 u_b = u_b + g_rhob_rhob_rhob(i, j, k)*p_rhob*p_rhob
7963 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + u_a
7964 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + u_b
7965 END DO
7966 END DO
7967 END DO
7968
7969 ELSE
7970
7971 NULLIFY (g_rhoa_rhoa)
7972 deriv_att => xc_dset_get_derivative(deriv_set, &
7974 IF (ASSOCIATED(deriv_att)) THEN
7975 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa)
7976 ELSE
7977 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
7978 END IF
7979 NULLIFY (g_rhoa_rhob)
7980 deriv_att => xc_dset_get_derivative(deriv_set, &
7982 IF (ASSOCIATED(deriv_att)) THEN
7983 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhob)
7984 ELSE
7985 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
7986 END IF
7987 NULLIFY (g_rhoa_gamma_aa)
7988 deriv_att => xc_dset_get_derivative(deriv_set, &
7990 IF (ASSOCIATED(deriv_att)) THEN
7991 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_aa)
7992 ELSE
7993 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
7994 END IF
7995 NULLIFY (g_rhoa_gamma_ab)
7996 deriv_att => xc_dset_get_derivative(deriv_set, &
7998 IF (ASSOCIATED(deriv_att)) THEN
7999 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_ab)
8000 ELSE
8001 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8002 END IF
8003 NULLIFY (g_rhoa_gamma_bb)
8004 deriv_att => xc_dset_get_derivative(deriv_set, &
8006 IF (ASSOCIATED(deriv_att)) THEN
8007 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_bb)
8008 ELSE
8009 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8010 END IF
8011 NULLIFY (g_rhob_rhob)
8012 deriv_att => xc_dset_get_derivative(deriv_set, &
8014 IF (ASSOCIATED(deriv_att)) THEN
8015 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_rhob)
8016 ELSE
8017 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8018 END IF
8019 NULLIFY (g_rhob_gamma_aa)
8020 deriv_att => xc_dset_get_derivative(deriv_set, &
8022 IF (ASSOCIATED(deriv_att)) THEN
8023 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_aa)
8024 ELSE
8025 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8026 END IF
8027 NULLIFY (g_rhob_gamma_ab)
8028 deriv_att => xc_dset_get_derivative(deriv_set, &
8030 IF (ASSOCIATED(deriv_att)) THEN
8031 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_ab)
8032 ELSE
8033 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8034 END IF
8035 NULLIFY (g_rhob_gamma_bb)
8036 deriv_att => xc_dset_get_derivative(deriv_set, &
8038 IF (ASSOCIATED(deriv_att)) THEN
8039 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_bb)
8040 ELSE
8041 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8042 END IF
8043 NULLIFY (g_gamma_aa_gamma_aa)
8044 deriv_att => xc_dset_get_derivative(deriv_set, &
8046 IF (ASSOCIATED(deriv_att)) THEN
8047 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_aa)
8048 ELSE
8049 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8050 END IF
8051 NULLIFY (g_gamma_aa_gamma_ab)
8052 deriv_att => xc_dset_get_derivative(deriv_set, &
8054 IF (ASSOCIATED(deriv_att)) THEN
8055 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_ab)
8056 ELSE
8057 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8058 END IF
8059 NULLIFY (g_gamma_aa_gamma_bb)
8060 deriv_att => xc_dset_get_derivative(deriv_set, &
8062 IF (ASSOCIATED(deriv_att)) THEN
8063 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_bb)
8064 ELSE
8065 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8066 END IF
8067 NULLIFY (g_gamma_ab_gamma_ab)
8068 deriv_att => xc_dset_get_derivative(deriv_set, &
8070 IF (ASSOCIATED(deriv_att)) THEN
8071 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_ab_gamma_ab)
8072 ELSE
8073 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8074 END IF
8075 NULLIFY (g_gamma_ab_gamma_bb)
8076 deriv_att => xc_dset_get_derivative(deriv_set, &
8078 IF (ASSOCIATED(deriv_att)) THEN
8079 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_ab_gamma_bb)
8080 ELSE
8081 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8082 END IF
8083 NULLIFY (g_gamma_bb_gamma_bb)
8084 deriv_att => xc_dset_get_derivative(deriv_set, &
8086 IF (ASSOCIATED(deriv_att)) THEN
8087 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_bb_gamma_bb)
8088 ELSE
8089 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8090 END IF
8091 NULLIFY (g_rhoa_rhoa_rhoa)
8092 deriv_att => xc_dset_get_derivative(deriv_set, &
8094 IF (ASSOCIATED(deriv_att)) THEN
8095 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_rhoa)
8096 ELSE
8097 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8098 END IF
8099 NULLIFY (g_rhoa_rhoa_rhob)
8100 deriv_att => xc_dset_get_derivative(deriv_set, &
8102 IF (ASSOCIATED(deriv_att)) THEN
8103 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_rhob)
8104 ELSE
8105 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8106 END IF
8107 NULLIFY (g_rhoa_rhoa_gamma_aa)
8108 deriv_att => xc_dset_get_derivative(deriv_set, &
8110 IF (ASSOCIATED(deriv_att)) THEN
8111 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_gamma_aa)
8112 ELSE
8113 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8114 END IF
8115 NULLIFY (g_rhoa_rhoa_gamma_ab)
8116 deriv_att => xc_dset_get_derivative(deriv_set, &
8118 IF (ASSOCIATED(deriv_att)) THEN
8119 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_gamma_ab)
8120 ELSE
8121 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8122 END IF
8123 NULLIFY (g_rhoa_rhoa_gamma_bb)
8124 deriv_att => xc_dset_get_derivative(deriv_set, &
8126 IF (ASSOCIATED(deriv_att)) THEN
8127 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhoa_gamma_bb)
8128 ELSE
8129 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8130 END IF
8131 NULLIFY (g_rhoa_rhob_rhob)
8132 deriv_att => xc_dset_get_derivative(deriv_set, &
8134 IF (ASSOCIATED(deriv_att)) THEN
8135 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhob_rhob)
8136 ELSE
8137 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8138 END IF
8139 NULLIFY (g_rhoa_rhob_gamma_aa)
8140 deriv_att => xc_dset_get_derivative(deriv_set, &
8142 IF (ASSOCIATED(deriv_att)) THEN
8143 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhob_gamma_aa)
8144 ELSE
8145 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8146 END IF
8147 NULLIFY (g_rhoa_rhob_gamma_ab)
8148 deriv_att => xc_dset_get_derivative(deriv_set, &
8150 IF (ASSOCIATED(deriv_att)) THEN
8151 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhob_gamma_ab)
8152 ELSE
8153 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8154 END IF
8155 NULLIFY (g_rhoa_rhob_gamma_bb)
8156 deriv_att => xc_dset_get_derivative(deriv_set, &
8158 IF (ASSOCIATED(deriv_att)) THEN
8159 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_rhob_gamma_bb)
8160 ELSE
8161 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8162 END IF
8163 NULLIFY (g_rhoa_gamma_aa_gamma_aa)
8164 deriv_att => xc_dset_get_derivative(deriv_set, &
8166 IF (ASSOCIATED(deriv_att)) THEN
8167 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_aa_gamma_aa)
8168 ELSE
8169 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8170 END IF
8171 NULLIFY (g_rhoa_gamma_aa_gamma_ab)
8172 deriv_att => xc_dset_get_derivative(deriv_set, &
8174 IF (ASSOCIATED(deriv_att)) THEN
8175 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_aa_gamma_ab)
8176 ELSE
8177 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8178 END IF
8179 NULLIFY (g_rhoa_gamma_aa_gamma_bb)
8180 deriv_att => xc_dset_get_derivative(deriv_set, &
8182 IF (ASSOCIATED(deriv_att)) THEN
8183 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_aa_gamma_bb)
8184 ELSE
8185 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8186 END IF
8187 NULLIFY (g_rhoa_gamma_ab_gamma_ab)
8188 deriv_att => xc_dset_get_derivative(deriv_set, &
8190 IF (ASSOCIATED(deriv_att)) THEN
8191 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_ab_gamma_ab)
8192 ELSE
8193 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8194 END IF
8195 NULLIFY (g_rhoa_gamma_ab_gamma_bb)
8196 deriv_att => xc_dset_get_derivative(deriv_set, &
8198 IF (ASSOCIATED(deriv_att)) THEN
8199 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_ab_gamma_bb)
8200 ELSE
8201 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8202 END IF
8203 NULLIFY (g_rhoa_gamma_bb_gamma_bb)
8204 deriv_att => xc_dset_get_derivative(deriv_set, &
8206 IF (ASSOCIATED(deriv_att)) THEN
8207 CALL xc_derivative_get(deriv_att, deriv_data=g_rhoa_gamma_bb_gamma_bb)
8208 ELSE
8209 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8210 END IF
8211 NULLIFY (g_rhob_rhob_rhob)
8212 deriv_att => xc_dset_get_derivative(deriv_set, &
8214 IF (ASSOCIATED(deriv_att)) THEN
8215 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_rhob_rhob)
8216 ELSE
8217 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8218 END IF
8219 NULLIFY (g_rhob_rhob_gamma_aa)
8220 deriv_att => xc_dset_get_derivative(deriv_set, &
8222 IF (ASSOCIATED(deriv_att)) THEN
8223 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_rhob_gamma_aa)
8224 ELSE
8225 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8226 END IF
8227 NULLIFY (g_rhob_rhob_gamma_ab)
8228 deriv_att => xc_dset_get_derivative(deriv_set, &
8230 IF (ASSOCIATED(deriv_att)) THEN
8231 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_rhob_gamma_ab)
8232 ELSE
8233 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8234 END IF
8235 NULLIFY (g_rhob_rhob_gamma_bb)
8236 deriv_att => xc_dset_get_derivative(deriv_set, &
8238 IF (ASSOCIATED(deriv_att)) THEN
8239 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_rhob_gamma_bb)
8240 ELSE
8241 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8242 END IF
8243 NULLIFY (g_rhob_gamma_aa_gamma_aa)
8244 deriv_att => xc_dset_get_derivative(deriv_set, &
8246 IF (ASSOCIATED(deriv_att)) THEN
8247 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_aa_gamma_aa)
8248 ELSE
8249 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8250 END IF
8251 NULLIFY (g_rhob_gamma_aa_gamma_ab)
8252 deriv_att => xc_dset_get_derivative(deriv_set, &
8254 IF (ASSOCIATED(deriv_att)) THEN
8255 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_aa_gamma_ab)
8256 ELSE
8257 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8258 END IF
8259 NULLIFY (g_rhob_gamma_aa_gamma_bb)
8260 deriv_att => xc_dset_get_derivative(deriv_set, &
8262 IF (ASSOCIATED(deriv_att)) THEN
8263 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_aa_gamma_bb)
8264 ELSE
8265 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8266 END IF
8267 NULLIFY (g_rhob_gamma_ab_gamma_ab)
8268 deriv_att => xc_dset_get_derivative(deriv_set, &
8270 IF (ASSOCIATED(deriv_att)) THEN
8271 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_ab_gamma_ab)
8272 ELSE
8273 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8274 END IF
8275 NULLIFY (g_rhob_gamma_ab_gamma_bb)
8276 deriv_att => xc_dset_get_derivative(deriv_set, &
8278 IF (ASSOCIATED(deriv_att)) THEN
8279 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_ab_gamma_bb)
8280 ELSE
8281 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8282 END IF
8283 NULLIFY (g_rhob_gamma_bb_gamma_bb)
8284 deriv_att => xc_dset_get_derivative(deriv_set, &
8286 IF (ASSOCIATED(deriv_att)) THEN
8287 CALL xc_derivative_get(deriv_att, deriv_data=g_rhob_gamma_bb_gamma_bb)
8288 ELSE
8289 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8290 END IF
8291 NULLIFY (g_gamma_aa_gamma_aa_gamma_aa)
8292 deriv_att => xc_dset_get_derivative(deriv_set, &
8294 IF (ASSOCIATED(deriv_att)) THEN
8295 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_aa_gamma_aa)
8296 ELSE
8297 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8298 END IF
8299 NULLIFY (g_gamma_aa_gamma_aa_gamma_ab)
8300 deriv_att => xc_dset_get_derivative(deriv_set, &
8302 IF (ASSOCIATED(deriv_att)) THEN
8303 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_aa_gamma_ab)
8304 ELSE
8305 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8306 END IF
8307 NULLIFY (g_gamma_aa_gamma_aa_gamma_bb)
8308 deriv_att => xc_dset_get_derivative(deriv_set, &
8310 IF (ASSOCIATED(deriv_att)) THEN
8311 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_aa_gamma_bb)
8312 ELSE
8313 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8314 END IF
8315 NULLIFY (g_gamma_aa_gamma_ab_gamma_ab)
8316 deriv_att => xc_dset_get_derivative(deriv_set, &
8318 IF (ASSOCIATED(deriv_att)) THEN
8319 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_ab_gamma_ab)
8320 ELSE
8321 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8322 END IF
8323 NULLIFY (g_gamma_aa_gamma_ab_gamma_bb)
8324 deriv_att => xc_dset_get_derivative(deriv_set, &
8326 IF (ASSOCIATED(deriv_att)) THEN
8327 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_ab_gamma_bb)
8328 ELSE
8329 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8330 END IF
8331 NULLIFY (g_gamma_aa_gamma_bb_gamma_bb)
8332 deriv_att => xc_dset_get_derivative(deriv_set, &
8334 IF (ASSOCIATED(deriv_att)) THEN
8335 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_aa_gamma_bb_gamma_bb)
8336 ELSE
8337 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8338 END IF
8339 NULLIFY (g_gamma_ab_gamma_ab_gamma_ab)
8340 deriv_att => xc_dset_get_derivative(deriv_set, &
8342 IF (ASSOCIATED(deriv_att)) THEN
8343 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_ab_gamma_ab_gamma_ab)
8344 ELSE
8345 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8346 END IF
8347 NULLIFY (g_gamma_ab_gamma_ab_gamma_bb)
8348 deriv_att => xc_dset_get_derivative(deriv_set, &
8350 IF (ASSOCIATED(deriv_att)) THEN
8351 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_ab_gamma_ab_gamma_bb)
8352 ELSE
8353 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8354 END IF
8355 NULLIFY (g_gamma_ab_gamma_bb_gamma_bb)
8356 deriv_att => xc_dset_get_derivative(deriv_set, &
8358 IF (ASSOCIATED(deriv_att)) THEN
8359 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_ab_gamma_bb_gamma_bb)
8360 ELSE
8361 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8362 END IF
8363 NULLIFY (g_gamma_bb_gamma_bb_gamma_bb)
8364 deriv_att => xc_dset_get_derivative(deriv_set, &
8366 IF (ASSOCIATED(deriv_att)) THEN
8367 CALL xc_derivative_get(deriv_att, deriv_data=g_gamma_bb_gamma_bb_gamma_bb)
8368 ELSE
8369 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
8370 END IF
8371
8372 ! perturbed reduced gradients: first order (gK1) and second (gK11)
8373 CALL prepare_dr1dr(gaa1, drhoa, drho1a)
8374 CALL prepare_dr1dr(gbb1, drhob, drho1b)
8375 CALL prepare_dr1dr(gab1, drhoa, drho1b)
8376 CALL prepare_dr1dr(gaa11, drho1a, drho1a)
8377 CALL prepare_dr1dr(gbb11, drho1b, drho1b)
8378 CALL prepare_dr1dr(gab11, drho1a, drho1b)
8379 block
8380 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: tmp_ba
8381 CALL prepare_dr1dr(tmp_ba, drhob, drho1a)
8382 gab1(:, :, :) = gab1(:, :, :) + tmp_ba(:, :, :)
8383 END block
8384
8385!$OMP PARALLEL DO PRIVATE(k,j,i,p_rhoa,p_rhob,p_gamma_aa,p_gamma_ab,p_gamma_bb, &
8386!$OMP pp_gamma_aa,pp_gamma_ab,pp_gamma_bb,u_a,u_b, &
8387!$OMP A_gamma_aa,A_gamma_ab,A_gamma_bb, &
8388!$OMP B_gamma_aa,B_gamma_ab,B_gamma_bb) DEFAULT(NONE) COLLAPSE(3) &
8389!$OMP SHARED(g_rhoa_rhoa) &
8390!$OMP SHARED(g_rhoa_rhob) &
8391!$OMP SHARED(g_rhoa_gamma_aa) &
8392!$OMP SHARED(g_rhoa_gamma_ab) &
8393!$OMP SHARED(g_rhoa_gamma_bb) &
8394!$OMP SHARED(g_rhob_rhob) &
8395!$OMP SHARED(g_rhob_gamma_aa) &
8396!$OMP SHARED(g_rhob_gamma_ab) &
8397!$OMP SHARED(g_rhob_gamma_bb) &
8398!$OMP SHARED(g_gamma_aa_gamma_aa) &
8399!$OMP SHARED(g_gamma_aa_gamma_ab) &
8400!$OMP SHARED(g_gamma_aa_gamma_bb) &
8401!$OMP SHARED(g_gamma_ab_gamma_ab) &
8402!$OMP SHARED(g_gamma_ab_gamma_bb) &
8403!$OMP SHARED(g_gamma_bb_gamma_bb) &
8404!$OMP SHARED(g_rhoa_rhoa_rhoa) &
8405!$OMP SHARED(g_rhoa_rhoa_rhob) &
8406!$OMP SHARED(g_rhoa_rhoa_gamma_aa) &
8407!$OMP SHARED(g_rhoa_rhoa_gamma_ab) &
8408!$OMP SHARED(g_rhoa_rhoa_gamma_bb) &
8409!$OMP SHARED(g_rhoa_rhob_rhob) &
8410!$OMP SHARED(g_rhoa_rhob_gamma_aa) &
8411!$OMP SHARED(g_rhoa_rhob_gamma_ab) &
8412!$OMP SHARED(g_rhoa_rhob_gamma_bb) &
8413!$OMP SHARED(g_rhoa_gamma_aa_gamma_aa) &
8414!$OMP SHARED(g_rhoa_gamma_aa_gamma_ab) &
8415!$OMP SHARED(g_rhoa_gamma_aa_gamma_bb) &
8416!$OMP SHARED(g_rhoa_gamma_ab_gamma_ab) &
8417!$OMP SHARED(g_rhoa_gamma_ab_gamma_bb) &
8418!$OMP SHARED(g_rhoa_gamma_bb_gamma_bb) &
8419!$OMP SHARED(g_rhob_rhob_rhob) &
8420!$OMP SHARED(g_rhob_rhob_gamma_aa) &
8421!$OMP SHARED(g_rhob_rhob_gamma_ab) &
8422!$OMP SHARED(g_rhob_rhob_gamma_bb) &
8423!$OMP SHARED(g_rhob_gamma_aa_gamma_aa) &
8424!$OMP SHARED(g_rhob_gamma_aa_gamma_ab) &
8425!$OMP SHARED(g_rhob_gamma_aa_gamma_bb) &
8426!$OMP SHARED(g_rhob_gamma_ab_gamma_ab) &
8427!$OMP SHARED(g_rhob_gamma_ab_gamma_bb) &
8428!$OMP SHARED(g_rhob_gamma_bb_gamma_bb) &
8429!$OMP SHARED(g_gamma_aa_gamma_aa_gamma_aa) &
8430!$OMP SHARED(g_gamma_aa_gamma_aa_gamma_ab) &
8431!$OMP SHARED(g_gamma_aa_gamma_aa_gamma_bb) &
8432!$OMP SHARED(g_gamma_aa_gamma_ab_gamma_ab) &
8433!$OMP SHARED(g_gamma_aa_gamma_ab_gamma_bb) &
8434!$OMP SHARED(g_gamma_aa_gamma_bb_gamma_bb) &
8435!$OMP SHARED(g_gamma_ab_gamma_ab_gamma_ab) &
8436!$OMP SHARED(g_gamma_ab_gamma_ab_gamma_bb) &
8437!$OMP SHARED(g_gamma_ab_gamma_bb_gamma_bb) &
8438!$OMP SHARED(g_gamma_bb_gamma_bb_gamma_bb) &
8439!$OMP SHARED(bo,rho1a,rho1b,gaa1,gab1,gbb1,gaa11,gab11,gbb11, &
8440!$OMP v_xc,v_drho_r,drhoa,drhob,drho1a,drho1b)
8441 DO k = bo(1, 3), bo(2, 3)
8442 DO j = bo(1, 2), bo(2, 2)
8443 DO i = bo(1, 1), bo(2, 1)
8444 p_rhoa = rho1a(i, j, k)
8445 p_rhob = rho1b(i, j, k)
8446 p_gamma_aa = 2.0_dp*gaa1(i, j, k)
8447 p_gamma_ab = gab1(i, j, k)
8448 p_gamma_bb = 2.0_dp*gbb1(i, j, k)
8449 pp_gamma_aa = 2.0_dp*gaa11(i, j, k)
8450 pp_gamma_ab = 2.0_dp*gab11(i, j, k)
8451 pp_gamma_bb = 2.0_dp*gbb11(i, j, k)
8452
8453 u_a = 0.0_dp
8454 u_a = u_a + g_rhoa_rhoa_rhoa(i, j, k)*p_rhoa*p_rhoa
8455 u_a = u_a + g_rhoa_rhoa_rhob(i, j, k)*p_rhoa*p_rhob
8456 u_a = u_a + g_rhoa_rhoa_gamma_aa(i, j, k)*p_rhoa*p_gamma_aa
8457 u_a = u_a + g_rhoa_rhoa_gamma_ab(i, j, k)*p_rhoa*p_gamma_ab
8458 u_a = u_a + g_rhoa_rhoa_gamma_bb(i, j, k)*p_rhoa*p_gamma_bb
8459 u_a = u_a + g_rhoa_rhoa_rhob(i, j, k)*p_rhob*p_rhoa
8460 u_a = u_a + g_rhoa_rhob_rhob(i, j, k)*p_rhob*p_rhob
8461 u_a = u_a + g_rhoa_rhob_gamma_aa(i, j, k)*p_rhob*p_gamma_aa
8462 u_a = u_a + g_rhoa_rhob_gamma_ab(i, j, k)*p_rhob*p_gamma_ab
8463 u_a = u_a + g_rhoa_rhob_gamma_bb(i, j, k)*p_rhob*p_gamma_bb
8464 u_a = u_a + g_rhoa_rhoa_gamma_aa(i, j, k)*p_gamma_aa*p_rhoa
8465 u_a = u_a + g_rhoa_rhob_gamma_aa(i, j, k)*p_gamma_aa*p_rhob
8466 u_a = u_a + g_rhoa_gamma_aa_gamma_aa(i, j, k)*p_gamma_aa*p_gamma_aa
8467 u_a = u_a + g_rhoa_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa*p_gamma_ab
8468 u_a = u_a + g_rhoa_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_bb
8469 u_a = u_a + g_rhoa_rhoa_gamma_ab(i, j, k)*p_gamma_ab*p_rhoa
8470 u_a = u_a + g_rhoa_rhob_gamma_ab(i, j, k)*p_gamma_ab*p_rhob
8471 u_a = u_a + g_rhoa_gamma_aa_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_aa
8472 u_a = u_a + g_rhoa_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_ab
8473 u_a = u_a + g_rhoa_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_bb
8474 u_a = u_a + g_rhoa_rhoa_gamma_bb(i, j, k)*p_gamma_bb*p_rhoa
8475 u_a = u_a + g_rhoa_rhob_gamma_bb(i, j, k)*p_gamma_bb*p_rhob
8476 u_a = u_a + g_rhoa_gamma_aa_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_aa
8477 u_a = u_a + g_rhoa_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_ab
8478 u_a = u_a + g_rhoa_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_bb
8479 u_a = u_a + g_rhoa_gamma_aa(i, j, k)*pp_gamma_aa
8480 u_a = u_a + g_rhoa_gamma_ab(i, j, k)*pp_gamma_ab
8481 u_a = u_a + g_rhoa_gamma_bb(i, j, k)*pp_gamma_bb
8482 u_b = 0.0_dp
8483 u_b = u_b + g_rhoa_rhoa_rhob(i, j, k)*p_rhoa*p_rhoa
8484 u_b = u_b + g_rhoa_rhob_rhob(i, j, k)*p_rhoa*p_rhob
8485 u_b = u_b + g_rhoa_rhob_gamma_aa(i, j, k)*p_rhoa*p_gamma_aa
8486 u_b = u_b + g_rhoa_rhob_gamma_ab(i, j, k)*p_rhoa*p_gamma_ab
8487 u_b = u_b + g_rhoa_rhob_gamma_bb(i, j, k)*p_rhoa*p_gamma_bb
8488 u_b = u_b + g_rhoa_rhob_rhob(i, j, k)*p_rhob*p_rhoa
8489 u_b = u_b + g_rhob_rhob_rhob(i, j, k)*p_rhob*p_rhob
8490 u_b = u_b + g_rhob_rhob_gamma_aa(i, j, k)*p_rhob*p_gamma_aa
8491 u_b = u_b + g_rhob_rhob_gamma_ab(i, j, k)*p_rhob*p_gamma_ab
8492 u_b = u_b + g_rhob_rhob_gamma_bb(i, j, k)*p_rhob*p_gamma_bb
8493 u_b = u_b + g_rhoa_rhob_gamma_aa(i, j, k)*p_gamma_aa*p_rhoa
8494 u_b = u_b + g_rhob_rhob_gamma_aa(i, j, k)*p_gamma_aa*p_rhob
8495 u_b = u_b + g_rhob_gamma_aa_gamma_aa(i, j, k)*p_gamma_aa*p_gamma_aa
8496 u_b = u_b + g_rhob_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa*p_gamma_ab
8497 u_b = u_b + g_rhob_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_bb
8498 u_b = u_b + g_rhoa_rhob_gamma_ab(i, j, k)*p_gamma_ab*p_rhoa
8499 u_b = u_b + g_rhob_rhob_gamma_ab(i, j, k)*p_gamma_ab*p_rhob
8500 u_b = u_b + g_rhob_gamma_aa_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_aa
8501 u_b = u_b + g_rhob_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_ab
8502 u_b = u_b + g_rhob_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_bb
8503 u_b = u_b + g_rhoa_rhob_gamma_bb(i, j, k)*p_gamma_bb*p_rhoa
8504 u_b = u_b + g_rhob_rhob_gamma_bb(i, j, k)*p_gamma_bb*p_rhob
8505 u_b = u_b + g_rhob_gamma_aa_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_aa
8506 u_b = u_b + g_rhob_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_ab
8507 u_b = u_b + g_rhob_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_bb
8508 u_b = u_b + g_rhob_gamma_aa(i, j, k)*pp_gamma_aa
8509 u_b = u_b + g_rhob_gamma_ab(i, j, k)*pp_gamma_ab
8510 u_b = u_b + g_rhob_gamma_bb(i, j, k)*pp_gamma_bb
8511 a_gamma_aa = 0.0_dp
8512 a_gamma_aa = a_gamma_aa + g_rhoa_rhoa_gamma_aa(i, j, k)*p_rhoa*p_rhoa
8513 a_gamma_aa = a_gamma_aa + g_rhoa_rhob_gamma_aa(i, j, k)*p_rhoa*p_rhob
8514 a_gamma_aa = a_gamma_aa + g_rhoa_gamma_aa_gamma_aa(i, j, k)*p_rhoa*p_gamma_aa
8515 a_gamma_aa = a_gamma_aa + g_rhoa_gamma_aa_gamma_ab(i, j, k)*p_rhoa*p_gamma_ab
8516 a_gamma_aa = a_gamma_aa + g_rhoa_gamma_aa_gamma_bb(i, j, k)*p_rhoa*p_gamma_bb
8517 a_gamma_aa = a_gamma_aa + g_rhoa_rhob_gamma_aa(i, j, k)*p_rhob*p_rhoa
8518 a_gamma_aa = a_gamma_aa + g_rhob_rhob_gamma_aa(i, j, k)*p_rhob*p_rhob
8519 a_gamma_aa = a_gamma_aa + g_rhob_gamma_aa_gamma_aa(i, j, k)*p_rhob*p_gamma_aa
8520 a_gamma_aa = a_gamma_aa + g_rhob_gamma_aa_gamma_ab(i, j, k)*p_rhob*p_gamma_ab
8521 a_gamma_aa = a_gamma_aa + g_rhob_gamma_aa_gamma_bb(i, j, k)*p_rhob*p_gamma_bb
8522 a_gamma_aa = a_gamma_aa + g_rhoa_gamma_aa_gamma_aa(i, j, k)*p_gamma_aa*p_rhoa
8523 a_gamma_aa = a_gamma_aa + g_rhob_gamma_aa_gamma_aa(i, j, k)*p_gamma_aa*p_rhob
8524 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_aa_gamma_aa(i, j, k)*p_gamma_aa*p_gamma_aa
8525 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa*p_gamma_ab
8526 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_bb
8527 a_gamma_aa = a_gamma_aa + g_rhoa_gamma_aa_gamma_ab(i, j, k)*p_gamma_ab*p_rhoa
8528 a_gamma_aa = a_gamma_aa + g_rhob_gamma_aa_gamma_ab(i, j, k)*p_gamma_ab*p_rhob
8529 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_aa_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_aa
8530 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_ab
8531 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_bb
8532 a_gamma_aa = a_gamma_aa + g_rhoa_gamma_aa_gamma_bb(i, j, k)*p_gamma_bb*p_rhoa
8533 a_gamma_aa = a_gamma_aa + g_rhob_gamma_aa_gamma_bb(i, j, k)*p_gamma_bb*p_rhob
8534 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_aa_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_aa
8535 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_ab
8536 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_bb
8537 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_aa(i, j, k)*pp_gamma_aa
8538 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_ab(i, j, k)*pp_gamma_ab
8539 a_gamma_aa = a_gamma_aa + g_gamma_aa_gamma_bb(i, j, k)*pp_gamma_bb
8540 a_gamma_ab = 0.0_dp
8541 a_gamma_ab = a_gamma_ab + g_rhoa_rhoa_gamma_ab(i, j, k)*p_rhoa*p_rhoa
8542 a_gamma_ab = a_gamma_ab + g_rhoa_rhob_gamma_ab(i, j, k)*p_rhoa*p_rhob
8543 a_gamma_ab = a_gamma_ab + g_rhoa_gamma_aa_gamma_ab(i, j, k)*p_rhoa*p_gamma_aa
8544 a_gamma_ab = a_gamma_ab + g_rhoa_gamma_ab_gamma_ab(i, j, k)*p_rhoa*p_gamma_ab
8545 a_gamma_ab = a_gamma_ab + g_rhoa_gamma_ab_gamma_bb(i, j, k)*p_rhoa*p_gamma_bb
8546 a_gamma_ab = a_gamma_ab + g_rhoa_rhob_gamma_ab(i, j, k)*p_rhob*p_rhoa
8547 a_gamma_ab = a_gamma_ab + g_rhob_rhob_gamma_ab(i, j, k)*p_rhob*p_rhob
8548 a_gamma_ab = a_gamma_ab + g_rhob_gamma_aa_gamma_ab(i, j, k)*p_rhob*p_gamma_aa
8549 a_gamma_ab = a_gamma_ab + g_rhob_gamma_ab_gamma_ab(i, j, k)*p_rhob*p_gamma_ab
8550 a_gamma_ab = a_gamma_ab + g_rhob_gamma_ab_gamma_bb(i, j, k)*p_rhob*p_gamma_bb
8551 a_gamma_ab = a_gamma_ab + g_rhoa_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa*p_rhoa
8552 a_gamma_ab = a_gamma_ab + g_rhob_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa*p_rhob
8553 a_gamma_ab = a_gamma_ab + g_gamma_aa_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa*p_gamma_aa
8554 a_gamma_ab = a_gamma_ab + g_gamma_aa_gamma_ab_gamma_ab(i, j, k)*p_gamma_aa*p_gamma_ab
8555 a_gamma_ab = a_gamma_ab + g_gamma_aa_gamma_ab_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_bb
8556 a_gamma_ab = a_gamma_ab + g_rhoa_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_rhoa
8557 a_gamma_ab = a_gamma_ab + g_rhob_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_rhob
8558 a_gamma_ab = a_gamma_ab + g_gamma_aa_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_aa
8559 a_gamma_ab = a_gamma_ab + g_gamma_ab_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab*p_gamma_ab
8560 a_gamma_ab = a_gamma_ab + g_gamma_ab_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_bb
8561 a_gamma_ab = a_gamma_ab + g_rhoa_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_rhoa
8562 a_gamma_ab = a_gamma_ab + g_rhob_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_rhob
8563 a_gamma_ab = a_gamma_ab + g_gamma_aa_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_aa
8564 a_gamma_ab = a_gamma_ab + g_gamma_ab_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_ab
8565 a_gamma_ab = a_gamma_ab + g_gamma_ab_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_bb
8566 a_gamma_ab = a_gamma_ab + g_gamma_aa_gamma_ab(i, j, k)*pp_gamma_aa
8567 a_gamma_ab = a_gamma_ab + g_gamma_ab_gamma_ab(i, j, k)*pp_gamma_ab
8568 a_gamma_ab = a_gamma_ab + g_gamma_ab_gamma_bb(i, j, k)*pp_gamma_bb
8569 a_gamma_bb = 0.0_dp
8570 a_gamma_bb = a_gamma_bb + g_rhoa_rhoa_gamma_bb(i, j, k)*p_rhoa*p_rhoa
8571 a_gamma_bb = a_gamma_bb + g_rhoa_rhob_gamma_bb(i, j, k)*p_rhoa*p_rhob
8572 a_gamma_bb = a_gamma_bb + g_rhoa_gamma_aa_gamma_bb(i, j, k)*p_rhoa*p_gamma_aa
8573 a_gamma_bb = a_gamma_bb + g_rhoa_gamma_ab_gamma_bb(i, j, k)*p_rhoa*p_gamma_ab
8574 a_gamma_bb = a_gamma_bb + g_rhoa_gamma_bb_gamma_bb(i, j, k)*p_rhoa*p_gamma_bb
8575 a_gamma_bb = a_gamma_bb + g_rhoa_rhob_gamma_bb(i, j, k)*p_rhob*p_rhoa
8576 a_gamma_bb = a_gamma_bb + g_rhob_rhob_gamma_bb(i, j, k)*p_rhob*p_rhob
8577 a_gamma_bb = a_gamma_bb + g_rhob_gamma_aa_gamma_bb(i, j, k)*p_rhob*p_gamma_aa
8578 a_gamma_bb = a_gamma_bb + g_rhob_gamma_ab_gamma_bb(i, j, k)*p_rhob*p_gamma_ab
8579 a_gamma_bb = a_gamma_bb + g_rhob_gamma_bb_gamma_bb(i, j, k)*p_rhob*p_gamma_bb
8580 a_gamma_bb = a_gamma_bb + g_rhoa_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa*p_rhoa
8581 a_gamma_bb = a_gamma_bb + g_rhob_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa*p_rhob
8582 a_gamma_bb = a_gamma_bb + g_gamma_aa_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_aa
8583 a_gamma_bb = a_gamma_bb + g_gamma_aa_gamma_ab_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_ab
8584 a_gamma_bb = a_gamma_bb + g_gamma_aa_gamma_bb_gamma_bb(i, j, k)*p_gamma_aa*p_gamma_bb
8585 a_gamma_bb = a_gamma_bb + g_rhoa_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_rhoa
8586 a_gamma_bb = a_gamma_bb + g_rhob_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_rhob
8587 a_gamma_bb = a_gamma_bb + g_gamma_aa_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_aa
8588 a_gamma_bb = a_gamma_bb + g_gamma_ab_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_ab
8589 a_gamma_bb = a_gamma_bb + g_gamma_ab_gamma_bb_gamma_bb(i, j, k)*p_gamma_ab*p_gamma_bb
8590 a_gamma_bb = a_gamma_bb + g_rhoa_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_rhoa
8591 a_gamma_bb = a_gamma_bb + g_rhob_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_rhob
8592 a_gamma_bb = a_gamma_bb + g_gamma_aa_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_aa
8593 a_gamma_bb = a_gamma_bb + g_gamma_ab_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_ab
8594 a_gamma_bb = a_gamma_bb + g_gamma_bb_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb*p_gamma_bb
8595 a_gamma_bb = a_gamma_bb + g_gamma_aa_gamma_bb(i, j, k)*pp_gamma_aa
8596 a_gamma_bb = a_gamma_bb + g_gamma_ab_gamma_bb(i, j, k)*pp_gamma_ab
8597 a_gamma_bb = a_gamma_bb + g_gamma_bb_gamma_bb(i, j, k)*pp_gamma_bb
8598 b_gamma_aa = 0.0_dp
8599 b_gamma_aa = b_gamma_aa + g_rhoa_gamma_aa(i, j, k)*p_rhoa
8600 b_gamma_aa = b_gamma_aa + g_rhob_gamma_aa(i, j, k)*p_rhob
8601 b_gamma_aa = b_gamma_aa + g_gamma_aa_gamma_aa(i, j, k)*p_gamma_aa
8602 b_gamma_aa = b_gamma_aa + g_gamma_aa_gamma_ab(i, j, k)*p_gamma_ab
8603 b_gamma_aa = b_gamma_aa + g_gamma_aa_gamma_bb(i, j, k)*p_gamma_bb
8604 b_gamma_ab = 0.0_dp
8605 b_gamma_ab = b_gamma_ab + g_rhoa_gamma_ab(i, j, k)*p_rhoa
8606 b_gamma_ab = b_gamma_ab + g_rhob_gamma_ab(i, j, k)*p_rhob
8607 b_gamma_ab = b_gamma_ab + g_gamma_aa_gamma_ab(i, j, k)*p_gamma_aa
8608 b_gamma_ab = b_gamma_ab + g_gamma_ab_gamma_ab(i, j, k)*p_gamma_ab
8609 b_gamma_ab = b_gamma_ab + g_gamma_ab_gamma_bb(i, j, k)*p_gamma_bb
8610 b_gamma_bb = 0.0_dp
8611 b_gamma_bb = b_gamma_bb + g_rhoa_gamma_bb(i, j, k)*p_rhoa
8612 b_gamma_bb = b_gamma_bb + g_rhob_gamma_bb(i, j, k)*p_rhob
8613 b_gamma_bb = b_gamma_bb + g_gamma_aa_gamma_bb(i, j, k)*p_gamma_aa
8614 b_gamma_bb = b_gamma_bb + g_gamma_ab_gamma_bb(i, j, k)*p_gamma_ab
8615 b_gamma_bb = b_gamma_bb + g_gamma_bb_gamma_bb(i, j, k)*p_gamma_bb
8616
8617 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + u_a
8618 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + u_b
8619
8620 ! xc_pw_divergence ADDS div(field); g_xc = u - div(v)
8621 v_drho_r(1, 1)%array(i, j, k) = &
8622 -(2.0_dp*drhoa(1)%array(i, j, k)*a_gamma_aa &
8623 + drhob(1)%array(i, j, k)*a_gamma_ab &
8624 + 2.0_dp*(2.0_dp*drho1a(1)%array(i, j, k)*b_gamma_aa &
8625 + drho1b(1)%array(i, j, k)*b_gamma_ab))
8626 v_drho_r(1, 2)%array(i, j, k) = &
8627 -(2.0_dp*drhob(1)%array(i, j, k)*a_gamma_bb &
8628 + drhoa(1)%array(i, j, k)*a_gamma_ab &
8629 + 2.0_dp*(2.0_dp*drho1b(1)%array(i, j, k)*b_gamma_bb &
8630 + drho1a(1)%array(i, j, k)*b_gamma_ab))
8631 v_drho_r(2, 1)%array(i, j, k) = &
8632 -(2.0_dp*drhoa(2)%array(i, j, k)*a_gamma_aa &
8633 + drhob(2)%array(i, j, k)*a_gamma_ab &
8634 + 2.0_dp*(2.0_dp*drho1a(2)%array(i, j, k)*b_gamma_aa &
8635 + drho1b(2)%array(i, j, k)*b_gamma_ab))
8636 v_drho_r(2, 2)%array(i, j, k) = &
8637 -(2.0_dp*drhob(2)%array(i, j, k)*a_gamma_bb &
8638 + drhoa(2)%array(i, j, k)*a_gamma_ab &
8639 + 2.0_dp*(2.0_dp*drho1b(2)%array(i, j, k)*b_gamma_bb &
8640 + drho1a(2)%array(i, j, k)*b_gamma_ab))
8641 v_drho_r(3, 1)%array(i, j, k) = &
8642 -(2.0_dp*drhoa(3)%array(i, j, k)*a_gamma_aa &
8643 + drhob(3)%array(i, j, k)*a_gamma_ab &
8644 + 2.0_dp*(2.0_dp*drho1a(3)%array(i, j, k)*b_gamma_aa &
8645 + drho1b(3)%array(i, j, k)*b_gamma_ab))
8646 v_drho_r(3, 2)%array(i, j, k) = &
8647 -(2.0_dp*drhob(3)%array(i, j, k)*a_gamma_bb &
8648 + drhoa(3)%array(i, j, k)*a_gamma_ab &
8649 + 2.0_dp*(2.0_dp*drho1b(3)%array(i, j, k)*b_gamma_bb &
8650 + drho1a(3)%array(i, j, k)*b_gamma_ab))
8651 END DO
8652 END DO
8653 END DO
8654
8655 IF (my_gapw) THEN
8656 DO ispin = 1, nspins
8657 DO idir = 1, 3
8658 vxg(idir, :, :, ispin) = -v_drho_r(idir, ispin)%array(:, :, 1)
8659 END DO
8660 END DO
8661 ELSE
8662 IF (my_gapw) THEN
8663 ! vxg carries +V; the plane-wave field above is -V
8664 DO idir = 1, 3
8665 vxg(idir, :, :, 1) = -v_drho_r(idir, 1)%array(:, :, 1)
8666 END DO
8667 ELSE
8668 IF (my_gapw) THEN
8669 DO idir = 1, 3
8670 vxg(idir, :, :, 1) = -v_drho_r(idir, 1)%array(:, :, 1)
8671 END DO
8672 ELSE
8673 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 1), tmp_g, vxc_g, v_xc(1))
8674 END IF
8675 END IF
8676 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 2), tmp_g, vxc_g, v_xc(2))
8677 END IF
8678 END IF
8679 END IF
8680
8681 ELSE
8682
8683 ! vxc contributions
8684 ! vxca = (vxc^{\alpha}-vxc^{\beta})*rho1/|rhoa-rhob|^2
8685 ! vxcb =-(vxc^{\alpha}-vxc^{\beta})*rho1/|rhoa-rhob|^2
8686 ! Alpha LDA contribution
8687 ! | d e_xc d e_xc | rho1a
8688 ! vxca = rho1a*|-------- - --------|*---------------
8689 ! | drhoa drhob | |rhoa - rhob|^2
8690 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa])
8691 IF (ASSOCIATED(deriv_att)) THEN
8692 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8693 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob])
8694 IF (ASSOCIATED(deriv_att)) THEN
8695 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8696!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8697!$OMP SHARED(bo,v_xc,deriv_data,deriv_data2,rho1a,rhoa,rhob,S_THRESH2) COLLAPSE(3)
8698 DO k = bo(1, 3), bo(2, 3)
8699 DO j = bo(1, 2), bo(2, 2)
8700 DO i = bo(1, 1), bo(2, 1)
8701 s = rhoa(i, j, k) - rhob(i, j, k)
8702 s = -sign(max(s**2, s_thresh2), s)
8703 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
8704 (deriv_data(i, j, k) - deriv_data2(i, j, k))*rho1a(i, j, k)**2/s
8705 END DO
8706 END DO
8707 END DO
8708!$OMP END PARALLEL DO
8709 END IF
8710 END IF
8711 ! GGA contributions to the spin-flip xcKernel
8712 ! Alpha GGA contributions
8713 ! | d e_xc d e_xc | rho1a
8714 ! vxca += + |----------*dra1dra - ----------*drb1drb|*---------------
8715 ! | d|drhoa| d|drhob| | |rhoa - rhob|^2
8716 IF (.NOT. alda0) THEN
8717 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa])
8718 IF (ASSOCIATED(deriv_att)) THEN
8719 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8720 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob])
8721 IF (ASSOCIATED(deriv_att)) THEN
8722 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8723!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8724!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,v_xc,rho1a,rhoa,rhob,S_THRESH2) COLLAPSE(3)
8725 DO k = bo(1, 3), bo(2, 3)
8726 DO j = bo(1, 2), bo(2, 2)
8727 DO i = bo(1, 1), bo(2, 1)
8728 s = rhoa(i, j, k) - rhob(i, j, k)
8729 s = -sign(max(s**2, s_thresh2), s)
8730 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
8731 (deriv_data(i, j, k)*dra1dra(i, j, k) - deriv_data2(i, j, k)*drb1drb(i, j, k)) &
8732 *rho1a(i, j, k)/s
8733 END DO
8734 END DO
8735 END DO
8736!$OMP END PARALLEL DO
8737 END IF
8738 END IF
8739 END IF
8740 ! Beta contribution = - alpha
8741!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8742!$OMP SHARED(bo,v_xc) COLLAPSE(3)
8743 DO k = bo(1, 3), bo(2, 3)
8744 DO j = bo(1, 2), bo(2, 2)
8745 DO i = bo(1, 1), bo(2, 1)
8746 v_xc(2)%array(i, j, k) = -v_xc(1)%array(i, j, k)
8747 END DO
8748 END DO
8749 END DO
8750!$OMP END PARALLEL DO
8751 ! fxc contributions
8752 ! vxca = rho1*(fxc^{\alpha\alpha}-fxc^{\alpha\beta})*rho1/|rhoa-rhob|
8753 ! vxcb = rho1*(fxc^{\beta\alpha}-fxc^{\beta\beta})*rho1/|rhoa-rhob|
8754 ! Alpha LDA contribution
8755 ! | d^2 e_xc d^2 e_xc | rho1a
8756 ! vxca += rho1a*|------------- - -------------|*-------------
8757 ! | drhoa drhoa drhoa drhob | |rhoa - rhob|
8758 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_rhob])
8759 IF (ASSOCIATED(deriv_att)) THEN
8760 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8761 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_rhoa])
8762 IF (ASSOCIATED(deriv_att)) THEN
8763 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8764!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8765!$OMP SHARED(bo,deriv_data,deriv_data2,rho1a,v_xc,rhoa,rhob,S_THRESH) COLLAPSE(3)
8766 DO k = bo(1, 3), bo(2, 3)
8767 DO j = bo(1, 2), bo(2, 2)
8768 DO i = bo(1, 1), bo(2, 1)
8769 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
8770 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
8771 rho1a(i, j, k)**2*(deriv_data(i, j, k) - deriv_data2(i, j, k))/s
8772 END DO
8773 END DO
8774 END DO
8775!$OMP END PARALLEL DO
8776 END IF
8777 END IF
8778 ! Beta LDA contribution
8779 ! | d^2 e_xc d^2 e_xc | rho1a
8780 ! vxcb += rho1a*|------------- - -------------|*-------------
8781 ! | drhob drhoa drhob drhob | |rhoa - rhob|
8782 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_rhob])
8783 IF (ASSOCIATED(deriv_att)) THEN
8784 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8785 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_rhoa])
8786 IF (ASSOCIATED(deriv_att)) THEN
8787 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8788!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8789!$OMP SHARED(bo,deriv_data,deriv_data2,rho1a,v_xc,rhoa,rhob,S_THRESH) COLLAPSE(3)
8790 DO k = bo(1, 3), bo(2, 3)
8791 DO j = bo(1, 2), bo(2, 2)
8792 DO i = bo(1, 1), bo(2, 1)
8793 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
8794 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
8795 rho1a(i, j, k)**2*(deriv_data(i, j, k) - deriv_data2(i, j, k))/s
8796 END DO
8797 END DO
8798 END DO
8799!$OMP END PARALLEL DO
8800 END IF
8801 END IF
8802 ! Alpha GGA contribution
8803 IF (.NOT. alda0) THEN
8804 ! rho1a | d^2 e_xc d^2 e_xc |
8805 ! vxca += + -------------*|----------------*dra1dra - ----------------*drb1drb|
8806 ! |rhoa - rhob| | drhoa d|drhoa| drhoa d|drhob| |
8807 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drhob])
8808 IF (ASSOCIATED(deriv_att)) THEN
8809 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8810 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_norm_drhoa])
8811 IF (ASSOCIATED(deriv_att)) THEN
8812 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8813!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8814!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,rho1a,v_xc,rhoa,rhob,S_THRESH) COLLAPSE(3)
8815 DO k = bo(1, 3), bo(2, 3)
8816 DO j = bo(1, 2), bo(2, 2)
8817 DO i = bo(1, 1), bo(2, 1)
8818 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
8819 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
8820 (deriv_data(i, j, k)*dra1dra(i, j, k) - deriv_data2(i, j, k)*drb1drb(i, j, k))* &
8821 rho1a(i, j, k)/s
8822 END DO
8823 END DO
8824 END DO
8825!$OMP END PARALLEL DO
8826 END IF
8827 END IF
8828 ! Beta GGA contribution
8829 ! rho1a | d^2 e_xc d^2 e_xc |
8830 ! vxcb += + -------------*|----------------*dra1dra - ----------------*drb1drb|
8831 ! |rhoa - rhob| | drhob d|drhoa| drhob d|drhob| |
8832 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_norm_drhob])
8833 IF (ASSOCIATED(deriv_att)) THEN
8834 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8835 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_norm_drhoa])
8836 IF (ASSOCIATED(deriv_att)) THEN
8837 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8838!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
8839!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,rho1a,v_xc,rhoa,rhob,S_THRESH) COLLAPSE(3)
8840 DO k = bo(1, 3), bo(2, 3)
8841 DO j = bo(1, 2), bo(2, 2)
8842 DO i = bo(1, 1), bo(2, 1)
8843 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
8844 v_xc(2)%array(i, j, k) = v_xc(2)%array(i, j, k) + &
8845 (deriv_data(i, j, k)*dra1dra(i, j, k) - deriv_data2(i, j, k)*drb1drb(i, j, k))* &
8846 rho1a(i, j, k)/s
8847 END DO
8848 END DO
8849 END DO
8850!$OMP END PARALLEL DO
8851 END IF
8852 END IF
8853 !
8854 !
8855 ! Calculate the vector for the partial integration term of GGA functionals
8856 ! First contribution alpha
8857 ! | d^2 e_xc d^2 e_xc |
8858 ! v_drhoa(1) += -|---------------- - ----------------|*rho1a
8859 ! | d|drhoa| drhoa d|drhoa| drhob |
8860 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_rhob])
8861 IF (ASSOCIATED(deriv_att)) THEN
8862 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8863 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_rhoa])
8864 IF (ASSOCIATED(deriv_att)) THEN
8865 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8866!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
8867!$OMP SHARED(bo,deriv_data,deriv_data2,rho1a,v_drhoa) COLLAPSE(3)
8868 DO k = bo(1, 3), bo(2, 3)
8869 DO j = bo(1, 2), bo(2, 2)
8870 DO i = bo(1, 1), bo(2, 1)
8871 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
8872 (deriv_data(i, j, k) - deriv_data2(i, j, k))*rho1a(i, j, k)
8873 END DO
8874 END DO
8875 END DO
8876!$OMP END PARALLEL DO
8877 END IF
8878 END IF
8879 ! First contribution beta
8880 ! | d^2 e_xc d^2 e_xc |
8881 ! v_drhob(2) += +|---------------- - ----------------|*rho1a
8882 ! | d|drhob| drhob d|drhob| drhoa |
8883 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_rhoa])
8884 IF (ASSOCIATED(deriv_att)) THEN
8885 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8886 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_rhob])
8887 IF (ASSOCIATED(deriv_att)) THEN
8888 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8889!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
8890!$OMP SHARED(bo,deriv_data,deriv_data2,rho1a,v_drhob) COLLAPSE(3)
8891 DO k = bo(1, 3), bo(2, 3)
8892 DO j = bo(1, 2), bo(2, 2)
8893 DO i = bo(1, 1), bo(2, 1)
8894 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) + &
8895 (deriv_data(i, j, k) - deriv_data2(i, j, k))*rho1a(i, j, k)
8896 END DO
8897 END DO
8898 END DO
8899!$OMP END PARALLEL DO
8900 END IF
8901 END IF
8902 ! First contribution spinless
8903 ! | d^2 e_xc d^2 e_xc |
8904 ! v_drho(1) += -|--------------- - ---------------|*rho1a
8905 ! | d|drho| drhoa d|drho| drhob |
8906 !
8907 ! | d^2 e_xc d^2 e_xc |
8908 ! v_drho(2) += -|--------------- - ---------------|*rho1a
8909 ! | d|drho| drhoa d|drho| drhob |
8910 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rhoa])
8911 IF (ASSOCIATED(deriv_att)) THEN
8912 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8913 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rhob])
8914 IF (ASSOCIATED(deriv_att)) THEN
8915 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8916!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
8917!$OMP SHARED(bo,deriv_data,deriv_data2,rho1a,v_drho) COLLAPSE(3)
8918 DO k = bo(1, 3), bo(2, 3)
8919 DO j = bo(1, 2), bo(2, 2)
8920 DO i = bo(1, 1), bo(2, 1)
8921 v_drho(1)%array(i, j, k) = v_drho(1)%array(i, j, k) - &
8922 (deriv_data(i, j, k) - deriv_data2(i, j, k))*rho1a(i, j, k)
8923 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
8924 (deriv_data(i, j, k) - deriv_data2(i, j, k))*rho1a(i, j, k)
8925 END DO
8926 END DO
8927 END DO
8928!$OMP END PARALLEL DO
8929 END IF
8930 END IF
8931 ! Second contribution
8932 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drhob])
8933 IF (ASSOCIATED(deriv_att)) THEN
8934 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8935 ! d^2 e_xc d^2 e_xc
8936 ! v_drhoa(1) += - -------------------*dra1dra + ------------------*drb1drb
8937 ! d|drhoa| d|drhoa| d|drhoa| d|drhob|
8938 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_norm_drhoa])
8939 IF (ASSOCIATED(deriv_att)) THEN
8940 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8941!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
8942!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,v_drhoa) COLLAPSE(3)
8943 DO k = bo(1, 3), bo(2, 3)
8944 DO j = bo(1, 2), bo(2, 2)
8945 DO i = bo(1, 1), bo(2, 1)
8946 v_drhoa(1)%array(i, j, k) = v_drhoa(1)%array(i, j, k) - &
8947 deriv_data(i, j, k)*dra1dra(i, j, k) + deriv_data2(i, j, k)*drb1drb(i, j, k)
8948 END DO
8949 END DO
8950 END DO
8951!$OMP END PARALLEL DO
8952 END IF
8953 ! d^2 e_xc d^2 e_xc
8954 ! v_drhob(2) += - -------------------*dra1dra + -------------------*drb1drb
8955 ! d|drhoa| d|drhob| d|drhob| d|drhob|
8956 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_norm_drhob])
8957 IF (ASSOCIATED(deriv_att)) THEN
8958 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8959!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
8960!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,v_drhob) COLLAPSE(3)
8961 DO k = bo(1, 3), bo(2, 3)
8962 DO j = bo(1, 2), bo(2, 2)
8963 DO i = bo(1, 1), bo(2, 1)
8964 v_drhob(2)%array(i, j, k) = v_drhob(2)%array(i, j, k) - &
8965 deriv_data(i, j, k)*dra1dra(i, j, k) + deriv_data2(i, j, k)*drb1drb(i, j, k)
8966 END DO
8967 END DO
8968 END DO
8969!$OMP END PARALLEL DO
8970 END IF
8971 END IF
8972 ! d^2 e_xc d^2 e_xc
8973 ! v_drho(1) += - ------------------*dra1dra + ------------------*drb1drb
8974 ! d|drho| d|drhoa| d|drho| d|drhob|
8975 !
8976 ! d^2 e_xc d^2 e_xc
8977 ! v_drho(2) += - ------------------*dra1dra + ------------------*drb1drb
8978 ! d|drho| d|drhoa| d|drho| d|drhob|
8979 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drhob])
8980 IF (ASSOCIATED(deriv_att)) THEN
8981 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data2)
8982 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_norm_drhoa])
8983 IF (ASSOCIATED(deriv_att)) THEN
8984 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
8985!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE)&
8986!$OMP SHARED(bo,deriv_data,deriv_data2,dra1dra,drb1drb,v_drho) COLLAPSE(3)
8987 DO k = bo(1, 3), bo(2, 3)
8988 DO j = bo(1, 2), bo(2, 2)
8989 DO i = bo(1, 1), bo(2, 1)
8990 v_drho(1)%array(i, j, k) = v_drho(1)%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 v_drho(2)%array(i, j, k) = v_drho(2)%array(i, j, k) - &
8994 deriv_data(i, j, k)*dra1dra(i, j, k) + &
8995 deriv_data2(i, j, k)*drb1drb(i, j, k)
8996 END DO
8997 END DO
8998 END DO
8999!$OMP END PARALLEL DO
9000 END IF
9001 END IF
9002 !
9003
9004 ! Last GGA contribution
9005 ! Alpha contribution
9006 ! d e_xc
9007 ! v_drhoa(1) += + ----------*dra1dra
9008 ! d|drhoa|
9009 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa])
9010 IF (ASSOCIATED(deriv_att)) THEN
9011 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
9012 CALL xc_derivative_get(deriv_att, deriv_data=e_drhoa)
9013
9014!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dra1dra,gradient_cut,norm_drhoa,v_drhoa,deriv_data)
9015 v_drhoa(1)%array(:, :, :) = v_drhoa(1)%array(:, :, :) + &
9016 deriv_data(:, :, :)*dra1dra(:, :, :)/max(gradient_cut, norm_drhoa(:, :, :))**2
9017!$OMP END PARALLEL WORKSHARE
9018 END IF
9019 ! Beta contribution
9020 ! d e_xc
9021 ! v_drhob(2) += - ----------*drb1drb
9022 ! d|drhob|
9023 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob])
9024 IF (ASSOCIATED(deriv_att)) THEN
9025 CALL xc_derivative_get(deriv_att, deriv_data=deriv_data)
9026 CALL xc_derivative_get(deriv_att, deriv_data=e_drhob)
9027
9028!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drb1drb,gradient_cut,norm_drhob,v_drhob,deriv_data)
9029 v_drhob(2)%array(:, :, :) = v_drhob(2)%array(:, :, :) - &
9030 deriv_data(:, :, :)*drb1drb(:, :, :)/max(gradient_cut, norm_drhob(:, :, :))**2
9031!$OMP END PARALLEL WORKSHARE
9032 END IF
9033 END IF ! If ALDA0
9034 END IF
9035
9036 ELSE
9037
9038 ! Analytic third derivative for closed-shell
9039 cpabort("Exchange-correlation's analytic third derivative not implemented")
9040
9041 END IF
9042
9043 IF (gradient_f) THEN
9044 ! This partial integration is written for the spin-flip kernel only;
9045 ! the gamma-form branch above does its own divergence. The cleanup
9046 ! below, however, has to run for both.
9047 IF (.NOT. alda0 .AND. do_spinflip) THEN
9048
9049 ! partial integration
9050 DO idir = 1, 3
9051
9052 ! GGA contributions to the spin-flip xc-Kernel
9053 !
9054 ! v_drhoa(1)*drhoa(:)*rhoa1 v_drhob(1)*drhob(:)*rhoa1 v_drho(1)*drho(:)*rhoa1
9055 ! v_drho_r(:,1) = --------------------------- + --------------------------- + -------------------------
9056 ! |rhoa - rhob| |rhoa - rhob| |rhoa - rhob|
9057 !
9058 ! v_drhoa(2)*drhoa(:)*rhoa1 v_drhob(2)*drhob(:)*rhoa1 v_drho(2)*drho(:)*rhoa1
9059 ! v_drho_r(:,2) = --------------------------- + --------------------------- + -------------------------
9060 ! |rhoa - rhob| |rhoa - rhob| |rhoa - rhob|
9061 IF (do_spinflip) THEN
9062!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
9063!$OMP SHARED(bo,v_drho_r,v_drho,v_drhoa,v_drhob,rhoa,rhob,drho,drhoa,drhob,rho1a,idir,S_THRESH) COLLAPSE(3)
9064 DO k = bo(1, 3), bo(2, 3)
9065 DO j = bo(1, 2), bo(2, 2)
9066 DO i = bo(1, 1), bo(2, 1)
9067 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
9068 DO ispin = 1, 2
9069 v_drho_r(idir, ispin)%array(i, j, k) = v_drho_r(idir, ispin)%array(i, j, k) + &
9070 v_drhoa(ispin)%array(i, j, k)*drhoa(idir)%array(i, j, k)*rho1a(i, j, k)/s + &
9071 v_drhob(ispin)%array(i, j, k)*drhob(idir)%array(i, j, k)*rho1a(i, j, k)/s + &
9072 v_drho(ispin)%array(i, j, k)*drho(idir)%array(i, j, k)*rho1a(i, j, k)/s
9073 END DO
9074 END DO
9075 END DO
9076 END DO
9077!$OMP END PARALLEL DO
9078 END IF
9079 ! Last GGA contribution
9080 ! Alpha contribution
9081 ! rho1a d e_xc
9082 ! v_drho_r(:,1) += - -------------*----------*drho1a(:)
9083 ! |rhoa - rhob| d|drhoa|
9084 IF (ASSOCIATED(e_drhoa)) THEN
9085!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
9086!$OMP SHARED(bo,e_drhoa,v_drho_r,drho1a,rho1a,rhoa,rhob,S_THRESH,idir) COLLAPSE(3)
9087 DO k = bo(1, 3), bo(2, 3)
9088 DO j = bo(1, 2), bo(2, 2)
9089 DO i = bo(1, 1), bo(2, 1)
9090 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
9091 v_drho_r(idir, 1)%array(i, j, k) = v_drho_r(idir, 1)%array(i, j, k) - &
9092 e_drhoa(i, j, k)*drho1a(idir)%array(i, j, k)*rho1a(i, j, k)/s
9093 END DO
9094 END DO
9095 END DO
9096!$OMP END PARALLEL DO
9097 END IF
9098 ! Beta contribution
9099 ! rho1a d e_xc
9100 ! v_drho_r(:,2) += + -------------*----------*drho1a(:)
9101 ! |rhoa - rhob| d|drhob|
9102 IF (ASSOCIATED(e_drhob)) THEN
9103!$OMP PARALLEL DO PRIVATE(k,j,i,s) DEFAULT(NONE)&
9104!$OMP SHARED(bo,e_drhob,v_drho_r,drho1a,rho1a,rhoa,rhob,S_THRESH,idir) COLLAPSE(3)
9105 DO k = bo(1, 3), bo(2, 3)
9106 DO j = bo(1, 2), bo(2, 2)
9107 DO i = bo(1, 1), bo(2, 1)
9108 s = max(abs(rhoa(i, j, k) - rhob(i, j, k)), s_thresh)
9109 v_drho_r(idir, 2)%array(i, j, k) = v_drho_r(idir, 2)%array(i, j, k) + &
9110 e_drhob(i, j, k)*drho1a(idir)%array(i, j, k)*rho1a(i, j, k)/s
9111 END DO
9112 END DO
9113 END DO
9114!$OMP END PARALLEL DO
9115 END IF
9116 END DO
9117
9118 ! partial integration: v_xc = v_xc - \nabla \cdot vdrho_r
9119 DO ispin = 1, nspins
9120 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, ispin), tmp_g, vxc_g, v_xc(ispin))
9121 END DO ! ispin
9122 END IF ! ALDA0
9123
9124 DO idir = 1, 3
9125 DEALLOCATE (drho(idir)%array)
9126 DEALLOCATE (drho1(idir)%array)
9127 END DO
9128
9129 DO ispin = 1, nspins
9130 CALL deallocate_pw(v_drhoa(ispin), pw_pool)
9131 CALL deallocate_pw(v_drhob(ispin), pw_pool)
9132 END DO
9133
9134 DEALLOCATE (v_drhoa, v_drhob)
9135
9136 END IF ! gradient_f
9137
9138 ELSE
9139
9140 !-----------------!
9141 ! restricted case !
9142 !-----------------!
9143 !
9144 ! Third functional derivative contracted twice with the response density,
9145 ! in the reduced-gradient variables gamma = |grad rho|^2 (LibXC's sigma):
9146 !
9147 ! g_xc = u - div(v)
9148 ! u = e_rrr rho1^2 + 2 e_rrg rho1 g1 + e_rgg g1^2 + e_rg g11
9149 ! A = e_rrg rho1^2 + 2 e_rgg rho1 g1 + e_ggg g1^2 + e_gg g11
9150 ! B = e_rg rho1 + e_gg g1
9151 ! v = 2 grad rho A + 4 grad rho1 B
9152 !
9153 ! with g1 = 2 grad rho . grad rho1 and g11 = 2 |grad rho1|^2. Working in
9154 ! gamma rather than in |grad rho| is what makes this terminate: gamma is
9155 ! quadratic in grad rho, so its third variation vanishes identically and
9156 ! no inverse powers of |grad rho| appear anywhere.
9157
9158 CALL xc_rho_set_get(rho1_set, rho=rho1)
9159
9160 NULLIFY (e_rrr, e_rrg, e_rgg, e_ggg, e_rg, e_gg)
9161 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_rho, deriv_rho])
9162 IF (ASSOCIATED(deriv_att)) CALL xc_derivative_get(deriv_att, deriv_data=e_rrr)
9163
9164 IF (gradient_f) THEN
9165 CALL xc_rho_set_get(rho_set, drho=drho)
9166 CALL xc_rho_set_get(rho1_set, drho=drho1)
9167 CALL prepare_dr1dr(dr1dr, drho, drho1)
9168 CALL prepare_dr1dr(dr1dr1, drho1, drho1)
9169
9170 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_rho, deriv_gamma])
9171 IF (ASSOCIATED(deriv_att)) CALL xc_derivative_get(deriv_att, deriv_data=e_rrg)
9172 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_gamma, deriv_gamma])
9173 IF (ASSOCIATED(deriv_att)) CALL xc_derivative_get(deriv_att, deriv_data=e_rgg)
9174 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_gamma, deriv_gamma, deriv_gamma])
9175 IF (ASSOCIATED(deriv_att)) CALL xc_derivative_get(deriv_att, deriv_data=e_ggg)
9176 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_gamma])
9177 IF (ASSOCIATED(deriv_att)) CALL xc_derivative_get(deriv_att, deriv_data=e_rg)
9178 deriv_att => xc_dset_get_derivative(deriv_set, [deriv_gamma, deriv_gamma])
9179 IF (ASSOCIATED(deriv_att)) CALL xc_derivative_get(deriv_att, deriv_data=e_gg)
9180
9181 ! The gamma derivatives are supplied by the LibXC path. Functionals
9182 ! implemented natively in CP2K still deliver only the norm_drho ones,
9183 ! for which the third derivative has not been written out.
9184 IF (.NOT. (ASSOCIATED(e_rrr) .AND. ASSOCIATED(e_rrg) .AND. ASSOCIATED(e_rgg) &
9185 .AND. ASSOCIATED(e_ggg) .AND. ASSOCIATED(e_rg) .AND. ASSOCIATED(e_gg))) THEN
9186 cpabort("Analytic 3rd GGA derivatives need the LibXC gamma derivatives")
9187 END IF
9188 END IF
9189
9190 IF (gradient_f .AND. (tau_f .OR. laplace_f)) THEN
9191
9192 ! Restricted meta-GGA. Same gamma formulation as the GGA branch, with
9193 ! the variable set widened to (rho, gamma, laplace_rho, tau). tau and
9194 ! the Laplacian are linear in the density, so their second variations
9195 ! vanish and only gamma contributes a gK11 term.
9196 !
9197 ! out_Z = sum_XY e_{Z X Y} X1 Y1 + e_{Z gamma} gamma11
9198 ! A = out_gamma, B = sum_Y e_{gamma Y} Y1
9199 ! v = 2 grad rho A + 4 grad rho1 B
9200 !
9201 ! out_rho -> v_xc, out_tau -> v_xc_tau, out_laplace_rho -> v_laplace
9202 ! (folded back through xc_pw_laplace below).
9203
9204 CALL xc_rho_set_get(rho_set, drho=drho)
9205 CALL xc_rho_set_get(rho1_set, drho=drho1)
9206 CALL prepare_dr1dr(dr1dr, drho, drho1)
9207 CALL prepare_dr1dr(dr1dr1, drho1, drho1)
9208 IF (tau_f) CALL xc_rho_set_get(rho1_set, tau=tau1)
9209 IF (laplace_f) CALL xc_rho_set_get(rho1_set, laplace_rho=laplace1)
9210
9211 ! a zero field stands in for derivatives this functional does not have
9212 ALLOCATE (zero_f(bo(1, 1):bo(2, 1), bo(1, 2):bo(2, 2), bo(1, 3):bo(2, 3)))
9213 zero_f = 0.0_dp
9214 deriv_att => xc_dset_get_derivative(deriv_set, &
9215 [deriv_rho, deriv_rho])
9216 IF (ASSOCIATED(deriv_att)) THEN
9217 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_rho)
9218 ELSE
9219 m_rho_rho => zero_f
9220 END IF
9221 deriv_att => xc_dset_get_derivative(deriv_set, &
9222 [deriv_rho, deriv_gamma])
9223 IF (ASSOCIATED(deriv_att)) THEN
9224 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_gamma)
9225 ELSE
9226 m_rho_gamma => zero_f
9227 END IF
9228 deriv_att => xc_dset_get_derivative(deriv_set, &
9229 [deriv_rho, deriv_laplace_rho])
9230 IF (ASSOCIATED(deriv_att)) THEN
9231 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_laplace_rho)
9232 ELSE
9233 m_rho_laplace_rho => zero_f
9234 END IF
9235 deriv_att => xc_dset_get_derivative(deriv_set, &
9236 [deriv_rho, deriv_tau])
9237 IF (ASSOCIATED(deriv_att)) THEN
9238 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_tau)
9239 ELSE
9240 m_rho_tau => zero_f
9241 END IF
9242 deriv_att => xc_dset_get_derivative(deriv_set, &
9243 [deriv_gamma, deriv_gamma])
9244 IF (ASSOCIATED(deriv_att)) THEN
9245 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_gamma)
9246 ELSE
9247 m_gamma_gamma => zero_f
9248 END IF
9249 deriv_att => xc_dset_get_derivative(deriv_set, &
9250 [deriv_gamma, deriv_laplace_rho])
9251 IF (ASSOCIATED(deriv_att)) THEN
9252 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_laplace_rho)
9253 ELSE
9254 m_gamma_laplace_rho => zero_f
9255 END IF
9256 deriv_att => xc_dset_get_derivative(deriv_set, &
9257 [deriv_gamma, deriv_tau])
9258 IF (ASSOCIATED(deriv_att)) THEN
9259 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_tau)
9260 ELSE
9261 m_gamma_tau => zero_f
9262 END IF
9263 deriv_att => xc_dset_get_derivative(deriv_set, &
9264 [deriv_laplace_rho, deriv_laplace_rho])
9265 IF (ASSOCIATED(deriv_att)) THEN
9266 CALL xc_derivative_get(deriv_att, deriv_data=m_laplace_rho_laplace_rho)
9267 ELSE
9268 m_laplace_rho_laplace_rho => zero_f
9269 END IF
9270 deriv_att => xc_dset_get_derivative(deriv_set, &
9271 [deriv_laplace_rho, deriv_tau])
9272 IF (ASSOCIATED(deriv_att)) THEN
9273 CALL xc_derivative_get(deriv_att, deriv_data=m_laplace_rho_tau)
9274 ELSE
9275 m_laplace_rho_tau => zero_f
9276 END IF
9277 deriv_att => xc_dset_get_derivative(deriv_set, &
9278 [deriv_tau, deriv_tau])
9279 IF (ASSOCIATED(deriv_att)) THEN
9280 CALL xc_derivative_get(deriv_att, deriv_data=m_tau_tau)
9281 ELSE
9282 m_tau_tau => zero_f
9283 END IF
9284 deriv_att => xc_dset_get_derivative(deriv_set, &
9285 [deriv_rho, deriv_rho, deriv_rho])
9286 IF (ASSOCIATED(deriv_att)) THEN
9287 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_rho_rho)
9288 ELSE
9289 m_rho_rho_rho => zero_f
9290 END IF
9291 deriv_att => xc_dset_get_derivative(deriv_set, &
9292 [deriv_rho, deriv_rho, deriv_gamma])
9293 IF (ASSOCIATED(deriv_att)) THEN
9294 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_rho_gamma)
9295 ELSE
9296 m_rho_rho_gamma => zero_f
9297 END IF
9298 deriv_att => xc_dset_get_derivative(deriv_set, &
9299 [deriv_rho, deriv_rho, deriv_laplace_rho])
9300 IF (ASSOCIATED(deriv_att)) THEN
9301 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_rho_laplace_rho)
9302 ELSE
9303 m_rho_rho_laplace_rho => zero_f
9304 END IF
9305 deriv_att => xc_dset_get_derivative(deriv_set, &
9306 [deriv_rho, deriv_rho, deriv_tau])
9307 IF (ASSOCIATED(deriv_att)) THEN
9308 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_rho_tau)
9309 ELSE
9310 m_rho_rho_tau => zero_f
9311 END IF
9312 deriv_att => xc_dset_get_derivative(deriv_set, &
9313 [deriv_rho, deriv_gamma, deriv_gamma])
9314 IF (ASSOCIATED(deriv_att)) THEN
9315 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_gamma_gamma)
9316 ELSE
9317 m_rho_gamma_gamma => zero_f
9318 END IF
9319 deriv_att => xc_dset_get_derivative(deriv_set, &
9320 [deriv_rho, deriv_gamma, deriv_laplace_rho])
9321 IF (ASSOCIATED(deriv_att)) THEN
9322 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_gamma_laplace_rho)
9323 ELSE
9324 m_rho_gamma_laplace_rho => zero_f
9325 END IF
9326 deriv_att => xc_dset_get_derivative(deriv_set, &
9327 [deriv_rho, deriv_gamma, deriv_tau])
9328 IF (ASSOCIATED(deriv_att)) THEN
9329 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_gamma_tau)
9330 ELSE
9331 m_rho_gamma_tau => zero_f
9332 END IF
9333 deriv_att => xc_dset_get_derivative(deriv_set, &
9334 [deriv_rho, deriv_laplace_rho, deriv_laplace_rho])
9335 IF (ASSOCIATED(deriv_att)) THEN
9336 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_laplace_rho_laplace_rho)
9337 ELSE
9338 m_rho_laplace_rho_laplace_rho => zero_f
9339 END IF
9340 deriv_att => xc_dset_get_derivative(deriv_set, &
9341 [deriv_rho, deriv_laplace_rho, deriv_tau])
9342 IF (ASSOCIATED(deriv_att)) THEN
9343 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_laplace_rho_tau)
9344 ELSE
9345 m_rho_laplace_rho_tau => zero_f
9346 END IF
9347 deriv_att => xc_dset_get_derivative(deriv_set, &
9348 [deriv_rho, deriv_tau, deriv_tau])
9349 IF (ASSOCIATED(deriv_att)) THEN
9350 CALL xc_derivative_get(deriv_att, deriv_data=m_rho_tau_tau)
9351 ELSE
9352 m_rho_tau_tau => zero_f
9353 END IF
9354 deriv_att => xc_dset_get_derivative(deriv_set, &
9355 [deriv_gamma, deriv_gamma, deriv_gamma])
9356 IF (ASSOCIATED(deriv_att)) THEN
9357 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_gamma_gamma)
9358 ELSE
9359 m_gamma_gamma_gamma => zero_f
9360 END IF
9361 deriv_att => xc_dset_get_derivative(deriv_set, &
9362 [deriv_gamma, deriv_gamma, deriv_laplace_rho])
9363 IF (ASSOCIATED(deriv_att)) THEN
9364 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_gamma_laplace_rho)
9365 ELSE
9366 m_gamma_gamma_laplace_rho => zero_f
9367 END IF
9368 deriv_att => xc_dset_get_derivative(deriv_set, &
9369 [deriv_gamma, deriv_gamma, deriv_tau])
9370 IF (ASSOCIATED(deriv_att)) THEN
9371 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_gamma_tau)
9372 ELSE
9373 m_gamma_gamma_tau => zero_f
9374 END IF
9375 deriv_att => xc_dset_get_derivative(deriv_set, &
9376 [deriv_gamma, deriv_laplace_rho, deriv_laplace_rho])
9377 IF (ASSOCIATED(deriv_att)) THEN
9378 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_laplace_rho_laplace_rho)
9379 ELSE
9380 m_gamma_laplace_rho_laplace_rho => zero_f
9381 END IF
9382 deriv_att => xc_dset_get_derivative(deriv_set, &
9383 [deriv_gamma, deriv_laplace_rho, deriv_tau])
9384 IF (ASSOCIATED(deriv_att)) THEN
9385 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_laplace_rho_tau)
9386 ELSE
9387 m_gamma_laplace_rho_tau => zero_f
9388 END IF
9389 deriv_att => xc_dset_get_derivative(deriv_set, &
9390 [deriv_gamma, deriv_tau, deriv_tau])
9391 IF (ASSOCIATED(deriv_att)) THEN
9392 CALL xc_derivative_get(deriv_att, deriv_data=m_gamma_tau_tau)
9393 ELSE
9394 m_gamma_tau_tau => zero_f
9395 END IF
9396 deriv_att => xc_dset_get_derivative(deriv_set, &
9397 [deriv_laplace_rho, deriv_laplace_rho, deriv_laplace_rho])
9398 IF (ASSOCIATED(deriv_att)) THEN
9399 CALL xc_derivative_get(deriv_att, deriv_data=m_laplace_rho_laplace_rho_laplace_rho)
9400 ELSE
9401 m_laplace_rho_laplace_rho_laplace_rho => zero_f
9402 END IF
9403 deriv_att => xc_dset_get_derivative(deriv_set, &
9404 [deriv_laplace_rho, deriv_laplace_rho, deriv_tau])
9405 IF (ASSOCIATED(deriv_att)) THEN
9406 CALL xc_derivative_get(deriv_att, deriv_data=m_laplace_rho_laplace_rho_tau)
9407 ELSE
9408 m_laplace_rho_laplace_rho_tau => zero_f
9409 END IF
9410 deriv_att => xc_dset_get_derivative(deriv_set, &
9411 [deriv_laplace_rho, deriv_tau, deriv_tau])
9412 IF (ASSOCIATED(deriv_att)) THEN
9413 CALL xc_derivative_get(deriv_att, deriv_data=m_laplace_rho_tau_tau)
9414 ELSE
9415 m_laplace_rho_tau_tau => zero_f
9416 END IF
9417 deriv_att => xc_dset_get_derivative(deriv_set, &
9418 [deriv_tau, deriv_tau, deriv_tau])
9419 IF (ASSOCIATED(deriv_att)) THEN
9420 CALL xc_derivative_get(deriv_att, deriv_data=m_tau_tau_tau)
9421 ELSE
9422 m_tau_tau_tau => zero_f
9423 END IF
9424
9425 IF (laplace_f) THEN
9426 ALLOCATE (v_laplace(nspins))
9427 DO ispin = 1, nspins
9428 CALL allocate_pw(v_laplace(ispin), pw_pool, bo)
9429 END DO
9430 END IF
9431
9432!$OMP PARALLEL DO PRIVATE(k,j,i,mp_rho,mp_gamma,mp_laplace_rho,mp_tau,mpp_gamma, &
9433!$OMP m_rho,m_gamma,m_laplace_rho,m_tau,m_B) DEFAULT(NONE) COLLAPSE(3) &
9434!$OMP SHARED(m_rho_rho) &
9435!$OMP SHARED(m_rho_gamma) &
9436!$OMP SHARED(m_rho_laplace_rho) &
9437!$OMP SHARED(m_rho_tau) &
9438!$OMP SHARED(m_gamma_gamma) &
9439!$OMP SHARED(m_gamma_laplace_rho) &
9440!$OMP SHARED(m_gamma_tau) &
9441!$OMP SHARED(m_laplace_rho_laplace_rho) &
9442!$OMP SHARED(m_laplace_rho_tau) &
9443!$OMP SHARED(m_tau_tau) &
9444!$OMP SHARED(m_rho_rho_rho) &
9445!$OMP SHARED(m_rho_rho_gamma) &
9446!$OMP SHARED(m_rho_rho_laplace_rho) &
9447!$OMP SHARED(m_rho_rho_tau) &
9448!$OMP SHARED(m_rho_gamma_gamma) &
9449!$OMP SHARED(m_rho_gamma_laplace_rho) &
9450!$OMP SHARED(m_rho_gamma_tau) &
9451!$OMP SHARED(m_rho_laplace_rho_laplace_rho) &
9452!$OMP SHARED(m_rho_laplace_rho_tau) &
9453!$OMP SHARED(m_rho_tau_tau) &
9454!$OMP SHARED(m_gamma_gamma_gamma) &
9455!$OMP SHARED(m_gamma_gamma_laplace_rho) &
9456!$OMP SHARED(m_gamma_gamma_tau) &
9457!$OMP SHARED(m_gamma_laplace_rho_laplace_rho) &
9458!$OMP SHARED(m_gamma_laplace_rho_tau) &
9459!$OMP SHARED(m_gamma_tau_tau) &
9460!$OMP SHARED(m_laplace_rho_laplace_rho_laplace_rho) &
9461!$OMP SHARED(m_laplace_rho_laplace_rho_tau) &
9462!$OMP SHARED(m_laplace_rho_tau_tau) &
9463!$OMP SHARED(m_tau_tau_tau) &
9464!$OMP SHARED(bo,rho1,dr1dr,dr1dr1,tau_f,tau1,laplace_f,laplace1, &
9465!$OMP v_xc,v_xc_tau,v_laplace,v_drho_r,drho,drho1)
9466 DO k = bo(1, 3), bo(2, 3)
9467 DO j = bo(1, 2), bo(2, 2)
9468 DO i = bo(1, 1), bo(2, 1)
9469 mp_rho = rho1(i, j, k)
9470 mp_gamma = 2.0_dp*dr1dr(i, j, k)
9471 mpp_gamma = 2.0_dp*dr1dr1(i, j, k)
9472 mp_tau = 0.0_dp
9473 IF (tau_f) mp_tau = tau1(i, j, k)
9474 mp_laplace_rho = 0.0_dp
9475 IF (laplace_f) mp_laplace_rho = laplace1(i, j, k)
9476
9477 m_rho = 0.0_dp
9478 m_rho = m_rho + 1.0_dp* &
9479 m_rho_rho_rho(i, j, k)*mp_rho*mp_rho
9480 m_rho = m_rho + 2.0_dp* &
9481 m_rho_rho_gamma(i, j, k)*mp_rho*mp_gamma
9482 m_rho = m_rho + 2.0_dp* &
9483 m_rho_rho_laplace_rho(i, j, k)*mp_rho*mp_laplace_rho
9484 m_rho = m_rho + 2.0_dp* &
9485 m_rho_rho_tau(i, j, k)*mp_rho*mp_tau
9486 m_rho = m_rho + 1.0_dp* &
9487 m_rho_gamma_gamma(i, j, k)*mp_gamma*mp_gamma
9488 m_rho = m_rho + 2.0_dp* &
9489 m_rho_gamma_laplace_rho(i, j, k)*mp_gamma*mp_laplace_rho
9490 m_rho = m_rho + 2.0_dp* &
9491 m_rho_gamma_tau(i, j, k)*mp_gamma*mp_tau
9492 m_rho = m_rho + 1.0_dp* &
9493 m_rho_laplace_rho_laplace_rho(i, j, k)*mp_laplace_rho*mp_laplace_rho
9494 m_rho = m_rho + 2.0_dp* &
9495 m_rho_laplace_rho_tau(i, j, k)*mp_laplace_rho*mp_tau
9496 m_rho = m_rho + 1.0_dp* &
9497 m_rho_tau_tau(i, j, k)*mp_tau*mp_tau
9498 m_rho = m_rho + m_rho_gamma(i, j, k)*mpp_gamma
9499 m_gamma = 0.0_dp
9500 m_gamma = m_gamma + 1.0_dp* &
9501 m_rho_rho_gamma(i, j, k)*mp_rho*mp_rho
9502 m_gamma = m_gamma + 2.0_dp* &
9503 m_rho_gamma_gamma(i, j, k)*mp_rho*mp_gamma
9504 m_gamma = m_gamma + 2.0_dp* &
9505 m_rho_gamma_laplace_rho(i, j, k)*mp_rho*mp_laplace_rho
9506 m_gamma = m_gamma + 2.0_dp* &
9507 m_rho_gamma_tau(i, j, k)*mp_rho*mp_tau
9508 m_gamma = m_gamma + 1.0_dp* &
9509 m_gamma_gamma_gamma(i, j, k)*mp_gamma*mp_gamma
9510 m_gamma = m_gamma + 2.0_dp* &
9511 m_gamma_gamma_laplace_rho(i, j, k)*mp_gamma*mp_laplace_rho
9512 m_gamma = m_gamma + 2.0_dp* &
9513 m_gamma_gamma_tau(i, j, k)*mp_gamma*mp_tau
9514 m_gamma = m_gamma + 1.0_dp* &
9515 m_gamma_laplace_rho_laplace_rho(i, j, k)*mp_laplace_rho*mp_laplace_rho
9516 m_gamma = m_gamma + 2.0_dp* &
9517 m_gamma_laplace_rho_tau(i, j, k)*mp_laplace_rho*mp_tau
9518 m_gamma = m_gamma + 1.0_dp* &
9519 m_gamma_tau_tau(i, j, k)*mp_tau*mp_tau
9520 m_gamma = m_gamma + m_gamma_gamma(i, j, k)*mpp_gamma
9521 m_laplace_rho = 0.0_dp
9522 m_laplace_rho = m_laplace_rho + 1.0_dp* &
9523 m_rho_rho_laplace_rho(i, j, k)*mp_rho*mp_rho
9524 m_laplace_rho = m_laplace_rho + 2.0_dp* &
9525 m_rho_gamma_laplace_rho(i, j, k)*mp_rho*mp_gamma
9526 m_laplace_rho = m_laplace_rho + 2.0_dp* &
9527 m_rho_laplace_rho_laplace_rho(i, j, k)*mp_rho*mp_laplace_rho
9528 m_laplace_rho = m_laplace_rho + 2.0_dp* &
9529 m_rho_laplace_rho_tau(i, j, k)*mp_rho*mp_tau
9530 m_laplace_rho = m_laplace_rho + 1.0_dp* &
9531 m_gamma_gamma_laplace_rho(i, j, k)*mp_gamma*mp_gamma
9532 m_laplace_rho = m_laplace_rho + 2.0_dp* &
9533 m_gamma_laplace_rho_laplace_rho(i, j, k)*mp_gamma*mp_laplace_rho
9534 m_laplace_rho = m_laplace_rho + 2.0_dp* &
9535 m_gamma_laplace_rho_tau(i, j, k)*mp_gamma*mp_tau
9536 m_laplace_rho = m_laplace_rho + 1.0_dp* &
9537 m_laplace_rho_laplace_rho_laplace_rho(i, j, k)*mp_laplace_rho*mp_laplace_rho
9538 m_laplace_rho = m_laplace_rho + 2.0_dp* &
9539 m_laplace_rho_laplace_rho_tau(i, j, k)*mp_laplace_rho*mp_tau
9540 m_laplace_rho = m_laplace_rho + 1.0_dp* &
9541 m_laplace_rho_tau_tau(i, j, k)*mp_tau*mp_tau
9542 m_laplace_rho = m_laplace_rho + m_gamma_laplace_rho(i, j, k)*mpp_gamma
9543 m_tau = 0.0_dp
9544 m_tau = m_tau + 1.0_dp* &
9545 m_rho_rho_tau(i, j, k)*mp_rho*mp_rho
9546 m_tau = m_tau + 2.0_dp* &
9547 m_rho_gamma_tau(i, j, k)*mp_rho*mp_gamma
9548 m_tau = m_tau + 2.0_dp* &
9549 m_rho_laplace_rho_tau(i, j, k)*mp_rho*mp_laplace_rho
9550 m_tau = m_tau + 2.0_dp* &
9551 m_rho_tau_tau(i, j, k)*mp_rho*mp_tau
9552 m_tau = m_tau + 1.0_dp* &
9553 m_gamma_gamma_tau(i, j, k)*mp_gamma*mp_gamma
9554 m_tau = m_tau + 2.0_dp* &
9555 m_gamma_laplace_rho_tau(i, j, k)*mp_gamma*mp_laplace_rho
9556 m_tau = m_tau + 2.0_dp* &
9557 m_gamma_tau_tau(i, j, k)*mp_gamma*mp_tau
9558 m_tau = m_tau + 1.0_dp* &
9559 m_laplace_rho_laplace_rho_tau(i, j, k)*mp_laplace_rho*mp_laplace_rho
9560 m_tau = m_tau + 2.0_dp* &
9561 m_laplace_rho_tau_tau(i, j, k)*mp_laplace_rho*mp_tau
9562 m_tau = m_tau + 1.0_dp* &
9563 m_tau_tau_tau(i, j, k)*mp_tau*mp_tau
9564 m_tau = m_tau + m_gamma_tau(i, j, k)*mpp_gamma
9565 m_b = 0.0_dp
9566 m_b = m_b + m_rho_gamma(i, j, k)*mp_rho
9567 m_b = m_b + m_gamma_gamma(i, j, k)*mp_gamma
9568 m_b = m_b + m_gamma_laplace_rho(i, j, k)*mp_laplace_rho
9569 m_b = m_b + m_gamma_tau(i, j, k)*mp_tau
9570
9571 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + m_rho
9572 IF (tau_f) v_xc_tau(1)%array(i, j, k) = &
9573 v_xc_tau(1)%array(i, j, k) + m_tau
9574 IF (laplace_f) v_laplace(1)%array(i, j, k) = &
9575 v_laplace(1)%array(i, j, k) + m_laplace_rho
9576
9577 ! xc_pw_divergence ADDS div(field), and g_xc = u - div(v)
9578 v_drho_r(1, 1)%array(i, j, k) = &
9579 -(2.0_dp*drho(1)%array(i, j, k)*m_gamma &
9580 + 4.0_dp*drho1(1)%array(i, j, k)*m_b)
9581 v_drho_r(2, 1)%array(i, j, k) = &
9582 -(2.0_dp*drho(2)%array(i, j, k)*m_gamma &
9583 + 4.0_dp*drho1(2)%array(i, j, k)*m_b)
9584 v_drho_r(3, 1)%array(i, j, k) = &
9585 -(2.0_dp*drho(3)%array(i, j, k)*m_gamma &
9586 + 4.0_dp*drho1(3)%array(i, j, k)*m_b)
9587 END DO
9588 END DO
9589 END DO
9590
9591 IF (my_gapw) THEN
9592 DO idir = 1, 3
9593 vxg(idir, :, :, 1) = -v_drho_r(idir, 1)%array(:, :, 1)
9594 END DO
9595 ELSE
9596 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 1), tmp_g, vxc_g, v_xc(1))
9597 END IF
9598
9599 IF (laplace_f) THEN
9600 DO ispin = 1, nspins
9601 CALL xc_pw_laplace(v_laplace(ispin), pw_pool, xc_deriv_method_id)
9602 CALL pw_axpy(v_laplace(ispin), v_xc(ispin))
9603 CALL deallocate_pw(v_laplace(ispin), pw_pool)
9604 END DO
9605 DEALLOCATE (v_laplace)
9606 END IF
9607 DEALLOCATE (zero_f)
9608
9609 ELSE IF (.NOT. gradient_f) THEN
9610 IF (ASSOCIATED(e_rrr)) THEN
9611!$OMP PARALLEL DO PRIVATE(k,j,i) DEFAULT(NONE) SHARED(bo,v_xc,e_rrr,rho1) COLLAPSE(3)
9612 DO k = bo(1, 3), bo(2, 3)
9613 DO j = bo(1, 2), bo(2, 2)
9614 DO i = bo(1, 1), bo(2, 1)
9615 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + &
9616 e_rrr(i, j, k)*rho1(i, j, k)**2
9617 END DO
9618 END DO
9619 END DO
9620 END IF
9621 ELSE
9622!$OMP PARALLEL DO PRIVATE(k,j,i,g1,g11,uu,aa,bb) DEFAULT(NONE) &
9623!$OMP SHARED(bo,v_xc,v_drho_r,rho1,dr1dr,dr1dr1,drho,drho1, &
9624!$OMP e_rrr,e_rrg,e_rgg,e_ggg,e_rg,e_gg) COLLAPSE(3)
9625 DO k = bo(1, 3), bo(2, 3)
9626 DO j = bo(1, 2), bo(2, 2)
9627 DO i = bo(1, 1), bo(2, 1)
9628 g1 = 2.0_dp*dr1dr(i, j, k)
9629 g11 = 2.0_dp*dr1dr1(i, j, k)
9630
9631 uu = e_rrr(i, j, k)*rho1(i, j, k)**2 &
9632 + 2.0_dp*e_rrg(i, j, k)*rho1(i, j, k)*g1 &
9633 + e_rgg(i, j, k)*g1**2 &
9634 + e_rg(i, j, k)*g11
9635 aa = e_rrg(i, j, k)*rho1(i, j, k)**2 &
9636 + 2.0_dp*e_rgg(i, j, k)*rho1(i, j, k)*g1 &
9637 + e_ggg(i, j, k)*g1**2 &
9638 + e_gg(i, j, k)*g11
9639 bb = e_rg(i, j, k)*rho1(i, j, k) + e_gg(i, j, k)*g1
9640
9641 v_xc(1)%array(i, j, k) = v_xc(1)%array(i, j, k) + uu
9642 ! xc_pw_divergence ADDS div(field), and g_xc = u - div(v),
9643 ! so the field handed over is -v
9644 v_drho_r(1, 1)%array(i, j, k) = -(2.0_dp*drho(1)%array(i, j, k)*aa &
9645 + 4.0_dp*drho1(1)%array(i, j, k)*bb)
9646 v_drho_r(2, 1)%array(i, j, k) = -(2.0_dp*drho(2)%array(i, j, k)*aa &
9647 + 4.0_dp*drho1(2)%array(i, j, k)*bb)
9648 v_drho_r(3, 1)%array(i, j, k) = -(2.0_dp*drho(3)%array(i, j, k)*aa &
9649 + 4.0_dp*drho1(3)%array(i, j, k)*bb)
9650 END DO
9651 END DO
9652 END DO
9653
9654 IF (my_gapw) THEN
9655 DO idir = 1, 3
9656 vxg(idir, :, :, 1) = -v_drho_r(idir, 1)%array(:, :, 1)
9657 END DO
9658 ELSE
9659 CALL xc_pw_divergence(xc_deriv_method_id, v_drho_r(:, 1), tmp_g, vxc_g, v_xc(1))
9660 END IF
9661 END IF
9662
9663 END IF
9664
9665 IF (gradient_f) THEN
9666
9667 DO ispin = 1, nspins
9668 CALL deallocate_pw(v_drho(ispin), pw_pool)
9669 DO idir = 1, 3
9670 CALL deallocate_pw(v_drho_r(idir, ispin), pw_pool)
9671 END DO
9672 END DO
9673 DEALLOCATE (v_drho, v_drho_r)
9674
9675 END IF
9676
9677 IF (ASSOCIATED(tmp_g%pw_grid) .AND. ASSOCIATED(pw_pool)) THEN
9678 CALL pw_pool%give_back_pw(tmp_g)
9679 END IF
9680
9681 IF (ASSOCIATED(vxc_g%pw_grid) .AND. ASSOCIATED(pw_pool)) THEN
9682 CALL pw_pool%give_back_pw(vxc_g)
9683 END IF
9684
9685 CALL timestop(handle)
9686 END SUBROUTINE xc_calc_3rd_deriv_analytical
9687
9688! **************************************************************************************************
9689!> \brief allocates grids using pw_pool (if associated) or with bounds
9690!> \param pw ...
9691!> \param pw_pool ...
9692!> \param bo ...
9693! **************************************************************************************************
9694 SUBROUTINE allocate_pw(pw, pw_pool, bo)
9695 TYPE(pw_r3d_rs_type), INTENT(OUT) :: pw
9696 TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool
9697 INTEGER, DIMENSION(2, 3), INTENT(IN) :: bo
9698
9699 IF (ASSOCIATED(pw_pool)) THEN
9700 CALL pw_pool%create_pw(pw)
9701 CALL pw_zero(pw)
9702 ELSE
9703 ALLOCATE (pw%array(bo(1, 1):bo(2, 1), bo(1, 2):bo(2, 2), bo(1, 3):bo(2, 3)))
9704 pw%array = 0.0_dp
9705 END IF
9706
9707 END SUBROUTINE allocate_pw
9708
9709! **************************************************************************************************
9710!> \brief deallocates grid allocated with allocate_pw
9711!> \param pw ...
9712!> \param pw_pool ...
9713! **************************************************************************************************
9714 SUBROUTINE deallocate_pw(pw, pw_pool)
9715 TYPE(pw_r3d_rs_type), INTENT(INOUT) :: pw
9716 TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool
9717
9718 IF (ASSOCIATED(pw_pool)) THEN
9719 CALL pw_pool%give_back_pw(pw)
9720 ELSE
9721 CALL pw%release()
9722 END IF
9723
9724 END SUBROUTINE deallocate_pw
9725
9726! **************************************************************************************************
9727!> \brief updates virial from first derivative w.r.t. norm_drho
9728!> \param virial_pw ...
9729!> \param drho ...
9730!> \param drho1 ...
9731!> \param deriv_data ...
9732!> \param virial_xc ...
9733! **************************************************************************************************
9734 SUBROUTINE virial_drho_drho1(virial_pw, drho, drho1, deriv_data, virial_xc)
9735 TYPE(pw_r3d_rs_type), INTENT(IN) :: virial_pw
9736 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drho, drho1
9737 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: deriv_data
9738 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT) :: virial_xc
9739
9740 INTEGER :: idir, jdir
9741 REAL(kind=dp) :: tmp
9742
9743 DO idir = 1, 3
9744!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drho,idir,virial_pw,deriv_data)
9745 virial_pw%array(:, :, :) = drho(idir)%array(:, :, :)*deriv_data(:, :, :)
9746!$OMP END PARALLEL WORKSHARE
9747 DO jdir = 1, 3
9748 tmp = virial_pw%pw_grid%dvol*accurate_dot_product(virial_pw%array(:, :, :), &
9749 drho1(jdir)%array(:, :, :))
9750 virial_xc(jdir, idir) = virial_xc(jdir, idir) + tmp
9751 virial_xc(idir, jdir) = virial_xc(idir, jdir) + tmp
9752 END DO
9753 END DO
9754
9755 END SUBROUTINE virial_drho_drho1
9756
9757! **************************************************************************************************
9758!> \brief Adds virial contribution from second order potential parts
9759!> \param virial_pw ...
9760!> \param drho ...
9761!> \param v_drho ...
9762!> \param virial_xc ...
9763! **************************************************************************************************
9764 SUBROUTINE virial_drho_drho(virial_pw, drho, v_drho, virial_xc)
9765 TYPE(pw_r3d_rs_type), INTENT(IN) :: virial_pw
9766 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drho
9767 TYPE(pw_r3d_rs_type), INTENT(IN) :: v_drho
9768 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT) :: virial_xc
9769
9770 INTEGER :: idir, jdir
9771 REAL(kind=dp) :: tmp
9772
9773 DO idir = 1, 3
9774!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drho,idir,v_drho,virial_pw)
9775 virial_pw%array(:, :, :) = drho(idir)%array(:, :, :)*v_drho%array(:, :, :)
9776!$OMP END PARALLEL WORKSHARE
9777 DO jdir = 1, idir
9778 tmp = -virial_pw%pw_grid%dvol*accurate_dot_product(virial_pw%array(:, :, :), &
9779 drho(jdir)%array(:, :, :))
9780 virial_xc(jdir, idir) = virial_xc(jdir, idir) + tmp
9781 virial_xc(idir, jdir) = virial_xc(jdir, idir)
9782 END DO
9783 END DO
9784
9785 END SUBROUTINE virial_drho_drho
9786
9787! **************************************************************************************************
9788!> \brief ...
9789!> \param rho_r ...
9790!> \param pw_pool ...
9791!> \param virial_xc ...
9792!> \param deriv_data ...
9793! **************************************************************************************************
9794 SUBROUTINE virial_laplace(rho_r, pw_pool, virial_xc, deriv_data)
9795 TYPE(pw_r3d_rs_type), TARGET :: rho_r
9796 TYPE(pw_pool_type), POINTER, INTENT(IN) :: pw_pool
9797 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT) :: virial_xc
9798 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: deriv_data
9799
9800 CHARACTER(len=*), PARAMETER :: routinen = 'virial_laplace'
9801
9802 INTEGER :: handle, idir, jdir
9803 TYPE(pw_r3d_rs_type), POINTER :: virial_pw
9804 TYPE(pw_c1d_gs_type), POINTER :: tmp_g, rho_g
9805 INTEGER, DIMENSION(3) :: my_deriv
9806
9807 CALL timeset(routinen, handle)
9808
9809 NULLIFY (virial_pw, tmp_g, rho_g)
9810 ALLOCATE (virial_pw, tmp_g, rho_g)
9811 CALL pw_pool%create_pw(virial_pw)
9812 CALL pw_pool%create_pw(tmp_g)
9813 CALL pw_pool%create_pw(rho_g)
9814 CALL pw_zero(virial_pw)
9815 CALL pw_transfer(rho_r, rho_g)
9816 DO idir = 1, 3
9817 DO jdir = idir, 3
9818 CALL pw_copy(rho_g, tmp_g)
9819
9820 my_deriv = 0
9821 my_deriv(idir) = 1
9822 my_deriv(jdir) = my_deriv(jdir) + 1
9823
9824 CALL pw_derive(tmp_g, my_deriv)
9825 CALL pw_transfer(tmp_g, virial_pw)
9826 virial_xc(idir, jdir) = virial_xc(idir, jdir) - 2.0_dp*virial_pw%pw_grid%dvol* &
9827 accurate_dot_product(virial_pw%array(:, :, :), &
9828 deriv_data(:, :, :))
9829 virial_xc(jdir, idir) = virial_xc(idir, jdir)
9830 END DO
9831 END DO
9832 CALL pw_pool%give_back_pw(virial_pw)
9833 CALL pw_pool%give_back_pw(tmp_g)
9834 CALL pw_pool%give_back_pw(rho_g)
9835 DEALLOCATE (virial_pw, tmp_g, rho_g)
9836
9837 CALL timestop(handle)
9838
9839 END SUBROUTINE virial_laplace
9840
9841! **************************************************************************************************
9842!> \brief Prepare objects for the calculation of the 2nd derivatives of the density functional.
9843!> The calculation must then be performed with xc_calc_2nd_deriv.
9844!> \param deriv_set object containing the XC derivatives (out)
9845!> \param rho_set object that will contain the density at which the
9846!> derivatives were calculated
9847!> \param rho_r the place where you evaluate the derivative
9848!> \param pw_pool the pool for the grids
9849!> \param weights integration weights
9850!> \param xc_section which functional should be used and how to calculate it
9851!> \param tau_r kinetic energy density in real space
9852! **************************************************************************************************
9853 SUBROUTINE xc_prep_2nd_deriv(deriv_set, &
9854 rho_set, rho_r, pw_pool, weights, xc_section, tau_r)
9855
9856 TYPE(xc_derivative_set_type) :: deriv_set
9857 TYPE(xc_rho_set_type) :: rho_set
9858 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
9859 TYPE(pw_pool_type), POINTER :: pw_pool
9860 TYPE(pw_r3d_rs_type), POINTER :: weights
9861 TYPE(section_vals_type), POINTER :: xc_section
9862 TYPE(pw_r3d_rs_type), DIMENSION(:), &
9863 OPTIONAL, POINTER :: tau_r
9864
9865 CHARACTER(len=*), PARAMETER :: routinen = 'xc_prep_2nd_deriv'
9866
9867 INTEGER :: handle, nspins
9868 LOGICAL :: lsd
9869 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
9870 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: tau
9871
9872 CALL timeset(routinen, handle)
9873
9874 cpassert(ASSOCIATED(xc_section))
9875 cpassert(ASSOCIATED(pw_pool))
9876
9877 IF (xc_section_uses_gauxc(xc_section)) THEN
9878 CALL cp_abort(__location__, gauxc_high_deriv_message)
9879 END IF
9880
9881 nspins = SIZE(rho_r)
9882 lsd = (nspins /= 1)
9883
9884 NULLIFY (rho_g, tau)
9885 IF (PRESENT(tau_r)) tau => tau_r
9886
9887 IF (section_get_lval(xc_section, "2ND_DERIV_ANALYTICAL")) THEN
9888 CALL xc_rho_set_and_dset_create(rho_set, deriv_set, 2, &
9889 rho_r, rho_g, tau, xc_section, pw_pool, weights, &
9890 calc_potential=.true.)
9891 ELSE
9892 CALL xc_rho_set_and_dset_create(rho_set, deriv_set, 1, &
9893 rho_r, rho_g, tau, xc_section, pw_pool, weights, &
9894 calc_potential=.true.)
9895 END IF
9896
9897 CALL timestop(handle)
9898
9899 END SUBROUTINE xc_prep_2nd_deriv
9900
9901! **************************************************************************************************
9902!> \brief Prepare deriv_set for the calculation of the 3rd derivatives of the density functional.
9903!> The calculation must then be performed with xc_calc_3rd_deriv.
9904!> \param deriv_set object containing the XC derivatives (out)
9905!> \param rho_set object that will contain the density at which the
9906!> derivatives were calculated
9907!> \param rho_r the place where you evaluate the derivative
9908!> \param pw_pool the pool for the grids
9909!> \param weights integration weights
9910!> \param xc_section which functional should be used and how to calculate it
9911!> \param tau_r kinetic energy density in real space
9912!> \param do_sf Flag to activate the noncollinear kernel for spin flip calculations
9913!> \par History
9914!> * 07.2024 Created [LHS]
9915! **************************************************************************************************
9916 SUBROUTINE xc_prep_3rd_deriv(deriv_set, rho_set, rho_r, pw_pool, weights, &
9917 xc_section, tau_r, do_sf)
9918
9919 TYPE(xc_derivative_set_type) :: deriv_set
9920 TYPE(xc_rho_set_type) :: rho_set
9921 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
9922 TYPE(pw_pool_type), POINTER :: pw_pool
9923 TYPE(pw_r3d_rs_type), POINTER :: weights
9924 TYPE(section_vals_type), POINTER :: xc_section
9925 TYPE(pw_r3d_rs_type), DIMENSION(:), &
9926 OPTIONAL, POINTER :: tau_r
9927 LOGICAL, OPTIONAL :: do_sf
9928
9929 CHARACTER(len=*), PARAMETER :: routinen = 'xc_prep_3rd_deriv'
9930
9931 INTEGER :: handle, nspins
9932 LOGICAL :: lsd, my_do_sf
9933 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
9934 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: tau
9935
9936 CALL timeset(routinen, handle)
9937
9938 cpassert(ASSOCIATED(xc_section))
9939 cpassert(ASSOCIATED(pw_pool))
9940
9941 IF (xc_section_uses_gauxc(xc_section)) THEN
9942 CALL cp_abort(__location__, gauxc_high_deriv_message)
9943 END IF
9944
9945 nspins = SIZE(rho_r)
9946 lsd = (nspins /= 1)
9947
9948 NULLIFY (rho_g, tau)
9949 IF (PRESENT(tau_r)) tau => tau_r
9950
9951 my_do_sf = .false.
9952 IF (PRESENT(do_sf)) my_do_sf = do_sf
9953
9954 IF (do_sf) THEN
9955 CALL xc_rho_set_and_dset_create(rho_set, deriv_set, 2, &
9956 rho_r, rho_g, tau, xc_section, pw_pool, weights, &
9957 calc_potential=.true.)
9958 ELSE
9959 CALL xc_rho_set_and_dset_create(rho_set, deriv_set, 3, &
9960 rho_r, rho_g, tau, xc_section, pw_pool, weights, &
9961 calc_potential=.true.)
9962 END IF
9963
9964 CALL timestop(handle)
9965
9966 END SUBROUTINE xc_prep_3rd_deriv
9967
9968! **************************************************************************************************
9969!> \brief divides derivatives from deriv_set by norm_drho
9970!> \param deriv_set ...
9971!> \param rho_set ...
9972!> \param lsd ...
9973! **************************************************************************************************
9974 SUBROUTINE divide_by_norm_drho(deriv_set, rho_set, lsd)
9975
9976 TYPE(xc_derivative_set_type), INTENT(INOUT) :: deriv_set
9977 TYPE(xc_rho_set_type), INTENT(IN) :: rho_set
9978 LOGICAL, INTENT(IN) :: lsd
9979
9980 INTEGER, DIMENSION(:), POINTER :: split_desc
9981 INTEGER :: idesc
9982 INTEGER, DIMENSION(2, 3) :: bo
9983 REAL(kind=dp) :: drho_cutoff
9984 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: norm_drho, norm_drhoa, norm_drhob
9985 TYPE(cp_3d_r_cp_type), DIMENSION(3) :: drho, drhoa, drhob
9986 TYPE(cp_sll_xc_deriv_type), POINTER :: pos
9987 TYPE(xc_derivative_type), POINTER :: deriv_att
9988
9989! check for unknown derivatives and divide by norm_drho where necessary
9990
9991 bo = rho_set%local_bounds
9992 CALL xc_rho_set_get(rho_set, drho_cutoff=drho_cutoff, norm_drho=norm_drho, &
9993 norm_drhoa=norm_drhoa, norm_drhob=norm_drhob, &
9994 drho=drho, drhoa=drhoa, drhob=drhob, can_return_null=.true.)
9995
9996 pos => deriv_set%derivs
9997 DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
9998 CALL xc_derivative_get(deriv_att, split_desc=split_desc)
9999 DO idesc = 1, SIZE(split_desc)
10000 SELECT CASE (split_desc(idesc))
10001 CASE (deriv_norm_drho)
10002 IF (ASSOCIATED(norm_drho)) THEN
10003!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,norm_drho,drho_cutoff)
10004 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10005 max(norm_drho(:, :, :), drho_cutoff)
10006!$OMP END PARALLEL WORKSHARE
10007 ELSE IF (ASSOCIATED(drho(1)%array)) THEN
10008!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,drho,drho_cutoff)
10009 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10010 max(sqrt(drho(1)%array(:, :, :)**2 + &
10011 drho(2)%array(:, :, :)**2 + &
10012 drho(3)%array(:, :, :)**2), drho_cutoff)
10013!$OMP END PARALLEL WORKSHARE
10014 ELSE IF (ASSOCIATED(drhoa(1)%array) .AND. ASSOCIATED(drhob(1)%array)) THEN
10015!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,drhoa,drhob,drho_cutoff)
10016 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10017 max(sqrt((drhoa(1)%array(:, :, :) + drhob(1)%array(:, :, :))**2 + &
10018 (drhoa(2)%array(:, :, :) + drhob(2)%array(:, :, :))**2 + &
10019 (drhoa(3)%array(:, :, :) + drhob(3)%array(:, :, :))**2), drho_cutoff)
10020!$OMP END PARALLEL WORKSHARE
10021 ELSE
10022 cpabort("Normalization of derivative requires any of norm_drho, drho or drhoa+drhob!")
10023 END IF
10024 CASE (deriv_norm_drhoa)
10025 IF (ASSOCIATED(norm_drhoa)) THEN
10026!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,norm_drhoa,drho_cutoff)
10027 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10028 max(norm_drhoa(:, :, :), drho_cutoff)
10029!$OMP END PARALLEL WORKSHARE
10030 ELSE IF (ASSOCIATED(drhoa(1)%array)) THEN
10031!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,drhoa,drho_cutoff)
10032 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10033 max(sqrt(drhoa(1)%array(:, :, :)**2 + &
10034 drhoa(2)%array(:, :, :)**2 + &
10035 drhoa(3)%array(:, :, :)**2), drho_cutoff)
10036!$OMP END PARALLEL WORKSHARE
10037 ELSE
10038 cpabort("Normalization of derivative requires any of norm_drhoa or drhoa!")
10039 END IF
10040 CASE (deriv_norm_drhob)
10041 IF (ASSOCIATED(norm_drhob)) THEN
10042!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,norm_drhob,drho_cutoff)
10043 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10044 max(norm_drhob(:, :, :), drho_cutoff)
10045!$OMP END PARALLEL WORKSHARE
10046 ELSE IF (ASSOCIATED(drhob(1)%array)) THEN
10047!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(deriv_att,drhob,drho_cutoff)
10048 deriv_att%deriv_data(:, :, :) = deriv_att%deriv_data(:, :, :)/ &
10049 max(sqrt(drhob(1)%array(:, :, :)**2 + &
10050 drhob(2)%array(:, :, :)**2 + &
10051 drhob(3)%array(:, :, :)**2), drho_cutoff)
10052!$OMP END PARALLEL WORKSHARE
10053 ELSE
10054 cpabort("Normalization of derivative requires any of norm_drhob or drhob!")
10055 END IF
10056 CASE (deriv_rho, deriv_tau, deriv_laplace_rho, deriv_gamma)
10057 ! gamma derivatives need no normalization: unlike norm_drho they
10058 ! are already the variables LibXC differentiated with respect to
10059 IF (lsd) THEN
10060 cpabort(trim(id_to_desc(split_desc(idesc)))//" not handled in lsd!'")
10061 END IF
10062 CASE (deriv_rhoa, deriv_rhob, deriv_tau_a, deriv_tau_b, deriv_laplace_rhoa, deriv_laplace_rhob, &
10063 deriv_gamma_aa, deriv_gamma_ab, deriv_gamma_bb)
10064 CASE default
10065 cpabort("Unknown derivative id")
10066 END SELECT
10067 END DO
10068 END DO
10069
10070 END SUBROUTINE divide_by_norm_drho
10071
10072! **************************************************************************************************
10073!> \brief allocates and calculates drho from given spin densities drhoa, drhob
10074!> \param drho ...
10075!> \param drhoa ...
10076!> \param drhob ...
10077! **************************************************************************************************
10078 SUBROUTINE calc_drho_from_ab(drho, drhoa, drhob)
10079 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(OUT) :: drho
10080 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drhoa, drhob
10081
10082 CHARACTER(len=*), PARAMETER :: routinen = 'calc_drho_from_ab'
10083
10084 INTEGER :: handle, idir
10085
10086 CALL timeset(routinen, handle)
10087
10088 DO idir = 1, 3
10089 NULLIFY (drho(idir)%array)
10090 ALLOCATE (drho(idir)%array(lbound(drhoa(1)%array, 1):ubound(drhoa(1)%array, 1), &
10091 lbound(drhoa(1)%array, 2):ubound(drhoa(1)%array, 2), &
10092 lbound(drhoa(1)%array, 3):ubound(drhoa(1)%array, 3)))
10093!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drho,drhoa,drhob,idir)
10094 drho(idir)%array(:, :, :) = drhoa(idir)%array(:, :, :) + drhob(idir)%array(:, :, :)
10095!$OMP END PARALLEL WORKSHARE
10096 END DO
10097
10098 CALL timestop(handle)
10099
10100 END SUBROUTINE calc_drho_from_ab
10101
10102! **************************************************************************************************
10103!> \brief allocates and calculates drho from given spin densities drhoa, drhob
10104!> \param drho ...
10105!> \param drhoa ...
10106!> \param drhob ...
10107! **************************************************************************************************
10108 SUBROUTINE calc_drho_from_a(drho, drhoa)
10109 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(OUT) :: drho
10110 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drhoa
10111
10112 CHARACTER(len=*), PARAMETER :: routinen = 'calc_drho_from_a'
10113
10114 INTEGER :: handle, idir
10115
10116 CALL timeset(routinen, handle)
10117
10118 DO idir = 1, 3
10119 NULLIFY (drho(idir)%array)
10120 ALLOCATE (drho(idir)%array(lbound(drhoa(1)%array, 1):ubound(drhoa(1)%array, 1), &
10121 lbound(drhoa(1)%array, 2):ubound(drhoa(1)%array, 2), &
10122 lbound(drhoa(1)%array, 3):ubound(drhoa(1)%array, 3)))
10123!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(drho,drhoa,idir)
10124 drho(idir)%array(:, :, :) = drhoa(idir)%array(:, :, :)
10125!$OMP END PARALLEL WORKSHARE
10126 END DO
10127
10128 CALL timestop(handle)
10129
10130 END SUBROUTINE calc_drho_from_a
10131
10132! **************************************************************************************************
10133!> \brief allocates and calculates dot products of two density gradients
10134!> \param dr1dr ...
10135!> \param drho ...
10136!> \param drho1 ...
10137! **************************************************************************************************
10138 SUBROUTINE prepare_dr1dr(dr1dr, drho, drho1)
10139 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
10140 INTENT(OUT) :: dr1dr
10141 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drho, drho1
10142
10143 CHARACTER(len=*), PARAMETER :: routinen = 'prepare_dr1dr'
10144
10145 INTEGER :: handle, idir
10146
10147 CALL timeset(routinen, handle)
10148
10149 ALLOCATE (dr1dr(lbound(drho(1)%array, 1):ubound(drho(1)%array, 1), &
10150 lbound(drho(1)%array, 2):ubound(drho(1)%array, 2), &
10151 lbound(drho(1)%array, 3):ubound(drho(1)%array, 3)))
10152
10153!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dr1dr,drho,drho1)
10154 dr1dr(:, :, :) = drho(1)%array(:, :, :)*drho1(1)%array(:, :, :)
10155!$OMP END PARALLEL WORKSHARE
10156 DO idir = 2, 3
10157!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(dr1dr,drho,drho1,idir)
10158 dr1dr(:, :, :) = dr1dr(:, :, :) + drho(idir)%array(:, :, :)*drho1(idir)%array(:, :, :)
10159!$OMP END PARALLEL WORKSHARE
10160 END DO
10161
10162 CALL timestop(handle)
10163
10164 END SUBROUTINE prepare_dr1dr
10165
10166! **************************************************************************************************
10167!> \brief allocates and calculates dot product of two densities for triplets
10168!> \param dr1dr ...
10169!> \param drhoa ...
10170!> \param drhob ...
10171!> \param drho1a ...
10172!> \param drho1b ...
10173!> \param fac ...
10174! **************************************************************************************************
10175 SUBROUTINE prepare_dr1dr_ab(dr1dr, drhoa, drhob, drho1a, drho1b, fac)
10176 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
10177 INTENT(OUT) :: dr1dr
10178 TYPE(cp_3d_r_cp_type), DIMENSION(3), INTENT(IN) :: drhoa, drhob, drho1a, drho1b
10179 REAL(kind=dp), INTENT(IN) :: fac
10180
10181 CHARACTER(len=*), PARAMETER :: routinen = 'prepare_dr1dr_ab'
10182
10183 INTEGER :: handle, idir
10184
10185 CALL timeset(routinen, handle)
10186
10187 ALLOCATE (dr1dr(lbound(drhoa(1)%array, 1):ubound(drhoa(1)%array, 1), &
10188 lbound(drhoa(1)%array, 2):ubound(drhoa(1)%array, 2), &
10189 lbound(drhoa(1)%array, 3):ubound(drhoa(1)%array, 3)))
10190
10191!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(fac,dr1dr,drho1a,drho1b,drhoa,drhob)
10192 dr1dr(:, :, :) = drhoa(1)%array(:, :, :)*(drho1a(1)%array(:, :, :) + &
10193 fac*drho1b(1)%array(:, :, :)) + &
10194 drhob(1)%array(:, :, :)*(fac*drho1a(1)%array(:, :, :) + &
10195 drho1b(1)%array(:, :, :))
10196!$OMP END PARALLEL WORKSHARE
10197 DO idir = 2, 3
10198!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(fac,dr1dr,drho1a,drho1b,drhoa,drhob,idir)
10199 dr1dr(:, :, :) = dr1dr(:, :, :) + &
10200 drhoa(idir)%array(:, :, :)*(drho1a(idir)%array(:, :, :) + &
10201 fac*drho1b(idir)%array(:, :, :)) + &
10202 drhob(idir)%array(:, :, :)*(fac*drho1a(idir)%array(:, :, :) + &
10203 drho1b(idir)%array(:, :, :))
10204!$OMP END PARALLEL WORKSHARE
10205 END DO
10206
10207 CALL timestop(handle)
10208
10209 END SUBROUTINE prepare_dr1dr_ab
10210
10211! **************************************************************************************************
10212!> \brief checks for gradients
10213!> \param deriv_set ...
10214!> \param lsd ...
10215!> \param gradient_f ...
10216!> \param tau_f ...
10217!> \param laplace_f ...
10218! **************************************************************************************************
10219 SUBROUTINE check_for_derivatives(deriv_set, lsd, rho_f, gradient_f, tau_f, laplace_f)
10220 TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
10221 LOGICAL, INTENT(IN) :: lsd
10222 LOGICAL, INTENT(OUT) :: rho_f, gradient_f, tau_f, laplace_f
10223
10224 CHARACTER(len=*), PARAMETER :: routinen = 'check_for_derivatives'
10225
10226 INTEGER :: handle, iorder, order
10227 INTEGER, DIMENSION(:), POINTER :: split_desc
10228 TYPE(cp_sll_xc_deriv_type), POINTER :: pos
10229 TYPE(xc_derivative_type), POINTER :: deriv_att
10230
10231 CALL timeset(routinen, handle)
10232
10233 rho_f = .false.
10234 gradient_f = .false.
10235 tau_f = .false.
10236 laplace_f = .false.
10237 ! check for unknown derivatives
10238 pos => deriv_set%derivs
10239 DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
10240 CALL xc_derivative_get(deriv_att, order=order, &
10241 split_desc=split_desc)
10242 IF (lsd) THEN
10243 DO iorder = 1, size(split_desc)
10244 SELECT CASE (split_desc(iorder))
10245 CASE (deriv_rhoa, deriv_rhob)
10246 rho_f = .true.
10247 CASE (deriv_norm_drho, deriv_norm_drhoa, deriv_norm_drhob, &
10248 deriv_gamma_aa, deriv_gamma_ab, deriv_gamma_bb)
10249 gradient_f = .true.
10250 CASE (deriv_tau_a, deriv_tau_b)
10251 tau_f = .true.
10252 CASE (deriv_laplace_rhoa, deriv_laplace_rhob)
10253 laplace_f = .true.
10254 CASE (deriv_rho, deriv_tau, deriv_laplace_rho)
10255 cpabort("Derivative not handled in lsd!")
10256 CASE default
10257 cpabort("Unknown derivative id")
10258 END SELECT
10259 END DO
10260 ELSE
10261 DO iorder = 1, size(split_desc)
10262 SELECT CASE (split_desc(iorder))
10263 CASE (deriv_rho)
10264 rho_f = .true.
10265 CASE (deriv_tau)
10266 tau_f = .true.
10267 CASE (deriv_norm_drho, deriv_gamma)
10268 gradient_f = .true.
10269 CASE (deriv_laplace_rho)
10270 laplace_f = .true.
10271 CASE default
10272 cpabort("Unknown derivative id")
10273 END SELECT
10274 END DO
10275 END IF
10276 END DO
10277
10278 CALL timestop(handle)
10279
10280 END SUBROUTINE check_for_derivatives
10281
10282END MODULE xc
10283
static GRID_HOST_DEVICE double fac(const int i)
Factorial function, e.g. fac(5) = 5! = 120.
Definition grid_common.h:57
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)
...
calculates a functional from libxc and its derivatives
Definition xc_libxc.F:29
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:9863
subroutine, public divide_by_norm_drho(deriv_set, rho_set, lsd)
divides derivatives from deriv_set by norm_drho
Definition xc.F:9983
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:2060
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:1066
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:795
logical function, public xc_uses_norm_drho(xc_fun_section, lsd)
...
Definition xc.F:119
logical function, public xc_uses_kinetic_energy_density(xc_fun_section, lsd)
...
Definition xc.F:99
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:478
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:932
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:4739
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:861
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:9926
subroutine, public calc_xc_density(pot, rho, rho_cutoff)
Definition xc.F:406
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:246
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