(git:ccc2433)
xc_xwpbe.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 ! !
5 ! SPDX-License-Identifier: GPL-2.0-or-later !
6 !--------------------------------------------------------------------------------------------------!
7 
8 ! **************************************************************************************************
9 !> \brief Calculates short range exchange part for wPBE functional and averaged
10 !> PBE exchange-hole functional (omega = 0.0 )
11 !> \par History
12 !> Manuel Guidon (05.2007) : initial version
13 !> \author Manuel Guidon (05.2007)
14 ! **************************************************************************************************
15 MODULE xc_xwpbe
16  USE bibliography, ONLY: heyd2004,&
17  cite_reference
18  USE input_section_types, ONLY: section_vals_type,&
19  section_vals_val_get
20  USE kinds, ONLY: dp
21  USE mathconstants, ONLY: pi,&
22  rootpi
23  USE mathlib, ONLY: expint
24  USE xc_derivative_desc, ONLY: deriv_norm_drho,&
25  deriv_norm_drhoa,&
26  deriv_norm_drhob,&
27  deriv_rho,&
28  deriv_rhoa,&
29  deriv_rhob
30  USE xc_derivative_set_types, ONLY: xc_derivative_set_type,&
31  xc_dset_get_derivative
32  USE xc_derivative_types, ONLY: xc_derivative_get,&
33  xc_derivative_type
34  USE xc_rho_cflags_types, ONLY: xc_rho_cflags_type
35  USE xc_rho_set_types, ONLY: xc_rho_set_get,&
36  xc_rho_set_type
37 #include "../base/base_uses.f90"
38 
39  IMPLICIT NONE
40 
41  PRIVATE
42 
43 ! *** Global parameters ***
44 
45  PUBLIC :: xwpbe_lda_info, xwpbe_lda_eval, xwpbe_lsd_info, &
46  xwpbe_lsd_eval
47 
48  REAL(KIND=dp), PARAMETER :: alpha1 = -1.128223946706117_dp, &
49  alpha2 = 1.452736265762971_dp, &
50  alpha3 = -1.243162299390327_dp, &
51  alpha4 = 0.971824836115601_dp, &
52  alpha5 = -0.568861079687373_dp, &
53  alpha6 = 0.246880514820192_dp, &
54  alpha7 = -0.065032363850763_dp, &
55  alpha8 = 0.008401793031216_dp
56  REAL(KIND=dp), PARAMETER :: beta = 1.455915450052607_dp, &
57  beta2 = 2.0_dp
58  REAL(KIND=dp), PARAMETER :: a1 = 0.00979681_dp, &
59  a2 = 0.04108340_dp, &
60  a3 = 0.18744000_dp, &
61  a4 = 0.00120824_dp, &
62  a5 = 0.0347188_dp
63  REAL(KIND=dp), PARAMETER :: a = 1.0161144_dp, &
64  b = -0.37170836_dp, &
65  c = -0.077215461_dp, &
66  dd = 0.57786348_dp, &
67  e = -0.051955731_dp, &
68  f1 = 0.47965830_dp, &
69  f2 = 6.4753871_dp, &
70  clda = -0.73855876638202240588423_dp
71  REAL(KIND=dp), PARAMETER :: expcutoff = 700.0_dp, &
72  exei1 = 4.0364_dp, &
73  exei2 = 1.15198_dp, &
74  exei3 = 5.03627_dp, &
75  exei4 = 4.19160_dp
76  REAL(KIND=dp), PARAMETER :: smax = 8.572844_dp, &
77  sconst = 18.79622316_dp, &
78  scutoff = 8.3_dp
79  REAL(KIND=dp), PARAMETER :: gcutoff = 0.08_dp, &
80  g1 = -0.02628417880_dp/e, &
81  g2 = -0.07117647788_dp/e, &
82  g3 = 0.08534541323_dp/e, &
83  g4 = 0.0_dp
84  REAL(KIND=dp), PARAMETER :: wcutoff = 14.0_dp
85  REAL(KIND=dp), PARAMETER :: f12 = 0.5_dp, f14 = 0.25_dp, f158 = 15.0_dp/8.0_dp, &
86  f1516 = 15.0_dp/16.0_dp, f24364 = 243.0_dp/64.0_dp, &
87  f2716 = 27.0_dp/16.0_dp, f2732 = 27.0_dp/32.0_dp, &
88  f34 = 0.75_dp, f32 = 1.5_dp, f38 = 0.375_dp, f68 = 0.75_dp, &
89  f6561512 = 6561.0_dp/512.0_dp, f8132 = 81.0_dp/32.0_dp, &
90  f8164 = 81.0_dp/64.0_dp, f729128 = 729.0_dp/128.0_dp, &
91  f52 = 2.5_dp, f94 = 9.0_dp/4.0_dp, f916 = 9.0_dp/16.0_dp, &
92  f89 = 8.0_dp/9.0_dp, f2187256 = 2187.0_dp/256.0_dp, &
93  r1 = 1.0_dp, f98 = 9.0_dp/8.0_dp, r15 = 15.0_dp, &
94  r3 = 3.0_dp, r4 = 4.0_dp, r16 = 16.0_dp, r8 = 8.0_dp, &
95  r6 = 6.0_dp, r2 = 2.0_dp
96 
97  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc_xwpbe'
98 
99 CONTAINS
100 
101 ! **************************************************************************************************
102 !> \brief return various information on the functional
103 !> \param reference string with the reference of the actual functional
104 !> \param shortform string with the shortform of the functional name
105 !> \param needs the components needed by this functional are set to
106 !> true (does not set the unneeded components to false)
107 !> \param max_deriv ...
108 !> \par History
109 !> 05.2007 created [Manuel Guidon]
110 !> \author Manuel Guidon
111 ! **************************************************************************************************
112  SUBROUTINE xwpbe_lda_info(reference, shortform, needs, max_deriv)
113  CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: reference, shortform
114  TYPE(xc_rho_cflags_type), INTENT(inout), OPTIONAL :: needs
115  INTEGER, INTENT(out), OPTIONAL :: max_deriv
116 
117  IF (PRESENT(reference)) THEN
118  reference = "Jochen Heyd and Gustavo E. Scuseria, J. Chem. Phys., 120, 7274 {LDA version}"
119  END IF
120  IF (PRESENT(shortform)) THEN
121  shortform = "shortrange part of PBE exchange {LDA}"
122  END IF
123  IF (PRESENT(needs)) THEN
124  needs%rho = .true.
125  needs%norm_drho = .true.
126  END IF
127  ! deriv > 1 are not correct
128  ! IF (PRESENT(max_deriv)) max_deriv = 2
129  IF (PRESENT(max_deriv)) max_deriv = 1
130  END SUBROUTINE xwpbe_lda_info
131 
132 ! **************************************************************************************************
133 !> \brief evaluates the screened hole averaged PBE exchange functional for lda
134 !> \param rho_set the density where you want to evaluate the functional
135 !> \param deriv_set place where to store the functional derivatives (they are
136 !> added to the derivatives)
137 !> \param order degree of the derivative that should be evaluated,
138 !> if positive all the derivatives up to the given degree are evaluated,
139 !> if negative only the given degree is calculated
140 !> \param xwpbe_params input parameters (scaling,omega)
141 !> \par History
142 !> 05.2007 created [Manuel Guidon]
143 !> \author Manuel Guidon
144 !> \note
145 !> The current version provides code for derivatives up to second order.
146 !> Using the maple sheet in cp2k/doc it is straightforward to produce routines
147 !> for higher derivatives.
148 ! **************************************************************************************************
149  SUBROUTINE xwpbe_lda_eval(rho_set, deriv_set, order, xwpbe_params)
150 
151  TYPE(xc_rho_set_type), INTENT(IN) :: rho_set
152  TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
153  INTEGER, INTENT(IN) :: order
154  TYPE(section_vals_type), POINTER :: xwpbe_params
155 
156  CHARACTER(len=*), PARAMETER :: routinen = 'xwpbe_lda_eval'
157 
158  INTEGER :: handle, npoints
159  INTEGER, DIMENSION(2, 3) :: bo
160  REAL(kind=dp) :: epsilon_norm_drho, epsilon_rho, omega, &
161  sx, sx0
162  REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :, :), &
163  POINTER :: dummy, e_0, e_ndrho, e_ndrho_ndrho, &
164  e_ndrho_rho, e_rho, e_rho_rho, &
165  norm_drho, rho
166  TYPE(xc_derivative_type), POINTER :: deriv
167 
168  CALL timeset(routinen, handle)
169 
170  CALL cite_reference(heyd2004)
171 
172  CALL section_vals_val_get(xwpbe_params, "SCALE_X", r_val=sx)
173  CALL section_vals_val_get(xwpbe_params, "SCALE_X0", r_val=sx0)
174  CALL section_vals_val_get(xwpbe_params, "OMEGA", r_val=omega)
175 
176  CALL xc_rho_set_get(rho_set, rho=rho, &
177  norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho, &
178  drho_cutoff=epsilon_norm_drho)
179  npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1)
180 
181  dummy => rho
182 
183  e_0 => dummy
184  e_rho => dummy
185  e_ndrho => dummy
186  e_rho_rho => dummy
187  e_ndrho_rho => dummy
188  e_ndrho_ndrho => dummy
189 
190  IF (order >= 0) THEN
191  deriv => xc_dset_get_derivative(deriv_set, [INTEGER::], &
192  allocate_deriv=.true.)
193  CALL xc_derivative_get(deriv, deriv_data=e_0)
194  END IF
195  IF (order >= 1 .OR. order == -1) THEN
196  deriv => xc_dset_get_derivative(deriv_set, [deriv_rho], &
197  allocate_deriv=.true.)
198  CALL xc_derivative_get(deriv, deriv_data=e_rho)
199  deriv => xc_dset_get_derivative(deriv_set, [deriv_norm_drho], &
200  allocate_deriv=.true.)
201  CALL xc_derivative_get(deriv, deriv_data=e_ndrho)
202  END IF
203  IF (order >= 2 .OR. order == -2) THEN
204  cpabort("derivatives bigger than 1 do not work correctly")
205  deriv => xc_dset_get_derivative(deriv_set, [deriv_rho, deriv_rho], &
206  allocate_deriv=.true.)
207  CALL xc_derivative_get(deriv, deriv_data=e_rho_rho)
208  deriv => xc_dset_get_derivative(deriv_set, [deriv_norm_drho, deriv_rho], &
209  allocate_deriv=.true.)
210  CALL xc_derivative_get(deriv, deriv_data=e_ndrho_rho)
211  deriv => xc_dset_get_derivative(deriv_set, &
212  [deriv_norm_drho, deriv_norm_drho], allocate_deriv=.true.)
213  CALL xc_derivative_get(deriv, deriv_data=e_ndrho_ndrho)
214  END IF
215  IF (order > 1 .OR. order < -1) THEN
216  cpabort("derivatives bigger than 1 do not work correctly")
217  END IF
218  IF (order > 2 .OR. order < -2) THEN
219  cpabort("derivatives bigger than 2 not implemented")
220  END IF
221 
222 !$OMP PARALLEL DEFAULT(NONE) &
223 !$OMP SHARED(npoints, order, rho, norm_drho, e_0, e_rho, e_ndrho) &
224 !$OMP SHARED(e_rho_rho, e_ndrho_rho, e_ndrho_ndrho, epsilon_rho) &
225 !$OMP SHARED(sx, sx0, omega)
226 
227  CALL xwpbe_lda_calc(npoints, order, rho=rho, norm_drho=norm_drho, &
228  e_0=e_0, e_rho=e_rho, e_ndrho=e_ndrho, e_rho_rho=e_rho_rho, &
229  e_ndrho_rho=e_ndrho_rho, e_ndrho_ndrho=e_ndrho_ndrho, &
230  epsilon_rho=epsilon_rho, sx=sx, sx0=sx0, omega=omega)
231 
232 !$OMP END PARALLEL
233 
234  CALL timestop(handle)
235 
236  END SUBROUTINE xwpbe_lda_eval
237 
238 ! **************************************************************************************************
239 !> \brief evaluates the screened hole averaged PBE exchange functional for lda
240 !> \param npoints ...
241 !> \param order degree of the derivative that should be evaluated,
242 !> if positive all the derivatives up to the given degree are evaluated,
243 !> if negative only the given degree is calculated
244 !> \param rho , ndrho: density and norm of the density gradient
245 !> \param norm_drho ...
246 !> \param e_0 ...
247 !> \param e_rho ...
248 !> \param e_ndrho ...
249 !> \param e_rho_rho ...
250 !> \param e_ndrho_rho ...
251 !> \param e_ndrho_ndrho ...
252 !> \param epsilon_rho ...
253 !> \param sx , sx0: scaling factor for omega!=0 and omega=0
254 !> \param sx0 ...
255 !> \param omega screening parameter
256 !> \par History
257 !> 05.2007 created [Manuel Guidon]
258 !> \author Manuel Guidon
259 !> \note
260 !> In order to avoid numerical instabilities, this routine calls different
261 !> subroutines. There are 4 routines for the case omega!=0 and 2 routines
262 !> for omega=0.
263 ! **************************************************************************************************
264  SUBROUTINE xwpbe_lda_calc(npoints, order, rho, norm_drho, e_0, e_rho, e_ndrho, &
265  e_rho_rho, e_ndrho_rho, e_ndrho_ndrho, &
266  epsilon_rho, sx, sx0, omega)
267 
268  INTEGER, INTENT(in) :: npoints, order
269  REAL(kind=dp), DIMENSION(1:npoints), INTENT(inout) :: rho, norm_drho, e_0, e_rho, e_ndrho, &
270  e_rho_rho, e_ndrho_rho, e_ndrho_ndrho
271  REAL(kind=dp), INTENT(in) :: epsilon_rho, sx, sx0, omega
272 
273  INTEGER :: ip
274  REAL(dp) :: my_ndrho, my_rho
275  REAL(kind=dp) :: ss, ss2, sscale, t1, t2, t3, t4, t5, t6, &
276  t7, t8, ww
277 
278 !$OMP DO
279 
280  DO ip = 1, npoints
281  my_rho = max(rho(ip), 0.0_dp)
282  IF (my_rho > epsilon_rho) THEN
283  my_ndrho = max(norm_drho(ip), 0.0_dp)
284 
285  !Do some precalculation in order to catch the correct branch afterwards
286  sscale = 1.0_dp
287  t1 = pi**2
288  t2 = t1*my_rho
289  t3 = t2**(0.1e1_dp/0.3e1_dp)
290  t4 = 0.1e1_dp/t3
291  t5 = omega*t4
292  ww = 0.6933612743506347048433524e0_dp*t5
293  t6 = my_ndrho*t4
294  t7 = 0.1e1_dp/my_rho
295  t8 = t7*sscale
296  ss = 0.3466806371753173524216762e0_dp*t6*t8
297  IF (ss > scutoff) THEN
298  ss2 = ss*ss
299  sscale = (smax*ss2 - sconst)/(ss2*ss)
300  END IF
301 
302  IF (sx0 /= 0.0_dp) THEN
303  !original PBE hole
304  IF (ss*sscale > gcutoff) THEN
305  CALL xwpbe_lda_calc_0(e_0(ip), e_rho(ip), e_ndrho(ip), e_rho_rho(ip), &
306  e_ndrho_rho(ip), e_ndrho_ndrho(ip), my_rho, &
307  my_ndrho, sscale, sx0, order)
308  ELSE
309  CALL xwpbe_lda_calc_01(e_0(ip), e_rho(ip), e_ndrho(ip), e_rho_rho(ip), &
310  e_ndrho_rho(ip), e_ndrho_ndrho(ip), my_rho, &
311  my_ndrho, sscale, sx0, order)
312  END IF
313  END IF
314 
315  IF (sx /= 0.0_dp) THEN
316  IF (ww < wcutoff .AND. ss*sscale > gcutoff) THEN
317  CALL xwpbe_lda_calc_1(e_0(ip), e_rho(ip), e_ndrho(ip), e_rho_rho(ip), &
318  e_ndrho_rho(ip), e_ndrho_ndrho(ip), my_rho, &
319  my_ndrho, omega, sscale, sx, order)
320  ELSE IF (ww < wcutoff .AND. ss*sscale <= gcutoff) THEN
321  CALL xwpbe_lda_calc_2(e_0(ip), e_rho(ip), e_ndrho(ip), e_rho_rho(ip), &
322  e_ndrho_rho(ip), e_ndrho_ndrho(ip), my_rho, &
323  my_ndrho, omega, sscale, sx, order)
324  ELSE IF (ww >= wcutoff .AND. ss*sscale > gcutoff) THEN
325  CALL xwpbe_lda_calc_3(e_0(ip), e_rho(ip), e_ndrho(ip), e_rho_rho(ip), &
326  e_ndrho_rho(ip), e_ndrho_ndrho(ip), my_rho, &
327  my_ndrho, omega, sscale, sx, order)
328  ELSE
329  CALL xwpbe_lda_calc_4(e_0(ip), e_rho(ip), e_ndrho(ip), e_rho_rho(ip), &
330  e_ndrho_rho(ip), e_ndrho_ndrho(ip), my_rho, &
331  my_ndrho, omega, sscale, sx, order)
332  END IF
333  END IF
334  END IF
335  END DO
336 
337 !$OMP END DO
338 
339  END SUBROUTINE xwpbe_lda_calc
340 
341 ! **************************************************************************************************
342 !> \brief Evaluates the screened hole averaged PBE exchange functional for lda
343 !> \param e_0 ...
344 !> \param e_rho ...
345 !> \param e_ndrho ...
346 !> \param e_rho_rho ...
347 !> \param e_ndrho_rho ...
348 !> \param e_ndrho_ndrho ...
349 !> \param rho , ndrho: density and norm of the density gradient
350 !> \param ndrho ...
351 !> \param sscale scaling factor to enforce Lieb-Oxford bound
352 !> \param sx0 scaling factor
353 !> \param order degree of the derivative that should be evaluated,
354 !> if positive all the derivatives up to the given degree are evaluated,
355 !> if negative only the given degree is calculated
356 !> \par History
357 !> 05.2007 created [Manuel Guidon]
358 !> \author Manuel Guidon
359 !> \note
360 !> This routine evaluates the exact functional for omega=0.
361 ! **************************************************************************************************
362  SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, &
363  e_ndrho_ndrho, rho, ndrho, sscale, sx0, order)
364  REAL(kind=dp), INTENT(INOUT) :: e_0, e_rho, e_ndrho, e_rho_rho, &
365  e_ndrho_rho, e_ndrho_ndrho
366  REAL(kind=dp), INTENT(IN) :: rho, ndrho, sscale, sx0
367  INTEGER, INTENT(IN) :: order
368 
369  REAL(kind=dp) :: d2qndrhondrho, d2qrhondrho, d2qrhorho, dqndrho, dqrho, q, t1, t10, t100, &
370  t1003, t1007, t1018, t1023, t1024, t103, t1037, t105, t1055, t1056, t1057, t1059, t106, &
371  t1060, t1073, t1079, t1082, t109, t11, t110, t1100, t111, t1110, t1114, t1117, t112, &
372  t114, t1143, t116, t1165, t117, t118, t119, t12, t120, t1202, t121, t1215, t122, t123, &
373  t1242, t125, t1258, t126, t1263, t127, t1286, t13, t130, t1316, t134, t1347, t135, t1352, &
374  t1358, t136, t1362, t1365, t1369, t1372, t138, t1382, t1388, t139, t1392, t1395, t14, &
375  t1412, t142, t143, t145, t1455, t146, t1465, t147, t148, t149, t15
376  REAL(kind=dp) :: t150, t1510, t152, t1547, t156, t1561, t158, t159, t16, t160, t163, t164, &
377  t165, t166, t169, t170, t172, t173, t174, t175, t176, t18, t180, t183, t184, t185, t187, &
378  t188, t19, t190, t191, t192, t193, t199, t2, t20, t200, t201, t202, t203, t207, t209, &
379  t21, t215, t218, t219, t22, t220, t222, t223, t224, t225, t227, t228, t231, t233, t236, &
380  t237, t24, t240, t241, t242, t245, t246, t247, t249, t25, t250, t253, t254, t258, t26, &
381  t261, t262, t263, t265, t266, t269, t272, t274, t275, t278, t28, t281, t282, t284, t285, &
382  t287, t288, t29, t290, t291, t294, t297, t3, t300, t301, t303
383  REAL(kind=dp) :: t304, t306, t307, t31, t314, t32, t321, t323, t326, t327, t33, t330, t334, &
384  t335, t336, t337, t338, t339, t34, t340, t342, t343, t344, t345, t347, t355, t356, t357, &
385  t358, t359, t36, t361, t362, t363, t367, t368, t37, t372, t374, t376, t377, t381, t383, &
386  t384, t387, t388, t39, t390, t391, t394, t397, t398, t4, t40, t400, t401, t402, t404, &
387  t405, t406, t408, t409, t410, t411, t412, t413, t414, t415, t416, t417, t418, t42, t423, &
388  t425, t426, t429, t430, t432, t433, t435, t44, t440, t443, t444, t446, t447, t449, t46, &
389  t463, t465, t47, t471, t472, t475, t476, t478, t479, t480, t484
390  REAL(kind=dp) :: t485, t489, t491, t495, t497, t5, t500, t501, t504, t505, t507, t508, t510, &
391  t511, t513, t514, t515, t52, t520, t53, t530, t537, t54, t540, t542, t546, t550, t553, &
392  t557, t56, t566, t569, t570, t577, t579, t58, t59, t6, t61, t616, t620, t621, t627, t628, &
393  t63, t632, t647, t65, t655, t657, t66, t663, t67, t678, t68, t685, t69, t7, t70, t707, &
394  t71, t716, t72, t73, t735, t74, t744, t751, t755, t76, t761, t77, t778, t78, t784, t788, &
395  t79, t791, t8, t80, t81, t819, t824, t83, t84, t854, t856, t857, t86, t867, t872, t875, &
396  t878, t88, t887, t888, t889, t89, t9, t905, t91, t910, t911
397  REAL(kind=dp) :: t92, t923, t924, t93, t930, t933, t94, t95, t952, t956, t968, t97, t975, &
398  t98, t983
399 
400  IF (order >= 0) THEN
401  t1 = ndrho**2
402  t2 = a1*t1
403  t3 = r2**2
404  t4 = 0.1e1_dp/t3
405  t5 = t2*t4
406  t6 = pi**2
407  t7 = r3*t6
408  t8 = t7*rho
409  t9 = t8**(0.1e1_dp/0.3e1_dp)
410  t10 = t9**2
411  t11 = 0.1e1_dp/t10
412  t12 = rho**2
413  t13 = 0.1e1_dp/t12
414  t14 = t11*t13
415  t15 = sscale**2
416  t16 = t14*t15
417  t18 = t1**2
418  t19 = a2*t18
419  t20 = t3**2
420  t21 = 0.1e1_dp/t20
421  t22 = t19*t21
422  t24 = 0.1e1_dp/t9/t8
423  t25 = t12**2
424  t26 = 0.1e1_dp/t25
425  t28 = t15**2
426  t29 = t24*t26*t28
427  t31 = t5*t16 + t22*t29
428  t32 = f94*t31
429  t33 = a3*t18
430  t34 = t33*t21
431  t36 = t18*ndrho
432  t37 = a4*t36
433  t39 = 0.1e1_dp/t20/r2
434  t40 = t37*t39
435  t42 = 0.1e1_dp/t10/t8
436  t44 = 0.1e1_dp/t25/rho
437  t46 = t28*sscale
438  t47 = t42*t44*t46
439  t52 = 0.1e1_dp/t20/t3
440  t53 = a5*t18*t1*t52
441  t54 = r3**2
442  t56 = t6**2
443  t58 = 0.1e1_dp/t54/t56
444  t59 = t25**2
445  t61 = t28*t15
446  t63 = t58/t59*t61
447  t65 = r1 + t34*t29 + t40*t47 + t53*t63
448  t66 = 0.1e1_dp/t65
449  t67 = t66*t1
450  t68 = t32*t67
451  t69 = t4*t11
452  t70 = t13*t15
453  t71 = 0.1e1_dp/a
454  t72 = t70*t71
455  t73 = t69*t72
456  q = t68*t73
457  t74 = rho**(0.1e1_dp/0.3e1_dp)
458  t76 = t74*rho*f89
459  t77 = b*f12
460  t78 = t1*t4
461  t79 = t78*t11
462  t80 = t31*t66
463  t81 = t70*t80
464  t83 = t79*t81 + dd
465  t84 = 0.1e1_dp/t83
466  t86 = f2*t31
467  t88 = f1 + t86*t66
468  t89 = t70*t88
469  t91 = t79*t89 + r1
470  t92 = f12*t91
471  t93 = t83**2
472  t94 = 0.1e1_dp/t93
473  t95 = c*t94
474  t97 = f34*pi
475  t98 = rootpi
476  t100 = r6*c
477  t103 = r4*b
478  t105 = r8*a
479  t106 = t93*t83
480  t109 = t98*(r15*e + t100*t91*t83 + t103*t93 + t105*t106)
481  t110 = 0.1e1_dp/r16
482  t111 = sqrt(t83)
483  t112 = t111*t106
484  t114 = t110/t112
485  t116 = sqrt(a)
486  t117 = exp(q)
487  t118 = t116*t117
488  t119 = f32*ndrho
489  t120 = 0.1e1_dp/r2
490  t121 = t119*t120
491  t122 = 0.1e1_dp/t9
492  t123 = 0.1e1_dp/rho
493  t125 = t80*t71
494  t126 = sqrt(t125)
495  t127 = sscale*t126
496  t130 = erfc(t121*t122*t123*t127)
497  t134 = 0.1e1_dp/f1516
498  t135 = (t97 + t109*t114 - t97*t118*t130)*t134
499  t136 = 0.1e1_dp/t98
500  t138 = 0.1e1_dp/e
501  t139 = t136*t112*t138
502  t142 = (-t135*t139 + r1)*e
503  t143 = 0.1e1_dp/t106
504  t145 = f12*a
505  t146 = exei(q)
506  t147 = t78*t14
507  t148 = t15*t31
508  t149 = t66*t84
509  t150 = t148*t149
510  t152 = log(t147*t150)
511  t156 = (t77*t84 + t92*t95 + t142*t143 + t145*(t146 + t152)) &
512  *clda
513  e_0 = e_0 + (-t76*t156)*sx0
514  END IF
515  IF (order >= 1 .OR. order == -1) THEN
516  t158 = t4*t42
517  t159 = t2*t158
518  t160 = t70*t7
519  t163 = t12*rho
520  t164 = 0.1e1_dp/t163
521  t165 = t11*t164
522  t166 = t165*t15
523  t169 = t54*t56
524  t170 = t169*t12
525  t172 = 0.1e1_dp/t9/t170
526  t173 = t21*t172
527  t174 = t19*t173
528  t175 = t26*t28
529  t176 = t175*t7
530  t180 = t24*t44*t28
531  t183 = -0.2e1_dp/0.3e1_dp*t159*t160 - (2._dp*t5*t166) - 0.4e1_dp/ &
532  0.3e1_dp*t174*t176 - (4._dp*t22*t180)
533  t184 = f94*t183
534  t185 = t184*t67
535  t187 = t65**2
536  t188 = 0.1e1_dp/t187
537  t190 = t188*t1*t4
538  t191 = t32*t190
539  t192 = t15*t71
540  t193 = t33*t173
541  t199 = 0.1e1_dp/t10/t170
542  t200 = t39*t199
543  t201 = t37*t200
544  t202 = t44*t46
545  t203 = t202*t7
546  t207 = 0.1e1_dp/t25/t12
547  t209 = t42*t207*t46
548  t215 = t58/t59/rho*t61
549  t218 = -0.4e1_dp/0.3e1_dp*t193*t176 - (4._dp*t34*t180) - 0.5e1_dp &
550  /0.3e1_dp*t201*t203 - (5._dp*t40*t209) - (8._dp*t53*t215)
551  t219 = t192*t218
552  t220 = t14*t219
553  t222 = t67*t4
554  t223 = t32*t222
555  t224 = t42*t13
556  t225 = t224*t15
557  t227 = t71*r3*t6
558  t228 = t225*t227
559  t231 = t164*t15
560  t233 = t69*t231*t71
561  dqrho = t185*t73 - t191*t220 - 0.2e1_dp/0.3e1_dp*t223*t228 - (2._dp &
562  *t68*t233)
563  t236 = a1*ndrho
564  t237 = t236*t4
565  t240 = t1*ndrho
566  t241 = a2*t240
567  t242 = t241*t21
568  t245 = 2._dp*t237*t16 + 4._dp*t242*t29
569  t246 = f94*t245
570  t247 = t246*t67
571  t249 = a3*t240
572  t250 = t249*t21
573  t253 = a4*t18
574  t254 = t253*t39
575  t258 = a5*t36*t52
576  t261 = 4._dp*t250*t29 + 5._dp*t254*t47 + 6._dp*t258*t63
577  t262 = t192*t261
578  t263 = t14*t262
579  t265 = t66*ndrho
580  t266 = t32*t265
581  dqndrho = t247*t73 - t191*t263 + 2._dp*t266*t73
582  t269 = t74*f89
583  t272 = t78*t224
584  t274 = t66*r3*t6
585  t275 = t148*t274
586  t278 = t231*t80
587  t281 = t183*t66
588  t282 = t70*t281
589  t284 = t188*t218
590  t285 = t148*t284
591  t287 = -0.2e1_dp/0.3e1_dp*t272*t275 - (2._dp*t79*t278) + (t79 &
592  *t282) - t147*t285
593  t288 = t94*t287
594  t290 = t15*t88
595  t291 = t290*t7
596  t294 = t231*t88
597  t297 = f2*t183
598  t300 = t297*t66 - t86*t284
599  t301 = t70*t300
600  t303 = -0.2e1_dp/0.3e1_dp*t272*t291 - (2._dp*t79*t294) + (t79 &
601  *t301)
602  t304 = f12*t303
603  t306 = c*t143
604  t307 = t306*t287
605  t314 = t83*t287
606  t321 = t98*(t100*t303*t83 + t100*t91*t287 + 2._dp*t103*t314 &
607  + 3._dp*t105*t93*t287)
608  t323 = t93**2
609  t326 = t110/t111/t323
610  t327 = t326*t287
611  t330 = t97*t116
612  t334 = rootpi
613  t335 = 0.1e1_dp/t334
614  t336 = t117*t335
615  t337 = f32**2
616  t338 = t337*t1
617  t339 = t338*t69
618  t340 = t70*t125
619  t342 = exp(-t339*t340)
620  t343 = t120*t24
621  t344 = t119*t343
622  t345 = t123*sscale
623  t347 = t126*r3*t6
624  t355 = t119*t120*t122
625  t356 = 0.1e1_dp/t126
626  t357 = t281*t71
627  t358 = t31*t188
628  t359 = t71*t218
629  t361 = t357 - t358*t359
630  t362 = t356*t361
631  t363 = t345*t362
632  t367 = t342*(-t344*t345*t347/0.3e1_dp - t121*t122*t13*t127 &
633  + t355*t363/0.2e1_dp)
634  t368 = t336*t367
635  t372 = (t321*t114 - 0.7e1_dp/0.2e1_dp*t109*t327 - (t330*dqrho &
636  *t117*t130) + (2._dp*t330*t368))*t134
637  t374 = t135*t136
638  t376 = t111*t93*t138
639  t377 = t376*t287
640  t381 = (-t372*t139 - 0.7e1_dp/0.2e1_dp*t374*t377)*e
641  t383 = 0.1e1_dp/t323
642  t384 = t383*t287
643  t387 = dexeirho(q, dqrho)
644  t388 = t78*t225
645  t390 = t84*r3*t6
646  t391 = t80*t390
647  t394 = t78*t165
648  t397 = t15*t183
649  t398 = t397*t149
650  t400 = t188*t84
651  t401 = t400*t218
652  t402 = t148*t401
653  t404 = t66*t94
654  t405 = t404*t287
655  t406 = t148*t405
656  t408 = -0.2e1_dp/0.3e1_dp*t388*t391 - (2._dp*t394*t150) + t147 &
657  *t398 - t147*t402 - t147*t406
658  t409 = 0.1e1_dp/t1
659  t410 = t408*t409
660  t411 = t3*t10
661  t412 = t410*t411
662  t413 = 0.1e1_dp/t15
663  t414 = t12*t413
664  t415 = 0.1e1_dp/t31
665  t416 = t415*t65
666  t417 = t416*t83
667  t418 = t414*t417
668  t423 = (-t77*t288 + t304*t95 - 2._dp*t92*t307 + t381*t143 - 3._dp &
669  *t142*t384 + t145*(t387 + t412*t418))*clda
670  e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t269*t156 - t76*t423)*sx0
671  t425 = ndrho*t4
672  t426 = t425*t11
673  t429 = t245*t66
674  t430 = t70*t429
675  t432 = t188*t261
676  t433 = t148*t432
677  t435 = 2._dp*t426*t81 + t79*t430 - t147*t433
678  t440 = f2*t245
679  t443 = t440*t66 - t86*t432
680  t444 = t70*t443
681  t446 = 2._dp*t426*t89 + t79*t444
682  t447 = f12*t446
683  t449 = t306*t435
684  t463 = t98*(t100*t446*t83 + t100*t91*t435 + 2._dp*t103*t83 &
685  *t435 + 3._dp*t105*t93*t435)
686  t465 = t326*t435
687  t471 = f32*t120
688  t472 = t471*t122
689  t475 = t429*t71
690  t476 = t71*t261
691  t478 = t475 - t358*t476
692  t479 = t356*t478
693  t480 = t345*t479
694  t484 = t342*(t472*t345*t126 + t355*t480/0.2e1_dp)
695  t485 = t336*t484
696  t489 = (t463*t114 - 0.7e1_dp/0.2e1_dp*t109*t465 - (t330*dqndrho &
697  *t117*t130) + (2._dp*t330*t485))*t134
698  t491 = t376*t435
699  t495 = (-t489*t139 - 0.7e1_dp/0.2e1_dp*t374*t491)*e
700  t497 = t383*t435
701  t500 = dexeindrho(q, dqndrho)
702  t501 = t425*t14
703  t504 = t15*t245
704  t505 = t504*t149
705  t507 = t400*t261
706  t508 = t148*t507
707  t510 = t404*t435
708  t511 = t148*t510
709  t513 = 2._dp*t501*t150 + t147*t505 - t147*t508 - t147*t511
710  t514 = t513*t409
711  t515 = t514*t411
712  t520 = (-t77*t94*t435 + t447*t95 - 2._dp*t92*t449 + t495*t143 &
713  - 3._dp*t142*t497 + t145*(t500 + t515*t418))*clda
714  e_ndrho = e_ndrho + (-t76*t520)*sx0
715  END IF
716  IF (order >= 2 .OR. order == -2) THEN
717  t530 = t11*t26
718  t537 = t54*r3*t56*t6*t163
719  t540 = t21/t9/t537
720  t542 = t175*t169
721  t546 = t44*t28*t7
722  t550 = t24*t207*t28
723  t553 = 0.10e2_dp/0.9e1_dp*t2*t4*t199*t70*t169 + 0.8e1_dp/0.3e1_dp &
724  *t159*t231*t7 + (6._dp*t5*t530*t15) + 0.28e2_dp/0.9e1_dp* &
725  t19*t540*t542 + 0.32e2_dp/0.3e1_dp*t174*t546 + (20._dp*t22 &
726  *t550)
727  t557 = t184*t190
728  t566 = 0.1e1_dp/t187/t65
729  t569 = t32*t566*t1*t4
730  t570 = t218**2
731  t577 = t32*t188*t78*t42
732  t579 = t218*r3*t6
733  t616 = 0.28e2_dp/0.9e1_dp*t33*t540*t542 + 0.32e2_dp/0.3e1_dp*t193* &
734  t546 + (20._dp*t34*t550) + 0.40e2_dp/0.9e1_dp*t37*t39/t10/ &
735  t537*t202*t169 + 0.50e2_dp/0.3e1_dp*t201*t207*t46*t7 + 0.30e2_dp &
736  *t40*t42/t25/t163*t46 + (72._dp*t53*t58/t59/ &
737  t12*t61)
738  t620 = t199*t13
739  t621 = t620*t15
740  t627 = t42*t164
741  t628 = t627*t15
742  t632 = t26*t15
743  d2qrhorho = f94*t553*t67*t73 - (2._dp*t557*t220) - 0.4e1_dp/0.3e1_dp &
744  *t184*t222*t228 - (4._dp*t185*t233) + (2._dp*t569*t14 &
745  *t192*t570) + 0.4e1_dp/0.3e1_dp*t577*t72*t579 + (4._dp*t191 &
746  *t165*t219) - (t191*t14*t192*t616) + 0.10e2_dp/0.9e1_dp &
747  *t223*t621*t71*t54*t56 + 0.8e1_dp/0.3e1_dp*t223*t628* &
748  t227 + 0.6e1_dp*t68*t69*t632*t71
749  t647 = -0.4e1_dp/0.3e1_dp*t236*t158*t160 - (4._dp*t237*t166) &
750  - 0.16e2_dp/0.3e1_dp*t241*t173*t176 - (16._dp*t242*t180)
751  t655 = t246*t190
752  t657 = t359*t261
753  t663 = t32*t188*ndrho*t4
754  t678 = -0.16e2_dp/0.3e1_dp*t249*t173*t176 - (16._dp*t250*t180) &
755  - 0.25e2_dp/0.3e1_dp*t253*t200*t203 - (25._dp*t254*t209) - &
756  (48._dp*t258*t215)
757  t685 = t7*t261
758  d2qrhondrho = (f94*t647*t67*t73) - t557*t263 + (2._dp*t184* &
759  t265*t73) - (t655*t220) + (2._dp*t569*t16*t657) - (2._dp &
760  *t663*t220) - (t191*t14*t192*t678) - 0.2e1_dp/0.3e1_dp &
761  *t246*t222*t228 + 0.2e1_dp/0.3e1_dp*t577*t72*t685 - 0.4e1_dp &
762  /0.3e1_dp*t32*(t265)*t4*t228 - (2._dp*t247*t233) + &
763  (2._dp*t191*t165*t262) - (4._dp*t266*t233)
764  t707 = 2._dp*a1*t4*t16 + 12._dp*a2*t1*t21*t29
765  t716 = t261**2
766  t735 = 12._dp*a3*t1*t21*t29 + 20._dp*a4*t240*t39*t47 + 30._dp* &
767  a5*t18*t52*t63
768  d2qndrhondrho = f94*t707*t67*t73 - 2._dp*t655*t263 + 4._dp*t246*t265* &
769  t73 + 2._dp*t569*t14*t192*t716 - 4._dp*t663*t263 - t191*t14 &
770  *t192*t735 + 2._dp*t32*t66*t4*t14*t192
771  t744 = t74**2
772  t751 = t287**2
773  t755 = t78*t620
774  t761 = t78*t627
775  t778 = t553*t66
776  t784 = t566*t570
777  t788 = t188*t616
778  t791 = 0.10e2_dp/0.9e1_dp*t755*t148*t66*t54*t56 + 0.8e1_dp/0.3e1_dp &
779  *t761*t275 - 0.4e1_dp/0.3e1_dp*t272*t397*t274 + 0.4e1_dp/0.3e1_dp &
780  *t388*t358*t579 + (6._dp*t79*t632*t80) - (4._dp*t79 &
781  *t231*t281) + (4._dp*t394*t285) + (t79*t70*t778) &
782  - 0.2e1_dp*t147*t397*t284 + 0.2e1_dp*t147*t148*t784 - t147 &
783  *t148*t788
784  t819 = 0.10e2_dp/0.9e1_dp*t755*t290*t169 + 0.8e1_dp/0.3e1_dp*t761* &
785  t291 - 0.4e1_dp/0.3e1_dp*t272*t15*t300*t7 + (6._dp*t79*t632 &
786  *t88) - 0.4e1_dp*(t79)*t231*t300 + (t79*t70*(f2 &
787  *t553*t66 - 2._dp*t297*t284 + 2._dp*t86*t784 - t86*t788))
788  t824 = c*t383
789  t854 = t323*t83
790  t856 = 0.1e1_dp/t111/t854
791  t857 = t110*t856
792  t867 = dqrho**2
793  t872 = t97*t116*dqrho
794  t875 = t97*t118
795  t878 = t148*t66
796  t887 = t69*t13
797  t888 = t338*t887
798  t889 = t188*t71
799  t905 = t13*sscale
800  t910 = t119*t343*t123
801  t911 = sscale*t356
802  t923 = 0.1e1_dp/t126/t125
803  t924 = t361**2
804  t930 = t183*t188
805  t933 = t31*t566
806  t952 = t372*t136
807  t956 = t111*t83*t138
808  t968 = 0.1e1_dp/t854
809  t975 = d2exeirhorho(q, dqrho, d2qrhorho)
810  t983 = t66*t143
811  t1003 = t358*t84
812  t1007 = t80*t94
813  t1018 = t566*t84
814  t1023 = t78*t16
815  t1024 = t94*t218
816  t1037 = (6._dp*t78*t530*t150) - (4._dp*t394*t398) + (4._dp &
817  *t394*t402) + (2._dp*t147*t148*t983*t751) - (t147 &
818  *t148*t404*t791) + (t147*t15*t553*t149) - (2._dp* &
819  t147*t397*t401) - (2._dp*t147*t397*t405) - 0.4e1_dp/0.3e1_dp &
820  *t388*t281*t390 + 0.4e1_dp/0.3e1_dp*t388*t1003*t579 + 0.4e1_dp &
821  /0.3e1_dp*t388*t1007*t7*t287 + 0.10e2_dp/0.9e1_dp*(t78) &
822  *(t621)*(t80)*(t84)*(t54)*(t56) + (2._dp &
823  *t147*t148*t1018*t570) + 0.2e1_dp*t1023*t358*t1024 &
824  *t287 - (t147*t148*t400*t616) + 0.8e1_dp/0.3e1_dp*(t78) &
825  *(t628)*(t391) + (4._dp*t394*t406)
826  t1055 = t411*t12
827  t1056 = t410*t1055
828  t1057 = t31**2
829  t1059 = t413/t1057
830  t1060 = t65*t83
831  t1073 = (2._dp*t77*t143*t751) - (t77*t94*t791) + (f12 &
832  *t819*t95) - (4._dp*t304*t307) + (6._dp*t92*t824* &
833  t751) - (2._dp*t92*t306*t791) + (-((t98*(t100*t819 &
834  *t83 + 2._dp*t100*t303*t287 + t100*t91*t791 + 2._dp*t103*t751 &
835  + 2._dp*t103*t83*t791 + 6._dp*t105*t83*t751 + 3._dp*t105*t93 &
836  *t791)*t114) - (7._dp*t321*t327) + 0.63e2_dp/0.4e1_dp*(t109) &
837  *(t857)*(t751) - 0.7e1_dp/0.2e1_dp*(t109)*(t326) &
838  *(t791) - t330*d2qrhorho*t117*t130 - t330*t867*t117 &
839  *t130 + (4._dp*t872*t368) + 0.2e1_dp*t875*t335*(0.2e1_dp/ &
840  0.3e1_dp*t338*t158*t13*t878*t227 + (2._dp*t339*t231* &
841  t125) - (t339*t70*t357) + t888*t148*t889*t218)*t367 &
842  + 0.2e1_dp*t330*t336*t342*(0.4e1_dp/0.9e1_dp*t119*t120*t172 &
843  *t345*t126*t54*t56 + 0.2e1_dp/0.3e1_dp*t344*t905*t347 &
844  - t910*t911*t7*t361/0.3e1_dp + (2._dp*t121*t122*t164* &
845  t127) - t355*t905*t362 - t355*t345*t923*t924/0.4e1_dp + t355 &
846  *t345*t356*(t778*t71 - 2._dp*t930*t359 + 2._dp*t933* &
847  t71*t570 - t358*t71*t616)/0.2e1_dp))*t134*t139 - (7._dp &
848  *t952*t377) - 0.35e2_dp/0.4e1_dp*(t374)*(t956)*(t751) &
849  - 0.7e1_dp/0.2e1_dp*(t374)*(t376)*(t791))*e* &
850  (t143) - (6._dp*t381*t384) + (12._dp*t142*t968*t751) &
851  - (3._dp*t142*t383*t791) + t145*(t975 + t1037*t409*t411 &
852  *t418 + 0.2e1_dp/0.3e1_dp*(t410)*(t3)*(t122)* &
853  (t12)*(t413)*(t415)*(t65)*(t83)*(r3) &
854  *(t6) + (2._dp*t412*rho*t413*t417) - t1056*t1059 &
855  *t1060*t183 + (t412)*t414*(t415)*t218*(t83) &
856  + (t412)*t414*t416*(t287))
857  e_rho_rho = e_rho_rho + (-0.4e1_dp/0.9e1_dp/t744*f89*t156 - 0.8e1_dp/0.3e1_dp*t269*t423 &
858  - t76*t1073*clda)*sx0
859  t1079 = t143*t287*t435
860  t1082 = t425*t224
861  t1100 = t647*t66
862  t1110 = t566*t218*t261
863  t1114 = t188*t678
864  t1117 = -0.4e1_dp/0.3e1_dp*t1082*t275 - 0.2e1_dp/0.3e1_dp*t272*t504 &
865  *t274 + 0.2e1_dp/0.3e1_dp*t388*t358*t685 - (4._dp*t426*t278) &
866  - (2._dp*t79*t231*t429) + (2._dp*t394*t433) + (2._dp &
867  *t426*t282) + (t79*t70*t1100) - t147*t397*t432 - (2._dp &
868  *t501*t285) - t147*t504*t284 + 0.2e1_dp*t147*t148*t1110 &
869  - t147*t148*t1114
870  t1143 = -0.4e1_dp/0.3e1_dp*t1082*t291 - 0.2e1_dp/0.3e1_dp*t272*t15 &
871  *t443*t7 - (4._dp*t426*t294) - 0.2e1_dp*t79*t231*t443 + &
872  (2._dp*t426*t301) + t79*t70*(f2*t647*t66 - t297* &
873  t432 - t440*t284 + 2._dp*t86*t1110 - t86*t1114)
874  t1165 = t435*t287
875  t1202 = t97*t116*dqndrho
876  t1215 = t335*(-2._dp*t337*ndrho*t69*t340 - t339*t70*t475 &
877  + t888*t148*t889*t261)
878  t1242 = t245*t188
879  t1258 = (t98*(t100*t1143*t83 + t100*t303*t435 + t100 &
880  *t446*t287 + t100*t91*t1117 + 2._dp*t103*t1165 + 2._dp*t103* &
881  t83*t1117 + 6._dp*t105*t314*t435 + 3._dp*t105*t93*t1117)* &
882  t114) - 0.7e1_dp/0.2e1_dp*t321*t465 - 0.7e1_dp/0.2e1_dp*t463*t327 &
883  + 0.63e2_dp/0.4e1_dp*(t109)*(t110)*(t856)*(t287) &
884  *(t435) - 0.7e1_dp/0.2e1_dp*(t109)*(t326)*(t1117) &
885  - t330*d2qrhondrho*t117*t130 - t330*dqrho*dqndrho*t117*t130 &
886  + (2._dp*t872*t485) + (2._dp*t1202*t368) + (2._dp*t875 &
887  *t1215*t367) + 0.2e1_dp*t330*t336*t342*(-t471*t24*t123 &
888  *t127*t7/0.3e1_dp - t910*t911*t7*t478/0.6e1_dp - t472*t905 &
889  *t126 - t355*t905*t479/0.2e1_dp + t472*t363/0.2e1_dp - t355 &
890  *t345*t923*t361*t478/0.4e1_dp + t355*t345*t356*(t1100 &
891  *t71 - t930*t476 - t1242*t359 + 2._dp*t933*t657 - t358 &
892  *t71*t678)/0.2e1_dp)
893  t1263 = t489*t136
894  t1286 = d2exeirhondrho(q, dqrho, dqndrho, d2qrhondrho)
895  t1316 = -0.4e1_dp/0.3e1_dp*t425*t225*t391 - 0.2e1_dp/0.3e1_dp*t388 &
896  *t429*t390 + 0.2e1_dp/0.3e1_dp*t388*t1003*t685 + 0.2e1_dp/0.3e1_dp &
897  *t388*t1007*t7*t435 - 0.4e1_dp*t425*t165*t150 - (2._dp &
898  *t394*t505) + (2._dp*t394*t508) + (2._dp*t394*t511) + &
899  (2._dp*t501*t398) + t147*t15*t647*t149 - t147*t397*t507
900  t1347 = -t147*t397*t510 - 2._dp*t501*t402 - t147*t504*t401 &
901  + 2._dp*t1023*t933*t84*t218*t261 + t1023*t358*t1024*t435 &
902  - t147*t148*t400*t678 - 2._dp*t501*t406 - t147*t504*t405 &
903  + t1023*t358*t288*t261 + 2._dp*t1023*t80*t1079 - t147 &
904  *t148*t404*t1117
905  t1352 = 0.1e1_dp/t240
906  t1358 = t1059*t1060*t245
907  t1362 = t414*t415*t261*t83
908  t1365 = t414*t416*t435
909  t1369 = (2._dp*t77*t1079) - (t77*t94*t1117) + f12*t1143 &
910  *t95 - (2._dp*t304*t449) - (2._dp*t447*t307) + (6._dp &
911  *t92*c*t384*t435) - (2._dp*t92*t306*t1117) + (-t1258 &
912  *t134*t139 - 0.7e1_dp/0.2e1_dp*t952*t491 - 0.7e1_dp/0.2e1_dp*t1263 &
913  *t377 - 0.35e2_dp/0.4e1_dp*t374*t956*t1165 - 0.7e1_dp/0.2e1_dp* &
914  t374*t376*(t1117))*e*t143 - (3._dp*t381*t497) - (3._dp &
915  *t495*t384) + (12._dp*t142*t968*t287*t435) - (3._dp &
916  *t142*t383*t1117) + (t145*(t1286 + (t1316 + t1347)* &
917  t409*t411*t418 - 2._dp*t408*t1352*t411*t418 - t1056*t1358 &
918  + t412*t1362 + t412*t1365))
919  e_ndrho_rho = e_ndrho_rho + (-0.4e1_dp/0.3e1_dp*t269*t520 - t76*t1369*clda)*sx0
920  t1372 = t435**2
921  t1382 = t707*t66
922  t1388 = t566*t716
923  t1392 = t188*t735
924  t1395 = 2._dp*t887*t878 + 4._dp*t426*t430 - 4._dp*t501*t433 + t79* &
925  t70*t1382 - 2._dp*t147*t504*t432 + 2._dp*t147*t148*t1388 - &
926  t147*t148*t1392
927  t1412 = 2._dp*t69*t89 + 4._dp*t426*t444 + t79*t70*(f2*t707* &
928  t66 - 2._dp*t440*t432 + 2._dp*t86*t1388 - t86*t1392)
929  t1455 = dqndrho**2
930  t1465 = t478**2
931  t1510 = d2exeindrhondrho(q, dqndrho, d2qndrhondrho)
932  t1547 = 2._dp*t887*t150 + 4._dp*t501*t505 - 4._dp*t501*t508 - 4._dp*t501 &
933  *t511 + t147*t15*t707*t149 - 2._dp*t147*t504*t507 - 2._dp &
934  *t147*t504*t510 + 2._dp*t147*t148*t1018*t716 + 2._dp*t1023 &
935  *t358*t94*t261*t435 - t147*t148*t400*t735 + 2._dp*t147 &
936  *t148*t983*t1372 - t147*t148*t404*t1395
937  t1561 = (2._dp*t77*t143*t1372) - (t77*t94*t1395) + (f12 &
938  *t1412*t95) - (4._dp*t447*t449) + (6._dp*t92*t824 &
939  *t1372) - (2._dp*t92*t306*t1395) + (-((t98*(t100* &
940  t1412*t83 + 2._dp*t100*t446*t435 + t100*t91*t1395 + 2._dp*t103 &
941  *t1372 + 2._dp*t103*t83*t1395 + 6._dp*t105*t83*t1372 + 3._dp* &
942  t105*t93*t1395)*t114) - (7._dp*t463*t465) + 0.63e2_dp/0.4e1_dp &
943  *(t109)*(t857)*(t1372) - 0.7e1_dp/0.2e1_dp*(t109) &
944  *(t326)*(t1395) - t330*d2qndrhondrho*t117*t130 - t330 &
945  *t1455*t117*t130 + (4._dp*t1202*t485) + (2._dp*t875* &
946  t1215*t484) + 0.2e1_dp*t330*t336*t342*(t472*t480 - t355 &
947  *t345*t923*t1465/0.4e1_dp + t355*t345*t356*(t1382* &
948  t71 - 2._dp*t1242*t476 + 2._dp*t933*t71*t716 - t358*t71*t735) &
949  /0.2e1_dp))*t134*t139 - (7._dp*t1263*t491) - 0.35e2_dp/0.4e1_dp &
950  *(t374)*(t956)*(t1372) - 0.7e1_dp/0.2e1_dp*(t374) &
951  *(t376)*(t1395))*e*(t143) - (6._dp*t495 &
952  *t497) + (12._dp*t142*t968*t1372) - (3._dp*t142*t383* &
953  t1395) + (t145*(t1510 + t1547*t409*t411*t418 - 2._dp*t513 &
954  *t1352*t411*t418 - t514*t1055*t1358 + t515*t1362 + t515 &
955  *t1365))
956  e_ndrho_ndrho = e_ndrho_ndrho + (-t76*t1561*clda)*sx0
957  END IF
958 
959  END SUBROUTINE xwpbe_lda_calc_0
960 
961 ! **************************************************************************************************
962 !> \brief Evaluates the screened hole averaged PBE exchange functional for lda
963 !> \param e_0 ...
964 !> \param e_rho ...
965 !> \param e_ndrho ...
966 !> \param e_rho_rho ...
967 !> \param e_ndrho_rho ...
968 !> \param e_ndrho_ndrho ...
969 !> \param rho , ndrho: density and norm of the density gradient
970 !> \param ndrho ...
971 !> \param sscale scaling factor to enforce Lieb-Oxford bound
972 !> \param sx0 scaling factor
973 !> \param order degree of the derivative that should be evaluated,
974 !> if positive all the derivatives up to the given degree are evaluated,
975 !> if negative only the given degree is calculated
976 !> \par History
977 !> 05.2007 created [Manuel Guidon]
978 !> \author Manuel Guidon
979 !> \note
980 !> This routine evaluates the functional for omega=0 using a taylor
981 !> expansion for the parameter G.
982 ! **************************************************************************************************
983  SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, &
984  e_ndrho_ndrho, rho, ndrho, sscale, sx0, order)
985  REAL(kind=dp), INTENT(INOUT) :: e_0, e_rho, e_ndrho, e_rho_rho, &
986  e_ndrho_rho, e_ndrho_ndrho
987  REAL(kind=dp), INTENT(IN) :: rho, ndrho, sscale, sx0
988  INTEGER, INTENT(IN) :: order
989 
990  REAL(kind=dp) :: d2qndrhondrho, d2qrhondrho, d2qrhorho, dqndrho, dqrho, q, t1, t10, t100, &
991  t101, t1019, t103, t104, t1051, t1056, t1062, t1066, t1069, t107, t1073, t1076, t1080, &
992  t109, t1094, t1098, t11, t1101, t111, t112, t113, t114, t115, t1154, t116, t118, t1191, &
993  t12, t1205, t122, t124, t125, t126, t129, t13, t130, t131, t132, t135, t136, t139, t14, &
994  t140, t141, t142, t146, t149, t15, t150, t151, t153, t154, t156, t157, t158, t159, t16, &
995  t165, t166, t167, t168, t169, t173, t175, t18, t181, t184, t185, t186, t188, t189, t19, &
996  t190, t191, t193, t194, t197, t199, t2, t20, t202, t203, t206, t207
997  REAL(kind=dp) :: t208, t21, t211, t212, t213, t215, t216, t219, t22, t220, t224, t227, t228, &
998  t229, t231, t232, t235, t238, t24, t240, t241, t244, t247, t248, t25, t250, t251, t253, &
999  t254, t256, t257, t26, t260, t263, t266, t267, t270, t272, t273, t276, t277, t28, t280, &
1000  t283, t288, t29, t293, t294, t297, t299, t3, t300, t301, t304, t305, t307, t308, t31, &
1001  t311, t314, t315, t317, t318, t319, t32, t321, t322, t323, t325, t326, t327, t328, t329, &
1002  t33, t330, t331, t332, t333, t334, t335, t34, t340, t342, t343, t346, t347, t349, t350, &
1003  t352, t357, t36, t360, t361, t364, t366, t37, t371, t372, t375
1004  REAL(kind=dp) :: t376, t379, t380, t383, t385, t388, t389, t39, t392, t393, t395, t396, &
1005  t398, t399, t4, t40, t401, t402, t403, t408, t410, t412, t415, t418, t419, t42, t425, &
1006  t428, t430, t434, t438, t44, t441, t445, t454, t457, t458, t46, t465, t467, t47, t5, &
1007  t504, t508, t509, t515, t516, t52, t520, t53, t535, t54, t543, t552, t56, t567, t574, &
1008  t58, t59, t596, t6, t605, t61, t624, t63, t633, t640, t644, t65, t650, t656, t66, t67, &
1009  t674, t678, t68, t681, t69, t7, t70, t71, t714, t72, t73, t74, t759, t76, t766, t77, &
1010  t773, t777, t78, t79, t8, t80, t806, t81, t811, t812, t820, t828, t83, t84
1011  REAL(kind=dp) :: t847, t848, t849, t851, t852, t86, t865, t871, t874, t88, t89, t9, t902, &
1012  t906, t909, t92, t93, t94, t95, t97, t98, t989
1013 
1014  IF (order >= 0) THEN
1015  t1 = ndrho**2
1016  t2 = a1*t1
1017  t3 = r2**2
1018  t4 = 0.1e1_dp/t3
1019  t5 = t2*t4
1020  t6 = pi**2
1021  t7 = r3*t6
1022  t8 = t7*rho
1023  t9 = t8**(0.1e1_dp/0.3e1_dp)
1024  t10 = t9**2
1025  t11 = 0.1e1_dp/t10
1026  t12 = rho**2
1027  t13 = 0.1e1_dp/t12
1028  t14 = t11*t13
1029  t15 = sscale**2
1030  t16 = t14*t15
1031  t18 = t1**2
1032  t19 = a2*t18
1033  t20 = t3**2
1034  t21 = 0.1e1_dp/t20
1035  t22 = t19*t21
1036  t24 = 0.1e1_dp/t9/t8
1037  t25 = t12**2
1038  t26 = 0.1e1_dp/t25
1039  t28 = t15**2
1040  t29 = t24*t26*t28
1041  t31 = t5*t16 + t22*t29
1042  t32 = f94*t31
1043  t33 = a3*t18
1044  t34 = t33*t21
1045  t36 = t18*ndrho
1046  t37 = a4*t36
1047  t39 = 0.1e1_dp/t20/r2
1048  t40 = t37*t39
1049  t42 = 0.1e1_dp/t10/t8
1050  t44 = 0.1e1_dp/t25/rho
1051  t46 = t28*sscale
1052  t47 = t42*t44*t46
1053  t52 = 0.1e1_dp/t20/t3
1054  t53 = a5*t18*t1*t52
1055  t54 = r3**2
1056  t56 = t6**2
1057  t58 = 0.1e1_dp/t54/t56
1058  t59 = t25**2
1059  t61 = t28*t15
1060  t63 = t58/t59*t61
1061  t65 = r1 + t34*t29 + t40*t47 + t53*t63
1062  t66 = 0.1e1_dp/t65
1063  t67 = t66*t1
1064  t68 = t32*t67
1065  t69 = t4*t11
1066  t70 = t13*t15
1067  t71 = 0.1e1_dp/a
1068  t72 = t70*t71
1069  t73 = t69*t72
1070  q = t68*t73
1071  t74 = rho**(0.1e1_dp/0.3e1_dp)
1072  t76 = t74*rho*f89
1073  t77 = b*f12
1074  t78 = t1*t4
1075  t79 = t78*t11
1076  t80 = t31*t66
1077  t81 = t70*t80
1078  t83 = t79*t81 + dd
1079  t84 = 0.1e1_dp/t83
1080  t86 = f2*t31
1081  t88 = f1 + t86*t66
1082  t89 = t70*t88
1083  t92 = f12*(t79*t89 + r1)
1084  t93 = t83**2
1085  t94 = 0.1e1_dp/t93
1086  t95 = c*t94
1087  t97 = g2*t1
1088  t98 = t97*t4
1089  t100 = g3*t18
1090  t101 = t100*t21
1091  t103 = g1 + t98*t16 + t101*t29
1092  t104 = t70*t103
1093  t107 = (t79*t104 + r1)*e
1094  t109 = 0.1e1_dp/t93/t83
1095  t111 = f12*a
1096  t112 = exei(q)
1097  t113 = t78*t14
1098  t114 = t15*t31
1099  t115 = t66*t84
1100  t116 = t114*t115
1101  t118 = log(t113*t116)
1102  t122 = (t77*t84 + t92*t95 + t107*t109 + t111*(t112 + t118)) &
1103  *clda
1104  e_0 = e_0 + (-t76*t122)*sx0
1105  END IF
1106  IF (order >= 1 .OR. order == -1) THEN
1107  t124 = t4*t42
1108  t125 = t2*t124
1109  t126 = t70*t7
1110  t129 = t12*rho
1111  t130 = 0.1e1_dp/t129
1112  t131 = t11*t130
1113  t132 = t131*t15
1114  t135 = t54*t56
1115  t136 = t135*t12
1116  t139 = t21/t9/t136
1117  t140 = t19*t139
1118  t141 = t26*t28
1119  t142 = t141*t7
1120  t146 = t24*t44*t28
1121  t149 = -0.2e1_dp/0.3e1_dp*t125*t126 - (2._dp*t5*t132) - 0.4e1_dp/ &
1122  0.3e1_dp*t140*t142 - (4._dp*t22*t146)
1123  t150 = f94*t149
1124  t151 = t150*t67
1125  t153 = t65**2
1126  t154 = 0.1e1_dp/t153
1127  t156 = t154*t1*t4
1128  t157 = t32*t156
1129  t158 = t15*t71
1130  t159 = t33*t139
1131  t165 = 0.1e1_dp/t10/t136
1132  t166 = t39*t165
1133  t167 = t37*t166
1134  t168 = t44*t46
1135  t169 = t168*t7
1136  t173 = 0.1e1_dp/t25/t12
1137  t175 = t42*t173*t46
1138  t181 = t58/t59/rho*t61
1139  t184 = -0.4e1_dp/0.3e1_dp*t159*t142 - (4._dp*t34*t146) - 0.5e1_dp &
1140  /0.3e1_dp*t167*t169 - (5._dp*t40*t175) - (8._dp*t53*t181)
1141  t185 = t158*t184
1142  t186 = t14*t185
1143  t188 = t67*t4
1144  t189 = t32*t188
1145  t190 = t42*t13
1146  t191 = t190*t15
1147  t193 = t71*r3*t6
1148  t194 = t191*t193
1149  t197 = t130*t15
1150  t199 = t69*t197*t71
1151  dqrho = t151*t73 - t157*t186 - 0.2e1_dp/0.3e1_dp*t189*t194 - (2._dp &
1152  *t68*t199)
1153  t202 = a1*ndrho
1154  t203 = t202*t4
1155  t206 = t1*ndrho
1156  t207 = a2*t206
1157  t208 = t207*t21
1158  t211 = 2._dp*t203*t16 + 4._dp*t208*t29
1159  t212 = f94*t211
1160  t213 = t212*t67
1161  t215 = a3*t206
1162  t216 = t215*t21
1163  t219 = a4*t18
1164  t220 = t219*t39
1165  t224 = a5*t36*t52
1166  t227 = 4._dp*t216*t29 + 5._dp*t220*t47 + 6._dp*t224*t63
1167  t228 = t158*t227
1168  t229 = t14*t228
1169  t231 = t66*ndrho
1170  t232 = t32*t231
1171  dqndrho = t213*t73 - t157*t229 + 2._dp*t232*t73
1172  t235 = t74*f89
1173  t238 = t78*t190
1174  t240 = t66*r3*t6
1175  t241 = t114*t240
1176  t244 = t197*t80
1177  t247 = t149*t66
1178  t248 = t70*t247
1179  t250 = t154*t184
1180  t251 = t114*t250
1181  t253 = -0.2e1_dp/0.3e1_dp*t238*t241 - (2._dp*t79*t244) + (t79 &
1182  *t248) - t113*t251
1183  t254 = t94*t253
1184  t256 = t15*t88
1185  t257 = t256*t7
1186  t260 = t197*t88
1187  t263 = f2*t149
1188  t266 = t263*t66 - t86*t250
1189  t267 = t70*t266
1190  t270 = f12*(-0.2e1_dp/0.3e1_dp*t238*t257 - (2._dp*t79*t260) + &
1191  (t79*t267))
1192  t272 = c*t109
1193  t273 = t272*t253
1194  t276 = t15*t103
1195  t277 = t276*t7
1196  t280 = t197*t103
1197  t283 = t97*t124
1198  t288 = t100*t139
1199  t293 = -0.2e1_dp/0.3e1_dp*t283*t126 - (2._dp*t98*t132) - 0.4e1_dp &
1200  /0.3e1_dp*t288*t142 - (4._dp*t101*t146)
1201  t294 = t70*t293
1202  t297 = (-0.2e1_dp/0.3e1_dp*t238*t277 - (2._dp*t79*t280) + (t79 &
1203  *t294))*e
1204  t299 = t93**2
1205  t300 = 0.1e1_dp/t299
1206  t301 = t300*t253
1207  t304 = dexeirho(q, dqrho)
1208  t305 = t78*t191
1209  t307 = t84*r3*t6
1210  t308 = t80*t307
1211  t311 = t78*t131
1212  t314 = t15*t149
1213  t315 = t314*t115
1214  t317 = t154*t84
1215  t318 = t317*t184
1216  t319 = t114*t318
1217  t321 = t66*t94
1218  t322 = t321*t253
1219  t323 = t114*t322
1220  t325 = -0.2e1_dp/0.3e1_dp*t305*t308 - (2._dp*t311*t116) + t113 &
1221  *t315 - t113*t319 - t113*t323
1222  t326 = 0.1e1_dp/t1
1223  t327 = t325*t326
1224  t328 = t3*t10
1225  t329 = t327*t328
1226  t330 = 0.1e1_dp/t15
1227  t331 = t12*t330
1228  t332 = 0.1e1_dp/t31
1229  t333 = t332*t65
1230  t334 = t333*t83
1231  t335 = t331*t334
1232  t340 = (-t77*t254 + t270*t95 - 2._dp*t92*t273 + t297*t109 - 3._dp &
1233  *t107*t301 + t111*(t304 + t329*t335))*clda
1234  e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t235*t122 - t76*t340)*sx0
1235  t342 = ndrho*t4
1236  t343 = t342*t11
1237  t346 = t211*t66
1238  t347 = t70*t346
1239  t349 = t154*t227
1240  t350 = t114*t349
1241  t352 = 2._dp*t343*t81 + t79*t347 - t113*t350
1242  t357 = f2*t211
1243  t360 = t357*t66 - t86*t349
1244  t361 = t70*t360
1245  t364 = f12*(2._dp*t343*t89 + t79*t361)
1246  t366 = t272*t352
1247  t371 = g2*ndrho
1248  t372 = t371*t4
1249  t375 = g3*t206
1250  t376 = t375*t21
1251  t379 = 2._dp*t372*t16 + 4._dp*t376*t29
1252  t380 = t70*t379
1253  t383 = (2._dp*t343*t104 + t79*t380)*e
1254  t385 = t300*t352
1255  t388 = dexeindrho(q, dqndrho)
1256  t389 = t342*t14
1257  t392 = t15*t211
1258  t393 = t392*t115
1259  t395 = t317*t227
1260  t396 = t114*t395
1261  t398 = t321*t352
1262  t399 = t114*t398
1263  t401 = 2._dp*t389*t116 + t113*t393 - t113*t396 - t113*t399
1264  t402 = t401*t326
1265  t403 = t402*t328
1266  t408 = (-t77*t94*t352 + t364*t95 - 2._dp*t92*t366 + t383*t109 &
1267  - 3._dp*t107*t385 + t111*(t388 + t403*t335))*clda
1268  e_ndrho = e_ndrho + (-t76*t408)*sx0
1269  END IF
1270  IF (order >= 2 .OR. order == -2) THEN
1271  t410 = t4*t165
1272  t412 = t70*t135
1273  t415 = t197*t7
1274  t418 = t11*t26
1275  t419 = t418*t15
1276  t425 = t54*r3*t56*t6*t129
1277  t428 = t21/t9/t425
1278  t430 = t141*t135
1279  t434 = t44*t28*t7
1280  t438 = t24*t173*t28
1281  t441 = 0.10e2_dp/0.9e1_dp*t2*t410*t412 + 0.8e1_dp/0.3e1_dp*t125*t415 &
1282  + (6._dp*t5*t419) + 0.28e2_dp/0.9e1_dp*t19*t428*t430 + 0.32e2_dp &
1283  /0.3e1_dp*t140*t434 + (20._dp*t22*t438)
1284  t445 = t150*t156
1285  t454 = 0.1e1_dp/t153/t65
1286  t457 = t32*t454*t1*t4
1287  t458 = t184**2
1288  t465 = t32*t154*t78*t42
1289  t467 = t184*r3*t6
1290  t504 = 0.28e2_dp/0.9e1_dp*t33*t428*t430 + 0.32e2_dp/0.3e1_dp*t159* &
1291  t434 + (20._dp*t34*t438) + 0.40e2_dp/0.9e1_dp*t37*t39/t10/ &
1292  t425*t168*t135 + 0.50e2_dp/0.3e1_dp*t167*t173*t46*t7 + 0.30e2_dp &
1293  *t40*t42/t25/t129*t46 + (72._dp*t53*t58/t59/ &
1294  t12*t61)
1295  t508 = t165*t13
1296  t509 = t508*t15
1297  t515 = t42*t130
1298  t516 = t515*t15
1299  t520 = t26*t15
1300  d2qrhorho = f94*t441*t67*t73 - (2._dp*t445*t186) - 0.4e1_dp/0.3e1_dp &
1301  *t150*t188*t194 - (4._dp*t151*t199) + (2._dp*t457*t14 &
1302  *t158*t458) + 0.4e1_dp/0.3e1_dp*t465*t72*t467 + (4._dp*t157 &
1303  *t131*t185) - (t157*t14*t158*t504) + 0.10e2_dp/0.9e1_dp &
1304  *t189*t509*t71*t54*t56 + 0.8e1_dp/0.3e1_dp*t189*t516* &
1305  t193 + 0.6e1_dp*t68*t69*t520*t71
1306  t535 = -0.4e1_dp/0.3e1_dp*t202*t124*t126 - (4._dp*t203*t132) &
1307  - 0.16e2_dp/0.3e1_dp*t207*t139*t142 - (16._dp*t208*t146)
1308  t543 = t212*t156
1309  t552 = t32*t154*ndrho*t4
1310  t567 = -0.16e2_dp/0.3e1_dp*t215*t139*t142 - (16._dp*t216*t146) &
1311  - 0.25e2_dp/0.3e1_dp*t219*t166*t169 - (25._dp*t220*t175) - &
1312  (48._dp*t224*t181)
1313  t574 = t7*t227
1314  d2qrhondrho = (f94*t535*t67*t73) - t445*t229 + (2._dp*t150* &
1315  t231*t73) - (t543*t186) + (2._dp*t457*t16*t71*t184 &
1316  *t227) - (2._dp*t552*t186) - (t157*t14*t158*t567) &
1317  - 0.2e1_dp/0.3e1_dp*t212*t188*t194 + 0.2e1_dp/0.3e1_dp*t465*t72 &
1318  *t574 - 0.4e1_dp/0.3e1_dp*t32*(t231)*t4*t194 - (2._dp*t213 &
1319  *t199) + (2._dp*t157*t131*t228) - (4._dp*t232*t199)
1320  t596 = 2._dp*a1*t4*t16 + 12._dp*a2*t1*t21*t29
1321  t605 = t227**2
1322  t624 = 12._dp*a3*t1*t21*t29 + 20._dp*a4*t206*t39*t47 + 30._dp* &
1323  a5*t18*t52*t63
1324  d2qndrhondrho = f94*t596*t67*t73 - 2._dp*t543*t229 + 4._dp*t212*t231* &
1325  t73 + 2._dp*t457*t14*t158*t605 - 4._dp*t552*t229 - t157*t14 &
1326  *t158*t624 + 2._dp*t32*t66*t4*t14*t158
1327  t633 = t74**2
1328  t640 = t253**2
1329  t644 = t78*t508
1330  t650 = t78*t515
1331  t656 = t31*t154
1332  t674 = t454*t458
1333  t678 = t154*t504
1334  t681 = 0.10e2_dp/0.9e1_dp*t644*t114*t66*t54*t56 + 0.8e1_dp/0.3e1_dp &
1335  *t650*t241 - 0.4e1_dp/0.3e1_dp*t238*t314*t240 + 0.4e1_dp/0.3e1_dp &
1336  *t305*t656*t467 + (6._dp*t79*t520*t80) - (4._dp*t79 &
1337  *t197*t247) + (4._dp*t311*t251) + (t79)*t70*t441 &
1338  *t66 - 0.2e1_dp*t113*t314*t250 + 0.2e1_dp*t113*t114*t674 - &
1339  t113*t114*t678
1340  t714 = c*t300
1341  t759 = 0.1e1_dp/t299/t83
1342  t766 = d2exeirhorho(q, dqrho, d2qrhorho)
1343  t773 = t656*t84
1344  t777 = t80*t94
1345  t806 = t454*t84
1346  t811 = t78*t16
1347  t812 = t94*t184
1348  t820 = t66*t109
1349  t828 = 0.8e1_dp/0.3e1_dp*t78*t516*t308 - 0.4e1_dp/0.3e1_dp*t305*t247 &
1350  *t307 + 0.4e1_dp/0.3e1_dp*t305*t773*t467 + 0.4e1_dp/0.3e1_dp* &
1351  t305*t777*t7*t253 + 0.10e2_dp/0.9e1_dp*t78*t509*t80*t84 &
1352  *t54*t56 + 0.6e1_dp*t78*t418*t116 - (4._dp*t311*t315) + &
1353  (4._dp*t311*t319) + (4._dp*t311*t323) + (t113*t15* &
1354  t441*t115) - (2._dp*t113*t314*t318) - (2._dp*t113*t314 &
1355  *t322) + (2._dp*t113*t114*t806*t458) + 0.2e1_dp*t811*t656 &
1356  *t812*t253 - (t113*t114*t317*t504) + (2._dp*t113 &
1357  *t114*t820*t640) - (t113*t114*t321*t681)
1358  t847 = t328*t12
1359  t848 = t327*t847
1360  t849 = t31**2
1361  t851 = t330/t849
1362  t852 = t65*t83
1363  t865 = (2._dp*t77*t109*t640) - (t77*t94*t681) + f12* &
1364  (0.10e2_dp/0.9e1_dp*t644*t256*t135 + 0.8e1_dp/0.3e1_dp*t650*t257 &
1365  - 0.4e1_dp/0.3e1_dp*t238*t15*t266*t7 + (6._dp*t79*t520* &
1366  t88) - 0.4e1_dp*(t79)*t197*t266 + (t79*t70*(f2*t441 &
1367  *t66 - 2._dp*t263*t250 + 2._dp*t86*t674 - t86*t678)))*t95 &
1368  - (4._dp*t270*t273) + (6._dp*t92*t714*t640) - (2._dp* &
1369  t92*t272*t681) + (0.10e2_dp/0.9e1_dp*t644*t276*t135 + 0.8e1_dp &
1370  /0.3e1_dp*t650*t277 - 0.4e1_dp/0.3e1_dp*t238*t15*t293*t7 + (6._dp &
1371  *t79*t520*t103) - 0.4e1_dp*(t79)*t197*t293 + (t79) &
1372  *(t70)*(0.10e2_dp/0.9e1_dp*t97*t410*t412 + 0.8e1_dp/ &
1373  0.3e1_dp*t283*t415 + (6._dp*t98*t419) + 0.28e2_dp/0.9e1_dp*t100 &
1374  *t428*t430 + 0.32e2_dp/0.3e1_dp*t288*t434 + (20._dp*t101* &
1375  t438)))*e*(t109) - (6._dp*t297*t301) + (12._dp*t107 &
1376  *t759*t640) - (3._dp*t107*t300*t681) + t111*(t766 + t828 &
1377  *t326*t328*t335 + 0.2e1_dp/0.3e1_dp*t327*t3/t9*t12*t330 &
1378  *t332*t65*t83*r3*t6 + 0.2e1_dp*t329*rho*t330*t334 &
1379  - t848*t851*t852*t149 + t329*t331*t332*t184*t83 + t329 &
1380  *t331*t333*t253)
1381  e_rho_rho = e_rho_rho + (-0.4e1_dp/0.9e1_dp/t633*f89*t122 - 0.8e1_dp/0.3e1_dp*t235*t340 &
1382  - t76*t865*clda)*sx0
1383  t871 = t109*t253*t352
1384  t874 = t342*t190
1385  t902 = t454*t184*t227
1386  t906 = t154*t567
1387  t909 = -0.4e1_dp/0.3e1_dp*t874*t241 - 0.2e1_dp/0.3e1_dp*t238*t392* &
1388  t240 + 0.2e1_dp/0.3e1_dp*t305*t656*t574 - (4._dp*t343*t244) &
1389  - (2._dp*t79*t197*t346) + (2._dp*t311*t350) + (2._dp* &
1390  t343*t248) + (t79*t70*t535*t66) - t113*t314*t349 - &
1391  (2._dp*t389*t251) - t113*t392*t250 + 0.2e1_dp*t113*t114 &
1392  *t902 - t113*t114*t906
1393  t989 = d2exeirhondrho(q, dqrho, dqndrho, d2qrhondrho)
1394  t1019 = -0.4e1_dp/0.3e1_dp*t342*t191*t308 - 0.2e1_dp/0.3e1_dp*t305 &
1395  *t346*t307 + 0.2e1_dp/0.3e1_dp*t305*t773*t574 + 0.2e1_dp/0.3e1_dp &
1396  *t305*t777*t7*t352 - 0.4e1_dp*t342*t131*t116 - (2._dp* &
1397  t311*t393) + (2._dp*t311*t396) + (2._dp*t311*t399) + (2._dp &
1398  *t389*t315) + t113*t15*t535*t115 - t113*t314*t395
1399  t1051 = -t113*t314*t398 - 2._dp*t389*t319 - t113*t392*t318 &
1400  + 2._dp*t811*t31*t454*t84*t184*t227 + t811*t656*t812* &
1401  t352 - t113*t114*t317*t567 - 2._dp*t389*t323 - t113*t392 &
1402  *t322 + t811*t656*t254*t227 + 2._dp*t811*t80*t871 - t113 &
1403  *t114*t321*t909
1404  t1056 = 0.1e1_dp/t206
1405  t1062 = t851*t852*t211
1406  t1066 = t331*t332*t227*t83
1407  t1069 = t331*t333*t352
1408  t1073 = (2._dp*t77*t871) - (t77*t94*t909) + f12*(-0.4e1_dp &
1409  /0.3e1_dp*t874*t257 - 0.2e1_dp/0.3e1_dp*t238*t15*t360*t7 &
1410  - (4._dp*t343*t260) - 0.2e1_dp*t79*t197*t360 + (2._dp*t343 &
1411  *t267) + t79*t70*(f2*t535*t66 - t263*t349 - t357 &
1412  *t250 + 2._dp*t86*t902 - t86*t906))*t95 - (2._dp*t270*t366) &
1413  - (2._dp*t364*t273) + (6._dp*t92*c*t301*t352) - (2._dp &
1414  *t92*t272*t909) + (-0.4e1_dp/0.3e1_dp*t874*t277 - 0.2e1_dp/ &
1415  0.3e1_dp*t238*t15*t379*t7 - (4._dp*t343*t280) - 0.2e1_dp* &
1416  t79*t197*t379 + (2._dp*t343*t294) + t79*t70*(-0.4e1_dp/ &
1417  0.3e1_dp*t371*t124*t126 - (4._dp*t372*t132) - 0.16e2_dp/0.3e1_dp &
1418  *t375*t139*t142 - (16._dp*t376*t146)))*e*t109 - (3._dp &
1419  *t297*t385) - (3._dp*t383*t301) + (12._dp*t107*t759 &
1420  *t253*t352) - (3._dp*t107*t300*t909) + (t111*(t989 &
1421  + (t1019 + t1051)*t326*t328*t335 - 2._dp*t325*t1056*t328 &
1422  *t335 - t848*t1062 + t329*t1066 + t329*t1069))
1423  e_ndrho_rho = e_ndrho_rho + (-0.4e1_dp/0.3e1_dp*t235*t408 - t76*t1073*clda)*sx0
1424  t1076 = t352**2
1425  t1080 = t69*t13
1426  t1094 = t454*t605
1427  t1098 = t154*t624
1428  t1101 = 2._dp*t1080*t114*t66 + 4._dp*t343*t347 - 4._dp*t389*t350 &
1429  + t79*t70*t596*t66 - 2._dp*t113*t392*t349 + 2._dp*t113*t114 &
1430  *t1094 - t113*t114*t1098
1431  t1154 = d2exeindrhondrho(q, dqndrho, d2qndrhondrho)
1432  t1191 = 2._dp*t1080*t116 + 4._dp*t389*t393 - 4._dp*t389*t396 - 4._dp* &
1433  t389*t399 + t113*t15*t596*t115 - 2._dp*t113*t392*t395 - &
1434  2._dp*t113*t392*t398 + 2._dp*t113*t114*t806*t605 + 2._dp*t811 &
1435  *t656*t94*t227*t352 - t113*t114*t317*t624 + 2._dp*t113 &
1436  *t114*t820*t1076 - t113*t114*t321*t1101
1437  t1205 = 2._dp*t77*t109*t1076 - t77*t94*t1101 + f12*(2._dp*t69 &
1438  *t89 + 4._dp*t343*t361 + t79*t70*(f2*t596*t66 - 2._dp*t357 &
1439  *t349 + 2._dp*t86*t1094 - t86*t1098))*t95 - 4._dp*t364*t366 &
1440  + 6._dp*t92*t714*t1076 - 2._dp*t92*t272*t1101 + (2._dp*t69*t104 &
1441  + 4._dp*t343*t380 + t79*t70*(2._dp*g2*t4*t16 + 12._dp*g3*t1 &
1442  *t21*t29))*e*t109 - 6._dp*t383*t385 + 12._dp*t107*t759* &
1443  t1076 - 3._dp*t107*t300*t1101 + t111*(t1154 + t1191*t326*t328 &
1444  *t335 - 2._dp*t401*t1056*t328*t335 - t402*t847*t1062 &
1445  + t403*t1066 + t403*t1069)
1446  e_ndrho_ndrho = e_ndrho_ndrho + (-t76*t1205*clda)*sx0
1447  END IF
1448 
1449  END SUBROUTINE xwpbe_lda_calc_01
1450 
1451 ! **************************************************************************************************
1452 !> \brief Evaluates the screened hole averaged PBE exchange functional for lda.
1453 !> \param e_0 ...
1454 !> \param e_rho ...
1455 !> \param e_ndrho ...
1456 !> \param e_rho_rho ...
1457 !> \param e_ndrho_rho ...
1458 !> \param e_ndrho_ndrho ...
1459 !> \param rho , ndrho: density and norm of the density gradient
1460 !> \param ndrho ...
1461 !> \param omega scaling factor
1462 !> \param sscale scaling factor to enforce Lieb-Oxford bound
1463 !> \param sx scaling factor
1464 !> \param order degree of the derivative that should be evaluated,
1465 !> if positive all the derivatives up to the given degree are evaluated,
1466 !> if negative only the given degree is calculated
1467 !> \par History
1468 !> 05.2007 created [Manuel Guidon]
1469 !> \author Manuel Guidon
1470 !> \note
1471 !> This routine evaluates the exact functional for omega!=0.
1472 ! **************************************************************************************************
1473  SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, &
1474  e_ndrho_ndrho, rho, ndrho, omega, sscale, sx, order)
1475  REAL(kind=dp), INTENT(INOUT) :: e_0, e_rho, e_ndrho, e_rho_rho, &
1476  e_ndrho_rho, e_ndrho_ndrho
1477  REAL(kind=dp), INTENT(IN) :: rho, ndrho, omega, sscale, sx
1478  INTEGER, INTENT(IN) :: order
1479 
1480  REAL(kind=dp) :: d2qndrhondrho, d2qrhondrho, d2qrhorho, dqndrho, dqrho, q, t1, t10, t1001, &
1481  t1009, t1011, t102, t1024, t1035, t104, t105, t1052, t1066, t1068, t1069, t1071, t1072, &
1482  t1077, t1078, t1079, t108, t1081, t1082, t1085, t1086, t1087, t109, t1090, t1091, t1094, &
1483  t1097, t1098, t11, t110, t1100, t111, t1113, t1115, t1119, t1123, t1126, t1127, t1129, &
1484  t113, t1132, t1134, t1135, t1136, t1139, t115, t116, t1168, t1169, t117, t1171, t1173, &
1485  t1176, t1178, t118, t1181, t1185, t119, t12, t120, t1208, t1209, t121, t1214, t1220, &
1486  t123, t1236, t1237, t124, t1240, t1242, t1243, t125, t1257, t1258
1487  REAL(kind=dp) :: t126, t1264, t1265, t127, t128, t1281, t1282, t1285, t1287, t129, t1294, &
1488  t1297, t13, t1301, t1304, t1305, t1306, t1309, t131, t1310, t1317, t1318, t132, t1324, &
1489  t1325, t1326, t133, t1355, t136, t1379, t1381, t1382, t1392, t14, t140, t1402, t1409, &
1490  t141, t142, t1433, t1437, t144, t1442, t1445, t145, t1456, t1457, t147, t1473, t1478, &
1491  t1479, t148, t149, t1491, t1492, t1498, t15, t150, t1501, t151, t152, t1520, t1524, t153, &
1492  t1531, t1535, t154, t1543, t1546, t1547, t1548, t155, t1551, t1555, t1559, t156, t1562, &
1493  t1563, t1564, t1568, t157, t1572, t1573, t1579, t158, t1580, t159
1494  REAL(kind=dp) :: t1592, t1599, t16, t1602, t1609, t1615, t162, t1624, t1625, t163, t1633, &
1495  t1649, t1658, t166, t1663, t167, t1677, t168, t1680, t1681, t1682, t1686, t169, t1693, &
1496  t1697, t17, t170, t1709, t1710, t1714, t1722, t1723, t1726, t1729, t1731, t174, t1740, &
1497  t176, t1767, t1768, t177, t1770, t1781, t1786, t1791, t18, t180, t1802, t1804, t1805, &
1498  t181, t1816, t1827, t1835, t1839, t1846, t185, t1853, t1854, t186, t1860, t1868, t1880, &
1499  t1881, t1885, t189, t1898, t19, t190, t1906, t1907, t192, t1923, t193, t1932, t1938, &
1500  t194, t195, t1951, t1956, t1961, t1967, t197, t1977, t198, t1983, t1984
1501  REAL(kind=dp) :: t1988, t199, t1995, t2, t200, t202, t2028, t205, t2059, t2072, t2073, t209, &
1502  t2099, t21, t210, t2108, t213, t214, t2142, t2144, t2150, t2173, t2184, t219, t2197, t22, &
1503  t221, t222, t2224, t223, t224, t2240, t2245, t2254, t2258, t2267, t2269, t227, t2271, &
1504  t2274, t228, t2280, t2282, t2285, t2291, t2297, t23, t2305, t2311, t2316, t2323, t2329, &
1505  t233, t2348, t2363, t237, t2371, t2379, t239, t24, t2401, t2405, t241, t2410, t243, &
1506  t2437, t2442, t2449, t2452, t2455, t2457, t246, t247, t2473, t2484, t2499, t25, t250, &
1507  t251, t2512, t252, t2529, t253, t2543, t255, t256, t257, t2573, t258
1508  REAL(kind=dp) :: t263, t264, t265, t267, t2688, t27, t270, t2707, t271, t2715, t273, t275, &
1509  t276, t2764, t2774, t28, t280, t2808, t2810, t2838, t284, t2841, t2844, t2846, t285, &
1510  t286, t2875, t288, t2880, t2884, t289, t29, t290, t2927, t293, t294, t295, t2963, t2971, &
1511  t2975, t2979, t298, t2994, t3, t3001, t303, t3033, t305, t307, t31, t310, t311, t312, &
1512  t313, t3139, t315, t316, t3167, t318, t319, t32, t321, t326, t329, t330, t332, t333, &
1513  t335, t336, t338, t339, t34, t340, t342, t343, t345, t346, t347, t348, t349, t35, t351, &
1514  t352, t353, t354, t357, t358, t36, t361, t362, t363, t364, t368, t371
1515  REAL(kind=dp) :: t372, t373, t374, t375, t376, t377, t378, t38, t383, t384, t385, t386, t39, &
1516  t390, t392, t398, t4, t401, t402, t403, t404, t406, t409, t41, t411, t412, t415, t416, &
1517  t419, t42, t420, t421, t424, t425, t426, t428, t429, t432, t433, t437, t44, t440, t441, &
1518  t442, t444, t446, t449, t452, t453, t454, t457, t46, t461, t463, t465, t468, t469, t472, &
1519  t475, t478, t479, t48, t481, t486, t49, t493, t495, t498, t499, t5, t502, t503, t504, &
1520  t507, t508, t509, t510, t511, t513, t514, t515, t517, t518, t522, t525, t529, t530, t531, &
1521  t532, t533, t534, t535, t537, t538, t539, t54, t540, t542, t55
1522  REAL(kind=dp) :: t550, t551, t552, t553, t554, t556, t557, t558, t56, t562, t563, t567, &
1523  t569, t571, t572, t575, t576, t577, t578, t58, t581, t582, t583, t587, t588, t589, t592, &
1524  t596, t597, t6, t60, t602, t603, t608, t61, t613, t617, t620, t621, t624, t626, t629, &
1525  t63, t631, t634, t638, t639, t644, t645, t65, t653, t655, t656, t657, t658, t659, t663, &
1526  t666, t669, t67, t673, t679, t68, t681, t685, t689, t69, t690, t691, t697, t698, t7, t70, &
1527  t701, t71, t711, t713, t717, t718, t72, t721, t728, t73, t735, t736, t739, t74, t740, &
1528  t746, t747, t748, t75, t752, t753, t754, t755, t759, t761, t763, t765
1529  REAL(kind=dp) :: t769, t77, t771, t772, t779, t78, t780, t781, t783, t784, t787, t791, t792, &
1530  t799, t8, t80, t800, t801, t803, t804, t808, t81, t810, t812, t815, t816, t817, t82, &
1531  t820, t823, t826, t83, t832, t834, t836, t84, t842, t845, t846, t848, t849, t85, t851, &
1532  t865, t867, t87, t870, t871, t873, t874, t876, t877, t88, t880, t884, t885, t888, t889, &
1533  t891, t892, t893, t897, t898, t9, t90, t902, t904, t907, t908, t909, t91, t910, t916, &
1534  t918, t919, t92, t93, t930, t932, t933, t937, t94, t942, t945, t95, t951, t954, t958, &
1535  t96, t962, t965, t968, t97, t971, t972, t979, t982, t988, t99
1536 
1537  IF (order >= 0) THEN
1538  t1 = ndrho**2
1539  t2 = r2**2
1540  t3 = 0.1e1_dp/t2
1541  t4 = t1*t3
1542  t5 = pi**2
1543  t6 = r3*t5
1544  t7 = t6*rho
1545  t8 = t7**(0.1e1_dp/0.3e1_dp)
1546  t9 = t8**2
1547  t10 = 0.1e1_dp/t9
1548  t11 = t4*t10
1549  t12 = rho**2
1550  t13 = 0.1e1_dp/t12
1551  t14 = sscale**2
1552  t15 = t13*t14
1553  t16 = a1*t1
1554  t17 = t16*t3
1555  t18 = t10*t13
1556  t19 = t18*t14
1557  t21 = t1**2
1558  t22 = a2*t21
1559  t23 = t2**2
1560  t24 = 0.1e1_dp/t23
1561  t25 = t22*t24
1562  t27 = 0.1e1_dp/t8/t7
1563  t28 = t12**2
1564  t29 = 0.1e1_dp/t28
1565  t31 = t14**2
1566  t32 = t27*t29*t31
1567  t34 = t17*t19 + t25*t32
1568  t35 = a3*t21
1569  t36 = t35*t24
1570  t38 = t21*ndrho
1571  t39 = a4*t38
1572  t41 = 0.1e1_dp/t23/r2
1573  t42 = t39*t41
1574  t44 = 0.1e1_dp/t9/t7
1575  t46 = 0.1e1_dp/t28/rho
1576  t48 = t31*sscale
1577  t49 = t44*t46*t48
1578  t54 = 0.1e1_dp/t23/t2
1579  t55 = a5*t21*t1*t54
1580  t56 = r3**2
1581  t58 = t5**2
1582  t60 = 0.1e1_dp/t56/t58
1583  t61 = t28**2
1584  t63 = t31*t14
1585  t65 = t60/t61*t63
1586  t67 = r1 + t36*t32 + t42*t49 + t55*t65
1587  t68 = 0.1e1_dp/t67
1588  t69 = t34*t68
1589  t70 = t15*t69
1590  t71 = t11*t70
1591  t72 = omega**2
1592  t73 = beta*t72
1593  t74 = t73*t10
1594  t75 = t71 + t74
1595  t77 = 0.1e1_dp/a
1596  q = f94*t75*t77
1597  t78 = rho**(0.1e1_dp/0.3e1_dp)
1598  t80 = t78*rho*f89
1599  t81 = b*f12
1600  t82 = t71 + dd
1601  t83 = 0.1e1_dp/t82
1602  t84 = t81*t83
1603  t85 = f2*t34
1604  t87 = f1 + t85*t68
1605  t88 = t15*t87
1606  t90 = t11*t88 + r1
1607  t91 = f12*t90
1608  t92 = t82**2
1609  t93 = 0.1e1_dp/t92
1610  t94 = c*t93
1611  t95 = t91*t94
1612  t96 = f34*pi
1613  t97 = rootpi
1614  t99 = r6*c
1615  t102 = r4*b
1616  t104 = r8*a
1617  t105 = t92*t82
1618  t108 = t97*(r15*e + t99*t90*t82 + t102*t92 + t104*t105)
1619  t109 = 0.1e1_dp/r16
1620  t110 = sqrt(t82)
1621  t111 = t110*t105
1622  t113 = t109/t111
1623  t115 = sqrt(a)
1624  t116 = f94*t34
1625  t117 = t68*t1
1626  t118 = t116*t117
1627  t119 = t3*t10
1628  t120 = t15*t77
1629  t121 = t119*t120
1630  t123 = exp(t118*t121)
1631  t124 = t115*t123
1632  t125 = f32*ndrho
1633  t126 = 0.1e1_dp/r2
1634  t127 = t125*t126
1635  t128 = 0.1e1_dp/t8
1636  t129 = 0.1e1_dp/rho
1637  t131 = t69*t77
1638  t132 = sqrt(t131)
1639  t133 = sscale*t132
1640  t136 = erfc(t127*t128*t129*t133)
1641  t140 = 0.1e1_dp/f1516
1642  t141 = (t96 + t108*t113 - t96*t124*t136)*t140
1643  t142 = 0.1e1_dp/t97
1644  t144 = 0.1e1_dp/e
1645  t145 = t142*t111*t144
1646  t147 = -t141*t145 + r1
1647  t148 = t147*e
1648  t149 = 0.1e1_dp/t105
1649  t150 = t148*t149
1650  t151 = f158*e
1651  t152 = t147*t83
1652  t153 = t72*t10
1653  t154 = t71 + dd + t153
1654  t155 = t154**2
1655  t156 = t155**2
1656  t157 = t156*t154
1657  t158 = sqrt(t157)
1658  t159 = 0.1e1_dp/t158
1659  t162 = sqrt(t154)
1660  t163 = 0.1e1_dp/t162
1661  t166 = f68*c
1662  t167 = t90*t83
1663  t168 = t155*t154
1664  t169 = sqrt(t168)
1665  t170 = 0.1e1_dp/t169
1666  t174 = (-t151*t152*t159 - t81*t83*t163 - t166*t167*t170) &
1667  *omega
1668  t176 = f52*e
1669  t177 = t147*t93
1670  t180 = f12*c
1671  t181 = t90*t93
1672  t185 = t72*omega
1673  t186 = (-t176*t177*t159 - t180*t181*t170)*t185
1674  t189 = 0.1e1_dp/r3/t5
1675  t190 = t189*t129
1676  t192 = t72**2
1677  t193 = t192*omega
1678  t194 = t159*t193
1679  t195 = t194*t44
1680  t197 = f12*a
1681  t198 = exei(q)
1682  t199 = t71 + dd + t74
1683  t200 = 0.1e1_dp/t199
1684  t202 = log(t75*t200)
1685  t205 = sqrt(t199)
1686  t209 = t115*f34
1687  t210 = exer(q)
1688  t213 = (t197*t97/t205 - t209*t210)*alpha1
1689  t214 = omega*t128
1690  t219 = (t197*t200 - f98*t198)*alpha2
1691  t221 = a*f14
1692  t222 = t199**2
1693  t223 = t222*t199
1694  t224 = sqrt(t223)
1695  t227 = sqrt(t75)
1696  t228 = 0.1e1_dp/t227
1697  t233 = 0.1e1_dp/t115
1698  t237 = (t97*(t221/t224 - f98*t228) + f2716*t210*t233)*alpha3 &
1699  *t185
1700  t239 = 0.1e1_dp/t75
1701  t241 = 0.1e1_dp/t222
1702  t243 = f8132*t77
1703  t246 = (-f98*t239 + t197*t241 + t243*t198)*alpha4
1704  t247 = t192*t27
1705  t250 = t75**2
1706  t251 = t250*t75
1707  t252 = sqrt(t251)
1708  t253 = 0.1e1_dp/t252
1709  t255 = f38*a
1710  t256 = t222**2
1711  t257 = t256*t199
1712  t258 = sqrt(t257)
1713  t263 = a**2
1714  t264 = t263*a
1715  t265 = sqrt(t264)
1716  t267 = f24364/t265
1717  t270 = (t97*(t243*t228 - f916*t253 + t255/t258) - t267*t210) &
1718  *alpha5
1719  t271 = t193*t44
1720  t273 = 0.1e1_dp/t223
1721  t275 = 0.1e1_dp/t250
1722  t276 = f98*t275
1723  t280 = f729128/t263
1724  t284 = t192*t72
1725  t285 = (a*t273 - t276 + t243*r1*t239 - t280*t198)*alpha6 &
1726  *t284
1727  t286 = t60*t13
1728  t288 = f1516*a
1729  t289 = t256*t223
1730  t290 = sqrt(t289)
1731  t293 = t250**2
1732  t294 = t293*t75
1733  t295 = sqrt(t294)
1734  t298 = f8164*t77
1735  t303 = t263**2
1736  t305 = sqrt(t303*a)
1737  t307 = f2187256/t305
1738  t310 = (t97*(t288/t290 - f2732/t295 + t298*t253 - t280*t228) &
1739  + t307*t210)*alpha7
1740  t311 = t192*t185
1741  t312 = t56*t58
1742  t313 = t312*t12
1743  t315 = 0.1e1_dp/t8/t313
1744  t316 = t311*t315
1745  t318 = r3*a
1746  t319 = 0.1e1_dp/t256
1747  t321 = 0.1e1_dp/t251
1748  t326 = f6561512/t264
1749  t329 = (t318*t319 - f94*t321 + t243*t275 - t280*t239 + t326 &
1750  *t198)*alpha8
1751  t330 = t192**2
1752  t332 = 0.1e1_dp/t9/t313
1753  t333 = t330*t332
1754  t335 = t84 + t95 + t150 + t174*t128 + t186*t190 - t150*t195 + &
1755  t197*(t198 + t202) + t213*t214 + t219*t153 + t237*t190 + &
1756  t246*t247 + t270*t271 + t285*t286 + t310*t316 + t329*t333
1757  t336 = t335*clda
1758  e_0 = e_0 + (-t80*t336)*sx
1759  END IF
1760  IF (order >= 1 .OR. order == -1) THEN
1761  t338 = t44*t13
1762  t339 = t4*t338
1763  t340 = t14*t34
1764  t342 = t68*r3*t5
1765  t343 = t340*t342
1766  t345 = 0.2e1_dp/0.3e1_dp*t339*t343
1767  t346 = t12*rho
1768  t347 = 0.1e1_dp/t346
1769  t348 = t347*t14
1770  t349 = t348*t69
1771  t351 = 2._dp*t11*t349
1772  t352 = t3*t44
1773  t353 = t16*t352
1774  t354 = t15*t6
1775  t357 = t10*t347
1776  t358 = t357*t14
1777  t361 = t24*t315
1778  t362 = t22*t361
1779  t363 = t29*t31
1780  t364 = t363*t6
1781  t368 = t27*t46*t31
1782  t371 = -0.2e1_dp/0.3e1_dp*t353*t354 - (2._dp*t17*t358) - 0.4e1_dp &
1783  /0.3e1_dp*t362*t364 - (4._dp*t25*t368)
1784  t372 = t371*t68
1785  t373 = t15*t372
1786  t374 = t11*t373
1787  t375 = t4*t18
1788  t376 = t67**2
1789  t377 = 0.1e1_dp/t376
1790  t378 = t35*t361
1791  t383 = t41*t332
1792  t384 = t39*t383
1793  t385 = t46*t48
1794  t386 = t385*t6
1795  t390 = 0.1e1_dp/t28/t12
1796  t392 = t44*t390*t48
1797  t398 = t60/t61/rho*t63
1798  t401 = -0.4e1_dp/0.3e1_dp*t378*t364 - (4._dp*t36*t368) - 0.5e1_dp &
1799  /0.3e1_dp*t384*t386 - (5._dp*t42*t392) - (8._dp*t55*t398)
1800  t402 = t377*t401
1801  t403 = t340*t402
1802  t404 = t375*t403
1803  t406 = t44*r3*t5
1804  t409 = -t345 - t351 + t374 - t404 - 0.2e1_dp/0.3e1_dp*t73*t406
1805  dqrho = f94*t409*t77
1806  t411 = ndrho*t3
1807  t412 = t411*t10
1808  t415 = a1*ndrho
1809  t416 = t415*t3
1810  t419 = t1*ndrho
1811  t420 = a2*t419
1812  t421 = t420*t24
1813  t424 = 2._dp*t416*t19 + 4._dp*t421*t32
1814  t425 = t424*t68
1815  t426 = t15*t425
1816  t428 = a3*t419
1817  t429 = t428*t24
1818  t432 = a4*t21
1819  t433 = t432*t41
1820  t437 = a5*t38*t54
1821  t440 = 4._dp*t429*t32 + 5._dp*t433*t49 + 6._dp*t437*t65
1822  t441 = t377*t440
1823  t442 = t340*t441
1824  t444 = 2._dp*t412*t70 + t11*t426 - t375*t442
1825  dqndrho = f94*t444*t77
1826  t446 = t78*f89
1827  t449 = t60*t347
1828  t452 = c*t149
1829  t453 = -t345 - t351 + t374 - t404
1830  t454 = t452*t453
1831  t457 = t329*t330
1832  t461 = t56*r3*t58*t5*t346
1833  t463 = 0.1e1_dp/t9/t461
1834  t465 = t463*r3*t5
1835  t468 = t14*t87
1836  t469 = t468*t6
1837  t472 = t348*t87
1838  t475 = f2*t371
1839  t478 = t475*t68 - t85*t402
1840  t479 = t15*t478
1841  t481 = -0.2e1_dp/0.3e1_dp*t339*t469 - (2._dp*t11*t472) + (t11 &
1842  *t479)
1843  t486 = t82*t453
1844  t493 = t97*(t99*t481*t82 + t99*t90*t453 + 2._dp*t102*t486 &
1845  + 3._dp*t104*t92*t453)
1846  t495 = t92**2
1847  t498 = t109/t110/t495
1848  t499 = t498*t453
1849  t502 = t96*t115
1850  t503 = f94*t371
1851  t504 = t503*t117
1852  t507 = t377*t1*t3
1853  t508 = t116*t507
1854  t509 = t14*t77
1855  t510 = t509*t401
1856  t511 = t18*t510
1857  t513 = t117*t3
1858  t514 = t116*t513
1859  t515 = t338*t14
1860  t517 = t77*r3*t5
1861  t518 = t515*t517
1862  t522 = t119*t348*t77
1863  t525 = t504*t121 - t508*t511 - 0.2e1_dp/0.3e1_dp*t514*t518 - (2._dp &
1864  *t118*t522)
1865  t529 = rootpi
1866  t530 = 0.1e1_dp/t529
1867  t531 = t123*t530
1868  t532 = f32**2
1869  t533 = t532*t1
1870  t534 = t533*t119
1871  t535 = t15*t131
1872  t537 = exp(-t534*t535)
1873  t538 = t126*t27
1874  t539 = t125*t538
1875  t540 = t129*sscale
1876  t542 = t132*r3*t5
1877  t550 = t125*t126*t128
1878  t551 = 0.1e1_dp/t132
1879  t552 = t372*t77
1880  t553 = t34*t377
1881  t554 = t77*t401
1882  t556 = t552 - t553*t554
1883  t557 = t551*t556
1884  t558 = t540*t557
1885  t562 = t537*(-t539*t540*t542/0.3e1_dp - t127*t128*t13*t133 &
1886  + t550*t558/0.2e1_dp)
1887  t563 = t531*t562
1888  t567 = (t493*t113 - 0.7e1_dp/0.2e1_dp*t108*t499 - (t502*t525 &
1889  *t123*t136) + (2._dp*t502*t563))*t140
1890  t569 = t141*t142
1891  t571 = t110*t92*t144
1892  t572 = t571*t453
1893  t575 = -t567*t145 - 0.7e1_dp/0.2e1_dp*t569*t572
1894  t576 = t575*e
1895  t577 = t576*t149
1896  t578 = t189*t13
1897  t581 = 0.1e1_dp/t158/t157
1898  t582 = t149*t581
1899  t583 = t148*t582
1900  t587 = -t345 - t351 + t374 - t404 - 0.2e1_dp/0.3e1_dp*t72*t44*t6
1901  t588 = t156*t587
1902  t589 = t271*t588
1903  t592 = t219*t72
1904  t596 = 0.1e1_dp/t224/t223
1905  t597 = t596*t222
1906  t602 = 0.1e1_dp/t227/t75
1907  t603 = f98*t602
1908  t608 = dexerrho(q, dqrho)
1909  t613 = (t97*(-0.3e1_dp/0.2e1_dp*t221*t597*t409 + t603*t409/ &
1910  0.2e1_dp) + f2716*t608*t233)*alpha3*t185
1911  t617 = f12*t481
1912  t620 = 0.1e1_dp/t495
1913  t621 = t620*t453
1914  t624 = t213*omega
1915  t626 = t27*r3*t5
1916  t629 = t246*t192
1917  t631 = t315*r3*t5
1918  t634 = t602*t409
1919  t638 = 0.1e1_dp/t252/t251
1920  t639 = f916*t638
1921  t644 = 0.1e1_dp/t258/t257
1922  t645 = t644*t256
1923  t653 = (t97*(-t243*t634/0.2e1_dp + 0.3e1_dp/0.2e1_dp*t639*t250* &
1924  t409 - 0.5e1_dp/0.2e1_dp*t255*t645*t409) - t267*t608)*alpha5
1925  t655 = -(2._dp*t285*t449) - (2._dp*t91*t454) - 0.8e1_dp/0.3e1_dp &
1926  *t457*t465 + t577 - t186*t578 + 0.5e1_dp/0.2e1_dp*t583*t589 &
1927  - 0.2e1_dp/0.3e1_dp*t592*t406 + t613*t190 - t81*t93*t453 + &
1928  t617*t94 - t237*t578 - (3._dp*t148*t621) - t624*t626/0.3e1_dp &
1929  - 0.4e1_dp/0.3e1_dp*t629*t631 + t653*t271
1930  t656 = t149*t159
1931  t657 = t148*t656
1932  t658 = t193*t332
1933  t659 = t658*t6
1934  t663 = t273*t409
1935  t666 = dexeirho(q, dqrho)
1936  t669 = (t276*t409 - 2._dp*t197*t663 + t243*t666)*alpha4
1937  t673 = t97/t205/t199
1938  t679 = (-t197*t673*t409/0.2e1_dp - t209*t608)*alpha1
1939  t681 = t241*t409
1940  t685 = (-t197*t681 - f98*t666)*alpha2
1941  t689 = 0.1e1_dp/t290/t289
1942  t690 = t256*t222
1943  t691 = t689*t690
1944  t697 = f2732/t295/t294
1945  t698 = t293*t409
1946  t701 = t638*t250
1947  t711 = (t97*(-0.7e1_dp/0.2e1_dp*t288*t691*t409 + 0.5e1_dp/0.2e1_dp &
1948  *t697*t698 - 0.3e1_dp/0.2e1_dp*t298*t701*t409 + t280*t634/ &
1949  0.2e1_dp) + t307*t608)*alpha7
1950  t713 = 0.1e1_dp/t257
1951  t717 = 0.1e1_dp/t293
1952  t718 = f94*t717
1953  t721 = t321*t409
1954  t728 = (-4._dp*t318*t713*t409 + 3._dp*t718*t409 - 2._dp*t243*t721 &
1955  + t280*t275*t409 + t326*t666)*alpha8
1956  t735 = t176*t147
1957  t736 = t656*t453
1958  t739 = t93*t581
1959  t740 = t739*t588
1960  t746 = t180*t90
1961  t747 = t149*t170
1962  t748 = t747*t453
1963  t752 = 0.1e1_dp/t169/t168
1964  t753 = t93*t752
1965  t754 = t155*t587
1966  t755 = t753*t754
1967  t759 = (-t176*t575*t93*t159 + (2._dp*t735*t736) + 0.5e1_dp/ &
1968  0.2e1_dp*(t735)*(t740) - t180*t481*t93*t170 + (2._dp &
1969  *t746*t748) + 0.3e1_dp/0.2e1_dp*(t746)*(t755))*t185
1970  t761 = t310*t311
1971  t763 = 0.1e1_dp/t8/t461
1972  t765 = t763*r3*t5
1973  t769 = t75*t241
1974  t771 = t409*t200 - t769*t409
1975  t772 = t771*t239
1976  t779 = t151*t147
1977  t780 = t93*t159
1978  t781 = t780*t453
1979  t783 = t83*t581
1980  t784 = t783*t588
1981  t787 = t93*t163
1982  t791 = 0.1e1_dp/t162/t154
1983  t792 = t83*t791
1984  t799 = t166*t90
1985  t800 = t93*t170
1986  t801 = t800*t453
1987  t803 = t83*t752
1988  t804 = t803*t754
1989  t808 = (-t151*t575*t83*t159 + t779*t781 + 0.5e1_dp/0.2e1_dp*t779 &
1990  *t784 + t81*t787*t453 + t81*t792*t587/0.2e1_dp - t166 &
1991  *t481*t83*t170 + t799*t801 + 0.3e1_dp/0.2e1_dp*t799*t804)* &
1992  omega
1993  t810 = t148*t620
1994  t812 = t194*t44*t453
1995  t815 = t270*t193
1996  t816 = t332*r3
1997  t817 = t816*t5
1998  t820 = a*t319
1999  t823 = f98*t321
2000  t826 = r1*t275
2001  t832 = (-3._dp*t820*t409 + 2._dp*t823*t409 - t243*t826*t409 - t280 &
2002  *t666)*alpha6*t284
2003  t834 = 0.5e1_dp/0.3e1_dp*t657*t659 + t669*t247 + t679*t214 + t685 &
2004  *t153 - t577*t195 + t711*t316 + t728*t333 - t174*t626 &
2005  /0.3e1_dp + t759*t190 - 0.7e1_dp/0.3e1_dp*t761*t765 + t197*(t666 &
2006  + t772*t199) + t808*t128 + (3._dp*t810*t812) - 0.5e1_dp/0.3e1_dp &
2007  *t815*t817 + t832*t286
2008  t836 = (t655 + t834)*clda
2009  e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t446*t336 - t80*t836)*sx
2010  t842 = f2*t424
2011  t845 = t842*t68 - t85*t441
2012  t846 = t15*t845
2013  t848 = 2._dp*t412*t88 + t11*t846
2014  t849 = f12*t848
2015  t851 = t452*t444
2016  t865 = t97*(t99*t848*t82 + t99*t90*t444 + 2._dp*t102*t82 &
2017  *t444 + 3._dp*t104*t92*t444)
2018  t867 = t498*t444
2019  t870 = f94*t424
2020  t871 = t870*t117
2021  t873 = t509*t440
2022  t874 = t18*t873
2023  t876 = t68*ndrho
2024  t877 = t116*t876
2025  t880 = t871*t121 - t508*t874 + 2._dp*t877*t121
2026  t884 = f32*t126
2027  t885 = t884*t128
2028  t888 = t425*t77
2029  t889 = t77*t440
2030  t891 = t888 - t553*t889
2031  t892 = t551*t891
2032  t893 = t540*t892
2033  t897 = t537*(t885*t540*t132 + t550*t893/0.2e1_dp)
2034  t898 = t531*t897
2035  t902 = (t865*t113 - 0.7e1_dp/0.2e1_dp*t108*t867 - (t502*t880 &
2036  *t123*t136) + (2._dp*t502*t898))*t140
2037  t904 = t571*t444
2038  t907 = -t902*t145 - 0.7e1_dp/0.2e1_dp*t569*t904
2039  t908 = t907*e
2040  t909 = t908*t149
2041  t910 = t620*t444
2042  t916 = t780*t444
2043  t918 = t156*t444
2044  t919 = t783*t918
2045  t930 = t800*t444
2046  t932 = t155*t444
2047  t933 = t803*t932
2048  t937 = (-t151*t907*t83*t159 + t779*t916 + 0.5e1_dp/0.2e1_dp*t779 &
2049  *t919 + t81*t787*t444 + t81*t792*t444/0.2e1_dp - t166 &
2050  *t848*t83*t170 + t799*t930 + 0.3e1_dp/0.2e1_dp*t799*t933)* &
2051  omega
2052  t942 = t656*t444
2053  t945 = t739*t918
2054  t951 = t747*t444
2055  t954 = t753*t932
2056  t958 = (-t176*t907*t93*t159 + (2._dp*t735*t942) + 0.5e1_dp/ &
2057  0.2e1_dp*(t735)*(t945) - t180*t848*t93*t170 + (2._dp &
2058  *t746*t951) + 0.3e1_dp/0.2e1_dp*(t746)*(t954))*t185
2059  t962 = t194*t44*t444
2060  t965 = t271*t918
2061  t968 = dexeindrho(q, dqndrho)
2062  t971 = t444*t200 - t769*t444
2063  t972 = t971*t239
2064  t979 = dexerndrho(q, dqndrho)
2065  t982 = (-t197*t673*t444/0.2e1_dp - t209*t979)*alpha1
2066  t988 = (-t197*t241*t444 - f98*t968)*alpha2
2067  t1001 = (t97*(-0.3e1_dp/0.2e1_dp*t221*t597*t444 + t603*t444/ &
2068  0.2e1_dp) + f2716*t979*t233)*alpha3*t185
2069  t1009 = (t276*t444 - 2._dp*t197*t273*t444 + t243*t968)*alpha4
2070  t1011 = t602*t444
2071  t1024 = (t97*(-t243*t1011/0.2e1_dp + 0.3e1_dp/0.2e1_dp*t639*t250 &
2072  *t444 - 0.5e1_dp/0.2e1_dp*t255*t645*t444) - t267*t979)*alpha5
2073  t1035 = (-3._dp*t820*t444 + 2._dp*t823*t444 - t243*t826*t444 - &
2074  t280*t968)*alpha6*t284
2075  t1052 = (t97*(-0.7e1_dp/0.2e1_dp*t288*t691*t444 + 0.5e1_dp/0.2e1_dp &
2076  *t697*t293*t444 - 0.3e1_dp/0.2e1_dp*t298*t701*t444 + t280 &
2077  *t1011/0.2e1_dp) + t307*t979)*alpha7
2078  t1066 = (-4._dp*t318*t713*t444 + 3._dp*t718*t444 - 2._dp*t243*t321 &
2079  *t444 + t280*t275*t444 + t326*t968)*alpha8
2080  t1068 = -t81*t93*t444 + t849*t94 - (2._dp*t91*t851) + t909 &
2081  - (3._dp*t148*t910) + t937*t128 + t958*t190 - t909*t195 &
2082  + (3._dp*t810*t962) + 0.5e1_dp/0.2e1_dp*t583*t965 + t197*(t968 &
2083  + t972*t199) + t982*t214 + t988*t153 + t1001*t190 + t1009 &
2084  *t247 + t1024*t271 + t1035*t286 + t1052*t316 + t1066* &
2085  t333
2086  t1069 = t1068*clda
2087  e_ndrho = e_ndrho + (-t80*t1069)*sx
2088  END IF
2089  IF (order >= 2 .OR. order == -2) THEN
2090  t1071 = t332*t13
2091  t1072 = t4*t1071
2092  t1077 = 0.10e2_dp/0.9e1_dp*t1072*t340*t68*t56*t58
2093  t1078 = t44*t347
2094  t1079 = t4*t1078
2095  t1081 = 0.8e1_dp/0.3e1_dp*t1079*t343
2096  t1082 = t14*t371
2097  t1085 = 0.4e1_dp/0.3e1_dp*t339*t1082*t342
2098  t1086 = t4*t515
2099  t1087 = t6*t401
2100  t1090 = 0.4e1_dp/0.3e1_dp*t1086*t553*t1087
2101  t1091 = t29*t14
2102  t1094 = 6._dp*t11*t1091*t69
2103  t1097 = 4._dp*t11*t348*t372
2104  t1098 = t4*t357
2105  t1100 = 4._dp*t1098*t403
2106  t1113 = t24*t763
2107  t1115 = t363*t312
2108  t1119 = t46*t31*t6
2109  t1123 = t27*t390*t31
2110  t1126 = 0.10e2_dp/0.9e1_dp*t16*t3*t332*t15*t312 + 0.8e1_dp/0.3e1_dp &
2111  *t353*t348*t6 + (6._dp*t17*t10*t29*t14) + 0.28e2_dp/ &
2112  0.9e1_dp*t22*t1113*t1115 + 0.32e2_dp/0.3e1_dp*t362*t1119 + (20._dp &
2113  *t25*t1123)
2114  t1127 = t1126*t68
2115  t1129 = t11*t15*t1127
2116  t1132 = 2._dp*t375*t1082*t402
2117  t1134 = 0.1e1_dp/t376/t67
2118  t1135 = t401**2
2119  t1136 = t1134*t1135
2120  t1139 = 2._dp*t375*t340*t1136
2121  t1168 = 0.28e2_dp/0.9e1_dp*t35*t1113*t1115 + 0.32e2_dp/0.3e1_dp*t378 &
2122  *t1119 + (20._dp*t36*t1123) + 0.40e2_dp/0.9e1_dp*t39*t41* &
2123  t463*t385*t312 + 0.50e2_dp/0.3e1_dp*t384*t390*t48*t6 + 0.30e2_dp &
2124  *t42*t44/t28/t346*t48 + (72._dp*t55*t60/t61/t12 &
2125  *t63)
2126  t1169 = t377*t1168
2127  t1171 = t375*t340*t1169
2128  t1173 = t332*t56*t58
2129  t1176 = t1077 + t1081 - t1085 + t1090 + t1094 - t1097 + t1100 + t1129 &
2130  - t1132 + t1139 - t1171 + 0.10e2_dp/0.9e1_dp*t73*t1173
2131  d2qrhorho = f94*t1176*t77
2132  t1178 = t411*t338
2133  t1181 = t14*t424
2134  t1185 = t6*t440
2135  t1208 = -0.4e1_dp/0.3e1_dp*t415*t352*t354 - (4._dp*t416*t358) &
2136  - 0.16e2_dp/0.3e1_dp*t420*t361*t364 - (16._dp*t421*t368)
2137  t1209 = t1208*t68
2138  t1214 = t411*t18
2139  t1220 = t1134*t401*t440
2140  t1236 = -0.16e2_dp/0.3e1_dp*t428*t361*t364 - (16._dp*t429*t368) &
2141  - 0.25e2_dp/0.3e1_dp*t432*t383*t386 - (25._dp*t433*t392) &
2142  - (48._dp*t437*t398)
2143  t1237 = t377*t1236
2144  t1240 = -0.4e1_dp/0.3e1_dp*t1178*t343 - 0.2e1_dp/0.3e1_dp*t339*t1181 &
2145  *t342 + 0.2e1_dp/0.3e1_dp*t1086*t553*t1185 - (4._dp*t412* &
2146  t349) - (2._dp*t11*t348*t425) + (2._dp*t1098*t442) + (2._dp &
2147  *t412*t373) + (t11*t15*t1209) - t375*t1082*t441 &
2148  - (2._dp*t1214*t403) - t375*t1181*t402 + 0.2e1_dp*t375*t340 &
2149  *t1220 - t375*t340*t1237
2150  d2qrhondrho = f94*t1240*t77
2151  t1242 = t119*t13
2152  t1243 = t340*t68
2153  t1257 = 2._dp*a1*t3*t19 + 12._dp*a2*t1*t24*t32
2154  t1258 = t1257*t68
2155  t1264 = t440**2
2156  t1265 = t1134*t1264
2157  t1281 = 12._dp*a3*t1*t24*t32 + 20._dp*a4*t419*t41*t49 + 30._dp &
2158  *a5*t21*t54*t65
2159  t1282 = t377*t1281
2160  t1285 = 2._dp*t1242*t1243 + 4._dp*t412*t426 - 4._dp*t1214*t442 + t11 &
2161  *t15*t1258 - 2._dp*t375*t1181*t441 + 2._dp*t375*t340*t1265 &
2162  - t375*t340*t1282
2163  d2qndrhondrho = f94*t1285*t77
2164  t1287 = t78**2
2165  t1294 = t166*t481
2166  t1297 = t453**2
2167  t1301 = t1077 + t1081 - t1085 + t1090 + t1094 - t1097 + t1100 + t1129 &
2168  - t1132 + t1139 - t1171
2169  t1304 = t166*t181
2170  t1305 = t752*t453
2171  t1306 = t1305*t754
2172  t1309 = t587**2
2173  t1310 = t154*t1309
2174  t1317 = t1077 + t1081 - t1085 + t1090 + t1094 - t1097 + t1100 + t1129 &
2175  - t1132 + t1139 - t1171 + 0.10e2_dp/0.9e1_dp*t72*t332*t312
2176  t1318 = t155*t1317
2177  t1324 = 0.1e1_dp/t169/t156/t155
2178  t1325 = t83*t1324
2179  t1326 = t156*t1309
2180  t1355 = 0.10e2_dp/0.9e1_dp*t1072*t468*t312 + 0.8e1_dp/0.3e1_dp*t1079 &
2181  *t469 - 0.4e1_dp/0.3e1_dp*t339*t14*t478*t6 + (6._dp*t11* &
2182  t1091*t87) - 0.4e1_dp*(t11)*t348*t478 + (t11*t15* &
2183  (f2*t1126*t68 - 2._dp*t475*t402 + 2._dp*t85*t1136 - t85*t1169))
2184  t1379 = t495*t82
2185  t1381 = 0.1e1_dp/t110/t1379
2186  t1382 = t109*t1381
2187  t1392 = t503*t507
2188  t1402 = t116*t1134*t1*t3
2189  t1409 = t116*t377*t4*t44
2190  t1433 = f94*t1126*t117*t121 - (2._dp*t1392*t511) - 0.4e1_dp &
2191  /0.3e1_dp*t503*t513*t518 - (4._dp*t504*t522) + (2._dp*t1402 &
2192  *t18*t509*t1135) + 0.4e1_dp/0.3e1_dp*t1409*t120*t1087 + &
2193  (4._dp*t508*t357*t510) - (t508*t18*t509*t1168) + &
2194  0.10e2_dp/0.9e1_dp*t514*t1071*t14*t77*t56*t58 + 0.8e1_dp/0.3e1_dp &
2195  *t514*t1078*t14*t517 + 0.6e1_dp*t118*t119*t1091*t77
2196  t1437 = t525**2
2197  t1442 = t96*t115*t525
2198  t1445 = t96*t124
2199  t1456 = t533*t1242
2200  t1457 = t377*t77
2201  t1473 = t13*sscale
2202  t1478 = t125*t538*t129
2203  t1479 = sscale*t551
2204  t1491 = 0.1e1_dp/t132/t131
2205  t1492 = t556**2
2206  t1498 = t371*t377
2207  t1501 = t34*t1134
2208  t1520 = t567*t142
2209  t1524 = t110*t82*t144
2210  t1531 = -((t97*(t99*t1355*t82 + 2._dp*t99*t481*t453 + t99 &
2211  *t90*t1301 + 2._dp*t102*t1297 + 2._dp*t102*t82*t1301 + 6._dp* &
2212  t104*t82*t1297 + 3._dp*t104*t92*t1301)*t113) - (7._dp*t493 &
2213  *t499) + 0.63e2_dp/0.4e1_dp*(t108)*(t1382)*(t1297) &
2214  - 0.7e1_dp/0.2e1_dp*(t108)*(t498)*(t1301) - t502 &
2215  *t1433*t123*t136 - t502*t1437*t123*t136 + (4._dp*t1442 &
2216  *t563) + 0.2e1_dp*t1445*t530*(0.2e1_dp/0.3e1_dp*t533*t352* &
2217  t13*t1243*t517 + (2._dp*t534*t348*t131) - (t534*t15 &
2218  *t552) + t1456*t340*t1457*t401)*t562 + 0.2e1_dp*t502* &
2219  t531*t537*(0.4e1_dp/0.9e1_dp*t125*t126*t315*t540*t132* &
2220  t56*t58 + 0.2e1_dp/0.3e1_dp*t539*t1473*t542 - t1478*t1479* &
2221  t6*t556/0.3e1_dp + (2._dp*t127*t128*t347*t133) - t550*t1473 &
2222  *t557 - t550*t540*t1491*t1492/0.4e1_dp + t550*t540* &
2223  t551*(t1127*t77 - 2._dp*t1498*t554 + 2._dp*t1501*t77*t1135 &
2224  - t553*t77*t1168)/0.2e1_dp))*t140*t145 - (7._dp*t1520 &
2225  *t572) - 0.35e2_dp/0.4e1_dp*(t569)*(t1524)*(t1297) &
2226  - 0.7e1_dp/0.2e1_dp*(t569)*(t571)*(t1301)
2227  t1535 = t151*t575
2228  t1543 = (3._dp*t1294*t804) - (2._dp*t799*t747*t1297) + (t799 &
2229  *t800*t1301) - (3._dp*t1304*t1306) + (3._dp*t799 &
2230  *t803*t1310) + 0.3e1_dp/0.2e1_dp*(t799)*(t803)*(t1318) &
2231  - 0.27e2_dp/0.4e1_dp*(t799)*(t1325)*(t1326) - &
2232  t151*t1531*t83*t159 + (2._dp*t1535*t781) + (5._dp*t1535 &
2233  *t784) - (2._dp*t779*t656*t1297)
2234  t1546 = t151*t177
2235  t1547 = t581*t453
2236  t1548 = t1547*t588
2237  t1551 = t156*t1317
2238  t1555 = t168*t1309
2239  t1559 = t156**2
2240  t1562 = 0.1e1_dp/t158/t1559/t155
2241  t1563 = t83*t1562
2242  t1564 = t1559*t1309
2243  t1568 = t149*t163
2244  t1572 = t81*t93
2245  t1573 = t791*t453
2246  t1579 = 0.1e1_dp/t162/t155
2247  t1580 = t83*t1579
2248  t1592 = t779*t780*(t1301) - (5._dp*t1546*t1548) + 0.5e1_dp &
2249  /0.2e1_dp*t779*t783*t1551 + 0.10e2_dp*t779*t783*t1555 - 0.75e2_dp &
2250  /0.4e1_dp*t779*t1563*t1564 - (2._dp*t81*t1568*t1297) &
2251  - t1572*t1573*t587 + (t81*t787*t1301) - 0.3e1_dp/0.4e1_dp &
2252  *(t81)*(t1580)*(t1309) + (t81*t792*t1317) &
2253  /0.2e1_dp - t166*t1355*t83*t170 + (2._dp*t1294*t801)
2254  t1599 = t576*t582
2255  t1602 = 0.1e1_dp/t1379
2256  t1609 = t315*t56*t58
2257  t1615 = t189*t347
2258  t1624 = 0.1e1_dp/t690
2259  t1625 = t409**2
2260  t1633 = f94/t294
2261  t1649 = d2exeirhorho(q, dqrho, d2qrhorho)
2262  t1658 = t148*t620*t581
2263  t1663 = (t1543 + t1592)*omega*t128 + (10._dp*t583*t271*t1555) &
2264  + (5._dp*t1599*t589) + (12._dp*t148*t1602*t1297) - &
2265  (2._dp*t613*t578) + 0.4e1_dp/0.9e1_dp*t624*t1609 - 0.8e1_dp/0.3e1_dp &
2266  *t669*t192*t631 + (2._dp*t186*t1615) + 0.10e2_dp/0.3e1_dp &
2267  *t576*t656*t659 + 0.5e1_dp/0.2e1_dp*(t583)*(t271)*(t1551) &
2268  + ((20._dp*t318*t1624*t1625 - 4._dp*t318*t713*t1176 &
2269  - 12._dp*t1633*t1625 + 3._dp*t718*t1176 + 6._dp*t243*t717*t1625 &
2270  - 2._dp*t243*t321*t1176 - 2._dp*t280*t321*t1625 + t280* &
2271  t275*t1176 + t326*t1649)*alpha8*t333) - (3._dp*t148*t620 &
2272  *t1301) - (15._dp*t1658*t271*t588*t453)
2273  t1677 = t256**2
2274  t1680 = 0.1e1_dp/t290/t1677/t690
2275  t1681 = t1677*t256
2276  t1682 = t1680*t1681
2277  t1686 = t689*t257
2278  t1693 = t293**2
2279  t1697 = f2732/t295/t1693/t250
2280  t1709 = 0.1e1_dp/t252/t293/t250
2281  t1710 = t1709*t293
2282  t1714 = t638*t75
2283  t1722 = 0.1e1_dp/t227/t250
2284  t1723 = t1722*t1625
2285  t1726 = t602*t1176
2286  t1729 = 0.147e3_dp/0.4e1_dp*t288*t1682*t1625 - 0.21e2_dp*t288*t1686 &
2287  *t1625 - 0.7e1_dp/0.2e1_dp*t288*t691*t1176 - 0.75e2_dp/0.4e1_dp &
2288  *t1697*t1693*t1625 + 0.10e2_dp*t697*t251*t1625 + 0.5e1_dp/ &
2289  0.2e1_dp*t697*t293*t1176 + 0.27e2_dp/0.4e1_dp*t298*t1710*t1625 &
2290  - 0.3e1_dp*t298*t1714*t1625 - 0.3e1_dp/0.2e1_dp*t298*t701*t1176 &
2291  - 0.3e1_dp/0.4e1_dp*t280*t1723 + t280*t1726/0.2e1_dp
2292  t1731 = d2exerrhorho(q, dqrho, d2qrhorho)
2293  t1740 = t148*t1602
2294  t1767 = t56**2
2295  t1768 = t58**2
2296  t1770 = t1767*t1768*t28
2297  t1781 = a*t713
2298  t1786 = f98*t717
2299  t1791 = r1*t321
2300  t1802 = ((-2._dp*t823*t1625 + t276*t1176 + 6._dp*t197*t319* &
2301  t1625 - 2._dp*t197*t273*t1176 + t243*t1649)*alpha4*t247) + &
2302  (t97*t1729 + t307*t1731)*alpha7*t316 - 0.40e2_dp/0.9e1_dp*t657 &
2303  *t193*t463*t312 - (12._dp*t1740*t194*t44*t1297) + &
2304  (6._dp*t285*t60*t29) + ((2._dp*t197*t273*t1625 - t197 &
2305  *t241*t1176 - f98*t1649)*alpha2*t153) - (4._dp*t832* &
2306  t449) - (2._dp*t759*t578) + (2._dp*t237*t1615) - (6._dp* &
2307  t576*t621) + f12*t1355*t94 + 0.70e2_dp/0.9e1_dp*t761/t8/t1770 &
2308  *t56*t58 + 0.40e2_dp/0.9e1_dp*t815*t463*t56*t58 + ((12._dp &
2309  *t1781*t1625 - 3._dp*t820*t1176 - 6._dp*t1786*t1625 + 2._dp*t823 &
2310  *t1176 + 2._dp*t243*t1791*t1625 - t243*t826*t1176 - t280 &
2311  *t1649)*alpha6*t284*t286)
2312  t1804 = t620*t159
2313  t1805 = t148*t1804
2314  t1816 = t576*t620
2315  t1827 = t148*t582*t193
2316  t1835 = t148*t149*t1562
2317  t1839 = c*t620
2318  t1846 = t75*t273
2319  t1853 = t771*t275
2320  t1854 = t199*t409
2321  t1860 = t1531*e*t149
2322  t1868 = f916*t1709
2323  t1880 = 0.1e1_dp/t258/t1677/t222
2324  t1881 = t1880*t1677
2325  t1885 = t644*t223
2326  t1898 = -(10._dp*t1805*t658*t6*t453) - 0.14e2_dp/0.3e1_dp*t711 &
2327  *t311*t765 - 0.16e2_dp/0.3e1_dp*t728*t330*t465 + (6._dp*t1816 &
2328  *t812) + (2._dp*t81*t149*t1297) + 0.28e2_dp/0.9e1_dp*t629 &
2329  *t763*t56*t58 - 0.25e2_dp/0.3e1_dp*t1827*t332*t156*t587 &
2330  *r3*t5 - 0.75e2_dp/0.4e1_dp*t1835*t271*t1564 + (6._dp*t91 &
2331  *t1839*t1297) + (t197*(t1649 + (t1176*t200 - 2._dp*t1625 &
2332  *t241 + 2._dp*t1846*t1625 - t769*t1176)*t239*t199 - t1853* &
2333  t1854 + t772*t409)) - t1860*t195 - (t81*t93*t1301) + &
2334  (t97*(0.3e1_dp/0.4e1_dp*t243*t1723 - t243*t1726/0.2e1_dp - 0.27e2_dp &
2335  /0.4e1_dp*(t1868)*(t293)*(t1625) + (3._dp*t639 &
2336  *t75*t1625) + 0.3e1_dp/0.2e1_dp*(t639)*(t250)*(t1176) &
2337  + 0.75e2_dp/0.4e1_dp*(t255)*(t1881)*(t1625) - &
2338  (10._dp*t255*t1885*t1625) - 0.5e1_dp/0.2e1_dp*(t255)*(t645) &
2339  *(t1176)) - t267*t1731)*alpha5*t271
2340  t1906 = 0.1e1_dp/t205/t222
2341  t1907 = t97*t1906
2342  t1923 = t176*t575
2343  t1932 = t176*t147*t149
2344  t1938 = t93*t1562
2345  t1951 = t180*t481
2346  t1956 = t620*t170
2347  t1961 = t180*t90*t149
2348  t1967 = t93*t1324
2349  t1977 = -t176*t1531*t93*t159 + (4._dp*t1923*t736) + (5._dp &
2350  *t1923*t740) - (6._dp*t735*t1804*t1297) - (10._dp*t1932 &
2351  *t1548) + (2._dp*t735*t656*t1301) - 0.75e2_dp/0.4e1_dp*(t735) &
2352  *(t1938)*(t1564) + (10._dp*t735*t739*t1555) &
2353  + 0.5e1_dp/0.2e1_dp*(t735)*(t739)*(t1551) - t180 &
2354  *t1355*t93*t170 + (4._dp*t1951*t748) + (3._dp*t1951*t755) &
2355  - (6._dp*t746*t1956*t1297) - (6._dp*t1961*t1306) + &
2356  (2._dp*t746*t747*t1301) - 0.27e2_dp/0.4e1_dp*(t746)*(t1967) &
2357  *(t1326) + (3._dp*t746*t753*t1310) + 0.3e1_dp/0.2e1_dp &
2358  *(t746)*(t753)*(t1318)
2359  t1983 = 0.1e1_dp/t224/t690
2360  t1984 = t1983*t256
2361  t1988 = t596*t199
2362  t1995 = f98*t1722
2363  t2028 = -0.4e1_dp/0.3e1_dp*t685*t72*t406 - 0.2e1_dp/0.3e1_dp*t679* &
2364  omega*t626 + (0.3e1_dp/0.4e1_dp*t197*t1907*t1625 - t197*t673 &
2365  *t1176/0.2e1_dp - t209*t1731)*alpha1*t214 + 0.4e1_dp/0.9e1_dp &
2366  *t174*t1609 + t1977*t185*t190 + 0.10e2_dp/0.9e1_dp*t592*t1173 &
2367  + (t97*(0.27e2_dp/0.4e1_dp*t221*t1984*t1625 - 0.3e1_dp*t221 &
2368  *t1988*t1625 - 0.3e1_dp/0.2e1_dp*t221*t597*t1176 - 0.3e1_dp/0.4e1_dp &
2369  *t1995*t1625 + t603*t1176/0.2e1_dp) + f2716*t1731*t233) &
2370  *alpha3*t185*t190 + (3._dp*t810*t194*t44*t1301) - (2._dp &
2371  *t91*t452*t1301) - 0.2e1_dp/0.3e1_dp*t808*t626 - 0.10e2_dp &
2372  /0.3e1_dp*t653*t193*t817 + t1860 - (4._dp*t617*t454) + 0.88e2_dp &
2373  /0.9e1_dp*t457/t9/t1770*t56*t58
2374  e_rho_rho = e_rho_rho - 0.4e1_dp/0.9e1_dp/t1287*f89*t336 - 0.8e1_dp/0.3e1_dp*t446* &
2375  t836 - t80*(t1663 + t1802 + t1898 + t2028)*clda
2376  t2059 = t156*t1240
2377  t2072 = t587*t444
2378  t2073 = t581*t156*t2072
2379  t2099 = -0.4e1_dp/0.3e1_dp*t1178*t469 - 0.2e1_dp/0.3e1_dp*t339*t14 &
2380  *t845*t6 - (4._dp*t412*t472) - 0.2e1_dp*t11*t348*t845 + &
2381  (2._dp*t412*t479) + t11*t15*(f2*t1208*t68 - t475* &
2382  t441 - t842*t402 + 2._dp*t85*t1220 - t85*t1237)
2383  t2108 = t444*t453
2384  t2142 = t870*t507
2385  t2144 = t554*t440
2386  t2150 = t116*t377*ndrho*t3
2387  t2173 = (f94*t1208*t117*t121) - t1392*t874 + (2._dp*t503 &
2388  *t876*t121) - (t2142*t511) + (2._dp*t1402*t19*t2144) &
2389  - (2._dp*t2150*t511) - (t508*t18*t509*t1236) - &
2390  0.2e1_dp/0.3e1_dp*t870*t513*t518 + 0.2e1_dp/0.3e1_dp*t1409*t120 &
2391  *t1185 - 0.4e1_dp/0.3e1_dp*t116*(t876)*t3*t518 - (2._dp &
2392  *t871*t522) + (2._dp*t508*t357*t873) - (4._dp*t877*t522)
2393  t2184 = t96*t115*t880
2394  t2197 = t530*(-2._dp*t532*ndrho*t119*t535 - t534*t15*t888 &
2395  + t1456*t340*t1457*t440)
2396  t2224 = t424*t377
2397  t2240 = (t97*(t99*t2099*t82 + t99*t481*t444 + t99*t848 &
2398  *t453 + t99*t90*t1240 + 2._dp*t102*t2108 + 2._dp*t102*t82 &
2399  *t1240 + 6._dp*t104*t486*t444 + 3._dp*t104*t92*t1240)*t113) &
2400  - 0.7e1_dp/0.2e1_dp*t493*t867 - 0.7e1_dp/0.2e1_dp*t865*t499 + 0.63e2_dp &
2401  /0.4e1_dp*(t108)*(t109)*(t1381)*(t453) &
2402  *(t444) - 0.7e1_dp/0.2e1_dp*(t108)*(t498)*(t1240) &
2403  - t502*t2173*t123*t136 - t502*t525*t880*t123*t136 &
2404  + (2._dp*t1442*t898) + (2._dp*t2184*t563) + (2._dp*t1445 &
2405  *t2197*t562) + 0.2e1_dp*t502*t531*t537*(-t884*t27*t129 &
2406  *t133*t6/0.3e1_dp - t1478*t1479*t6*t891/0.6e1_dp - t885 &
2407  *t1473*t132 - t550*t1473*t892/0.2e1_dp + t885*t558/0.2e1_dp &
2408  - t550*t540*t1491*t556*t891/0.4e1_dp + t550*t540*t551 &
2409  *(t1209*t77 - t1498*t889 - t2224*t554 + 2._dp*t1501*t2144 &
2410  - t553*t77*t1236)/0.2e1_dp)
2411  t2245 = t902*t142
2412  t2254 = -t2240*t140*t145 - 0.7e1_dp/0.2e1_dp*t1520*t904 - 0.7e1_dp &
2413  /0.2e1_dp*t2245*t572 - 0.35e2_dp/0.4e1_dp*t569*t1524*t2108 - &
2414  0.7e1_dp/0.2e1_dp*t569*t571*t1240
2415  t2258 = t1547*t918
2416  t2267 = t151*t907
2417  t2269 = t166*t167
2418  t2271 = t752*t154*t2072
2419  t2274 = t81*t792*t1240/0.2e1_dp - t1572*t1573*t444/0.2e1_dp + &
2420  t81*t787*t1240 + 0.5e1_dp/0.2e1_dp*t779*t783*t2059 - 0.2e1_dp &
2421  *t81*t149*t163*t453*t444 + t1294*t930 + 0.5e1_dp/0.2e1_dp* &
2422  t1535*t919 - 0.5e1_dp/0.2e1_dp*t1546*t2073 - t151*t2254*t83 &
2423  *t159 - 0.5e1_dp/0.2e1_dp*t1546*t2258 + t1535*t916 - 0.2e1_dp*t779 &
2424  *t656*t2108 + t779*t780*t1240 + t2267*t781 + (3._dp* &
2425  t2269*t2271)
2426  t2280 = t151*t152
2427  t2282 = t1562*t1559*t2072
2428  t2285 = t166*t848
2429  t2291 = t752*t155*t2072
2430  t2297 = t1305*t932
2431  t2305 = t581*t168*t2072
2432  t2311 = t155*t1240
2433  t2316 = t1324*t156*t2072
2434  t2323 = -(2._dp*t799*t747*t2108) + (t799*t800*t1240) &
2435  - 0.75e2_dp/0.4e1_dp*t2280*t2282 + 0.3e1_dp/0.2e1_dp*t2285*t804 + &
2436  0.5e1_dp/0.2e1_dp*t2267*t784 - 0.3e1_dp/0.2e1_dp*t1304*t2291 - t166 &
2437  *t2099*t83*t170 - 0.3e1_dp/0.2e1_dp*t1304*t2297 - t1572*t791 &
2438  *t587*t444/0.2e1_dp + 0.10e2_dp*t2280*t2305 + 0.3e1_dp/0.2e1_dp &
2439  *t1294*t933 + t2285*t801 + 0.3e1_dp/0.2e1_dp*(t799)*(t803) &
2440  *(t2311) - 0.27e2_dp/0.4e1_dp*t2269*t2316 - 0.3e1_dp/0.4e1_dp &
2441  *t84*t1579*t587*t444
2442  t2329 = t908*t582
2443  t2348 = t176*t907
2444  t2363 = t176*t177
2445  t2371 = -t176*t2254*t93*t159 + (2._dp*t1923*t942) + 0.5e1_dp &
2446  /0.2e1_dp*(t1923)*(t945) + (2._dp*t2348*t736) - (6._dp &
2447  *t735*t1804*t2108) - (5._dp*t1932*t2258) + (2._dp*t735 &
2448  *t656*t1240) + 0.5e1_dp/0.2e1_dp*(t2348)*(t740) - (5._dp &
2449  *t1932*t2073) - 0.75e2_dp/0.4e1_dp*t2363*t2282 + 0.10e2_dp* &
2450  t2363*t2305 + 0.5e1_dp/0.2e1_dp*(t735)*(t739)*(t2059)
2451  t2379 = t180*t848
2452  t2401 = -t180*t2099*t93*t170 + (2._dp*t1951*t951) + 0.3e1_dp &
2453  /0.2e1_dp*(t1951)*(t954) + (2._dp*t2379*t748) - (6._dp &
2454  *t746*t1956*t2108) - (3._dp*t1961*t2297) + (2._dp*t746 &
2455  *t747*t1240) + 0.3e1_dp/0.2e1_dp*(t2379)*(t755) - (3._dp &
2456  *t1961*t2291) - 0.27e2_dp/0.4e1_dp*t95*t2316 + 0.3e1_dp*t95 &
2457  *t2271 + 0.3e1_dp/0.2e1_dp*(t746)*(t753)*(t2311)
2458  t2405 = -0.25e2_dp/0.6e1_dp*t1827*t816*t5*t156*t444 + 0.12e2_dp &
2459  *t148*t1602*t453*t444 - 0.5e1_dp*t1805*t658*t6*t444 + &
2460  0.6e1_dp*t746*t621*t444 + (t2274 + t2323)*omega*t128 - (2._dp &
2461  *t1035*t449) + 0.5e1_dp/0.2e1_dp*t2329*t589 + 0.5e1_dp/0.2e1_dp &
2462  *t1599*t965 - t81*t93*t1240 - 0.7e1_dp/0.3e1_dp*t1052*t311 &
2463  *t765 - t937*t626/0.3e1_dp + (t2371 + t2401)*t185*t190
2464  t2410 = t2254*e*t149
2465  t2437 = t698*t444
2466  t2442 = t75*t409*t444
2467  t2449 = t1722*t409*t444
2468  t2452 = t602*t1240
2469  t2455 = 0.147e3_dp/0.4e1_dp*t288*t1680*t1681*t409*t444 - 0.21e2_dp &
2470  *t288*t689*t257*t409*t444 - 0.7e1_dp/0.2e1_dp*t288*t691 &
2471  *t1240 - 0.75e2_dp/0.4e1_dp*t1697*t1693*t409*t444 + 0.10e2_dp &
2472  *t697*t251*t409*t444 + 0.5e1_dp/0.2e1_dp*t697*t293*t1240 &
2473  + 0.27e2_dp/0.4e1_dp*t298*t1709*t2437 - 0.3e1_dp*t298*t638*t2442 &
2474  - 0.3e1_dp/0.2e1_dp*t298*t701*t1240 - 0.3e1_dp/0.4e1_dp*t280* &
2475  t2449 + t280*t2452/0.2e1_dp
2476  t2457 = d2exerrhondrho(q, dqrho, dqndrho, d2qrhondrho)
2477  t2473 = t409*t444
2478  t2484 = d2exeirhondrho(q, dqrho, dqndrho, d2qrhondrho)
2479  t2499 = -(3._dp*t908*t621) - t1001*t578 - t2410*t195 + t2410 &
2480  + (t97*t2455 + t307*t2457)*alpha7*t316 + 0.5e1_dp/0.2e1_dp* &
2481  t583*t271*t2059 - 0.12e2_dp*t148*t1602*t159*t271*t2108 &
2482  - t982*omega*t626/0.3e1_dp + ((-2._dp*t823*t2473 + t276* &
2483  t1240 + 6._dp*t197*t319*t409*t444 - 2._dp*t197*t273*t1240 + &
2484  t243*t2484)*alpha4*t247) - 0.15e2_dp/0.2e1_dp*t1658*t271*t588 &
2485  *(t444) - 0.4e1_dp/0.3e1_dp*t1009*t192*t631 - 0.3e1_dp*t148 &
2486  *t620*(t1240)
2487  t2512 = t199*t444
2488  t2529 = t721*t444
2489  t2543 = t908*t620
2490  t2573 = (3._dp*t1816*t962) + (t197*(t2484 + (t1240*t200 &
2491  - 2._dp*t681*t444 + 2._dp*t1846*t2473 - t769*t1240)*t239*t199 &
2492  - t1853*t2512 + t772*t444)) - 0.5e1_dp/0.3e1_dp*t1024*t193 &
2493  *t817 + ((12._dp*t1781*t2473 - 3._dp*t820*t1240 - 6._dp*t1786* &
2494  t2473 + 2._dp*t823*t1240 + 2._dp*t243*r1*t2529 - t243*t826* &
2495  t1240 - t280*t2484)*alpha6*t284*t286) + (2._dp*t81*t149 &
2496  *t453*t444) + (3._dp*t2543*t812) + f12*t2099*t94 + (10._dp &
2497  *t583*t271*t168*t587*t444) + ((2._dp*t197*t663 &
2498  *t444 - t197*t241*t1240 - f98*t2484)*alpha2*t153) - 0.8e1_dp &
2499  /0.3e1_dp*t1066*t330*t465 - 0.2e1_dp/0.3e1_dp*t988*t72*t406 &
2500  - 0.75e2_dp/0.4e1_dp*(t1835)*(t271)*(t1559)*(t587) &
2501  *(t444)
2502  t2688 = -(2._dp*t91*t452*t1240) - (2._dp*t617*t851) + (t97 &
2503  *(0.3e1_dp/0.4e1_dp*t243*t2449 - t243*t2452/0.2e1_dp - 0.27e2_dp &
2504  /0.4e1_dp*t1868*t2437 + (3._dp*t639*t2442) + 0.3e1_dp/0.2e1_dp* &
2505  (t639)*(t250)*(t1240) + 0.75e2_dp/0.4e1_dp*t255*t1880 &
2506  *t1677*t409*t444 - 0.10e2_dp*t255*t644*t223*t409* &
2507  t444 - 0.5e1_dp/0.2e1_dp*t255*t645*(t1240)) - t267*t2457) &
2508  *alpha5*t271 - (3._dp*t576*t910) - (2._dp*t849*t454) - &
2509  t958*t578 + (0.20e2_dp*t318*t1624*t409*t444 - 0.4e1_dp*t318 &
2510  *t713*(t1240) - (12._dp*t1633*t2473) + (3._dp*t718* &
2511  t1240) + 0.6e1_dp*t243*t717*t409*t444 - 0.2e1_dp*t243*t321* &
2512  (t1240) - (2._dp*t280*t2529) + (t280*t275*t1240) &
2513  + t326*t2484)*alpha8*t333 + (3._dp*t810*t194*t44*t1240) &
2514  + (0.3e1_dp/0.4e1_dp*t197*t97*t1906*t409*t444 - t197*t673 &
2515  *(t1240)/0.2e1_dp - t209*t2457)*alpha1*t214 + 0.5e1_dp &
2516  /0.3e1_dp*t908*t656*t659 + (t97*(0.27e2_dp/0.4e1_dp*t221*t1983 &
2517  *t256*t409*t444 - 0.3e1_dp*t221*t596*t1854*t444 - 0.3e1_dp &
2518  /0.2e1_dp*t221*t597*(t1240) - 0.3e1_dp/0.4e1_dp*(t1995) &
2519  *(t2473) + (t603*t1240)/0.2e1_dp) + f2716*t2457*t233) &
2520  *alpha3*t185*t190 - 0.15e2_dp/0.2e1_dp*t1658*t271*t453 &
2521  *t156*t444
2522  e_ndrho_rho = e_ndrho_rho - 0.4e1_dp/0.3e1_dp*t446*t1069 - t80*(t2405 + t2499 + t2573 &
2523  + t2688)*clda
2524  t2707 = 2._dp*t119*t88 + 4._dp*t412*t846 + t11*t15*(f2*t1257 &
2525  *t68 - 2._dp*t842*t441 + 2._dp*t85*t1265 - t85*t1282)
2526  t2715 = t444**2
2527  t2764 = t880**2
2528  t2774 = t891**2
2529  t2808 = -((t97*(t99*t2707*t82 + 2._dp*t99*t848*t444 + t99 &
2530  *t90*t1285 + 2._dp*t102*t2715 + 2._dp*t102*t82*t1285 + 6._dp* &
2531  t104*t82*t2715 + 3._dp*t104*t92*t1285)*t113) - (7._dp*t865 &
2532  *t867) + 0.63e2_dp/0.4e1_dp*(t108)*(t1382)*(t2715) &
2533  - 0.7e1_dp/0.2e1_dp*(t108)*(t498)*(t1285) - (t502 &
2534  *(f94*t1257*t117*t121 - 2._dp*t2142*t874 + 4._dp*t870* &
2535  t876*t121 + 2._dp*t1402*t18*t509*t1264 - 4._dp*t2150*t874 - &
2536  t508*t18*t509*t1281 + 2._dp*t116*t68*t3*t18*t509)*t123 &
2537  *t136) - (t502*t2764*t123*t136) + (4._dp*t2184* &
2538  t898) + (2._dp*t1445*t2197*t897) + 0.2e1_dp*(t502)*t531 &
2539  *t537*(t885*t893 - t550*t540*t1491*t2774/0.4e1_dp + t550 &
2540  *t540*t551*(t1258*t77 - 2._dp*t2224*t889 + 2._dp*t1501 &
2541  *t77*t1264 - t553*t77*t1281)/0.2e1_dp))*t140*t145 - (7._dp &
2542  *t2245*t904) - 0.35e2_dp/0.4e1_dp*(t569)*(t1524)*(t2715) &
2543  - 0.7e1_dp/0.2e1_dp*(t569)*(t571)*(t1285)
2544  t2810 = t2808*e*t149
2545  t2838 = t1722*t2715
2546  t2841 = t602*t1285
2547  t2844 = 0.147e3_dp/0.4e1_dp*t288*t1682*t2715 - 0.21e2_dp*t288*t1686 &
2548  *t2715 - 0.7e1_dp/0.2e1_dp*t288*t691*t1285 - 0.75e2_dp/0.4e1_dp &
2549  *t1697*t1693*t2715 + 0.10e2_dp*t697*t251*t2715 + 0.5e1_dp/ &
2550  0.2e1_dp*t697*t293*t1285 + 0.27e2_dp/0.4e1_dp*t298*t1710*t2715 &
2551  - 0.3e1_dp*t298*t1714*t2715 - 0.3e1_dp/0.2e1_dp*t298*t701*t1285 &
2552  - 0.3e1_dp/0.4e1_dp*t280*t2838 + t280*t2841/0.2e1_dp
2553  t2846 = d2exerndrhondrho(q, dqndrho, d2qndrhondrho)
2554  t2875 = d2exeindrhondrho(q, dqndrho, d2qndrhondrho)
2555  t2880 = t2715*t156
2556  t2884 = t1559*t2715
2557  t2927 = t156*t1285
2558  t2963 = t2810 + (t97*t2844 + t307*t2846)*alpha7*t316 + (3._dp &
2559  *t810*t194*t44*t1285) - (6._dp*t908*t910) - (3._dp* &
2560  t148*t620*t1285) + (0.3e1_dp/0.4e1_dp*t197*t1907*t2715 - t197 &
2561  *t673*(t1285)/0.2e1_dp - t209*t2846)*alpha1*t214 + &
2562  (0.2e1_dp*t197*t273*t2715 - t197*t241*(t1285) - f98*t2875) &
2563  *alpha2*t153 - (15._dp*t1658*t271*t2880) - 0.75e2_dp/ &
2564  0.4e1_dp*(t1835)*(t271)*(t2884) + (0.20e2_dp*t318* &
2565  t1624*t2715 - 0.4e1_dp*t318*t713*(t1285) - 0.12e2_dp*t1633 &
2566  *t2715 + (3._dp*t718*t1285) + 0.6e1_dp*t243*t717*t2715 - &
2567  0.2e1_dp*t243*t321*(t1285) - 0.2e1_dp*t280*t321*t2715 + &
2568  t280*t275*(t1285) + t326*t2875)*alpha8*t333 + t197 &
2569  *(t2875 + ((t1285*t200) - 0.2e1_dp*t2715*t241 + 0.2e1_dp*t1846 &
2570  *t2715 - (t769*t1285))*t239*t199 - t971*t275*t2512 &
2571  + t972*t444) + 0.5e1_dp/0.2e1_dp*(t583)*(t271)*(t2927) &
2572  + (t97*(0.3e1_dp/0.4e1_dp*t243*t2838 - t243*t2841/0.2e1_dp &
2573  - 0.27e2_dp/0.4e1_dp*t1868*t293*t2715 + 0.3e1_dp*t639*t75 &
2574  *t2715 + 0.3e1_dp/0.2e1_dp*t639*t250*(t1285) + 0.75e2_dp/0.4e1_dp &
2575  *t255*t1881*t2715 - 0.10e2_dp*t255*t1885*t2715 - 0.5e1_dp &
2576  /0.2e1_dp*t255*t645*(t1285)) - t267*t2846)*alpha5*(t271) &
2577  + (5._dp*t2329*t965) - (t81*t93*t1285)
2578  t2971 = t2715*t155
2579  t2975 = t154*t2715
2580  t2979 = t155*t1285
2581  t2994 = t168*t2715
2582  t3001 = -(2._dp*t799*t747*t2715) + (t799*t800*t1285) &
2583  - (3._dp*t799*t753*t2971) + (3._dp*t799*t803*t2975) + &
2584  0.3e1_dp/0.2e1_dp*(t799)*(t803)*(t2979) - 0.27e2_dp/0.4e1_dp &
2585  *(t799)*(t1325)*(t2880) - (2._dp*t779*t656 &
2586  *t2715) + (t779*t780*t1285) - (5._dp*t779*t739*t2880) &
2587  + (10._dp*t779*t783*t2994) + 0.5e1_dp/0.2e1_dp*(t779) &
2588  *(t783)*(t2927)
2589  t3033 = -0.75e2_dp/0.4e1_dp*t779*t1563*t2884 - (2._dp*t81*t1568 &
2590  *t2715) - (t81*t93*t791*t2715) + (t81*t787*t1285) &
2591  - 0.3e1_dp/0.4e1_dp*(t81)*(t1580)*(t2715) + (t81 &
2592  *t792*t1285)/0.2e1_dp - t166*t2707*t83*t170 + (2._dp &
2593  *t2285*t930) + (3._dp*t2285*t933) - t151*t2808*t83* &
2594  t159 + (2._dp*t2267*t916) + (5._dp*t2267*t919)
2595  t3139 = -t176*t2808*t93*t159 + (4._dp*t2348*t942) + (5._dp &
2596  *t2348*t945) - (6._dp*t735*t1804*t2715) - (10._dp*t735 &
2597  *t582*t2880) + (2._dp*t735*t656*t1285) - 0.75e2_dp/0.4e1_dp &
2598  *(t735)*(t1938)*(t2884) + (10._dp*t735*t739 &
2599  *t2994) + 0.5e1_dp/0.2e1_dp*(t735)*(t739)*(t2927) - &
2600  t180*t2707*t93*t170 + (4._dp*t2379*t951) + (3._dp*t2379 &
2601  *t954) - (6._dp*t746*t1956*t2715) - (6._dp*t746*t149 &
2602  *t752*t2971) + (2._dp*t746*t747*t1285) - 0.27e2_dp/0.4e1_dp &
2603  *(t746)*(t1967)*(t2880) + (3._dp*t746*t753* &
2604  t2975) + 0.3e1_dp/0.2e1_dp*(t746)*(t753)*(t2979)
2605  t3167 = f12*t2707*t94 + (t3001 + t3033)*omega*t128 + (2._dp &
2606  *t81*t149*t2715) + (6._dp*t2543*t962) - t2810*t195 + (10._dp &
2607  *t583*t271*t2994) + (12._dp*t148*t1602*t2715) + &
2608  (t97*(0.27e2_dp/0.4e1_dp*(t221)*(t1984)*(t2715) - &
2609  (3._dp*t221*t1988*t2715) - 0.3e1_dp/0.2e1_dp*(t221)*(t597) &
2610  *(t1285) - 0.3e1_dp/0.4e1_dp*(t1995)*(t2715) + &
2611  (t603*t1285)/0.2e1_dp) + f2716*t2846*t233)*alpha3*t185 &
2612  *t190 + ((-2._dp*t823*t2715 + t276*t1285 + 6._dp*t197*t319 &
2613  *t2715 - 2._dp*t197*t273*t1285 + t243*t2875)*alpha4*t247) &
2614  - (2._dp*t91*t452*t1285) - (4._dp*t849*t851) + t3139 &
2615  *t185*t190 + (6._dp*t91*t1839*t2715) + ((12._dp*t1781 &
2616  *t2715 - 3._dp*t820*t1285 - 6._dp*t1786*t2715 + 2._dp*t823*t1285 &
2617  + 2._dp*t243*t1791*t2715 - t243*t826*t1285 - t280*t2875)* &
2618  alpha6*t284*t286) - (12._dp*t1740*t194*t44*t2715)
2619  e_ndrho_ndrho = e_ndrho_ndrho - t80*(t2963 + t3167)*clda
2620  END IF
2621 
2622  END SUBROUTINE xwpbe_lda_calc_1
2623 
2624 ! **************************************************************************************************
2625 !> \brief Evaluates the screened hole averaged PBE exchange functional for lda.
2626 !> \param e_0 ...
2627 !> \param e_rho ...
2628 !> \param e_ndrho ...
2629 !> \param e_rho_rho ...
2630 !> \param e_ndrho_rho ...
2631 !> \param e_ndrho_ndrho ...
2632 !> \param rho , ndrho: density and norm of the density gradient
2633 !> \param ndrho ...
2634 !> \param omega scaling factor
2635 !> \param sscale scaling factor to enforce Lieb-Oxford bound
2636 !> \param sx scaling factor
2637 !> \param order degree of the derivative that should be evaluated,
2638 !> if positive all the derivatives up to the given degree are evaluated,
2639 !> if negative only the given degree is calculated
2640 !> \par History
2641 !> 05.2007 created [Manuel Guidon]
2642 !> \author Manuel Guidon
2643 !> \note
2644 !> This routine evaluates the functional for omega!=0 using a taylor
2645 !> expansion for the parameter G.
2646 ! **************************************************************************************************
2647  SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, &
2648  e_ndrho_ndrho, rho, ndrho, omega, sscale, sx, order)
2649  REAL(kind=dp), INTENT(INOUT) :: e_0, e_rho, e_ndrho, e_rho_rho, &
2650  e_ndrho_rho, e_ndrho_ndrho
2651  REAL(kind=dp), INTENT(IN) :: rho, ndrho, omega, sscale, sx
2652  INTEGER, INTENT(IN) :: order
2653 
2654  REAL(kind=dp) :: d2qndrhondrho, d2qrhondrho, d2qrhorho, dqndrho, dqrho, q, t1, t10, t100, &
2655  t102, t1022, t1024, t1026, t1029, t103, t1031, t1034, t105, t106, t1061, t1067, t1073, &
2656  t108, t109, t1090, t1093, t1095, t11, t110, t111, t1111, t1118, t1119, t112, t113, t1136, &
2657  t1139, t114, t1141, t1149, t115, t1150, t1151, t1157, t1158, t1159, t116, t1162, t1167, &
2658  t1168, t117, t1178, t118, t1181, t1182, t1186, t1195, t12, t121, t122, t1239, t1241, &
2659  t1243, t125, t1251, t1256, t126, t1261, t1262, t1263, t1266, t127, t1270, t1273, t1274, &
2660  t1275, t1276, t128, t1280, t1287, t1288, t129, t13, t1317, t1321
2661  REAL(kind=dp) :: t1326, t133, t1331, t1332, t1333, t134, t1341, t1342, t1343, t1347, t1351, &
2662  t1355, t136, t1362, t137, t1374, t1379, t1382, t1383, t1385, t1392, t1397, t14, t140, &
2663  t1407, t141, t1417, t1426, t1430, t1434, t1435, t1438, t1442, t1443, t145, t1453, t146, &
2664  t1469, t1473, t1476, t149, t15, t151, t1517, t1519, t153, t1538, t154, t1545, t1546, &
2665  t155, t1552, t1553, t156, t1577, t158, t1584, t1589, t159, t1594, t16, t160, t161, t1613, &
2666  t1614, t1615, t1619, t1626, t163, t1630, t1640, t1644, t1655, t166, t1661, t1666, t1667, &
2667  t167, t1671, t1678, t1691, t1699, t17, t171, t172, t1726, t173
2668  REAL(kind=dp) :: t1732, t1736, t1737, t1742, t1756, t176, t1768, t177, t1773, t1785, t1788, &
2669  t1791, t1795, t18, t1816, t182, t1824, t184, t1841, t185, t1850, t186, t187, t1885, t19, &
2670  t190, t191, t1938, t1946, t196, t1976, t1978, t2, t200, t2018, t202, t204, t2053, t2056, &
2671  t206, t2060, t2066, t2069, t2071, t2072, t2076, t2084, t2086, t209, t2090, t2099, t21, &
2672  t210, t2105, t2111, t2115, t213, t2133, t2136, t214, t215, t2155, t2158, t216, t218, &
2673  t2180, t219, t2195, t22, t220, t2203, t221, t2211, t2233, t226, t227, t2274, t2279, t228, &
2674  t2280, t2283, t23, t230, t2306, t2316, t2323, t233, t2336, t234
2675  REAL(kind=dp) :: t236, t2365, t238, t239, t2391, t24, t243, t2432, t2452, t2454, t247, &
2676  t2473, t248, t2486, t249, t25, t2501, t251, t2511, t2515, t2519, t252, t253, t256, t257, &
2677  t2571, t258, t2604, t261, t266, t2668, t268, t27, t270, t273, t274, t275, t276, t278, &
2678  t279, t28, t281, t282, t284, t289, t29, t292, t293, t295, t296, t298, t299, t3, t301, &
2679  t302, t303, t305, t306, t308, t309, t31, t310, t311, t312, t314, t315, t316, t317, t32, &
2680  t320, t321, t324, t325, t326, t327, t331, t334, t335, t336, t337, t338, t339, t34, t340, &
2681  t341, t346, t347, t348, t349, t35, t353, t355, t36, t361, t364, t365
2682  REAL(kind=dp) :: t366, t367, t369, t372, t374, t375, t378, t379, t38, t382, t383, t384, &
2683  t387, t388, t389, t39, t391, t392, t395, t396, t4, t400, t403, t404, t405, t407, t409, &
2684  t41, t413, t416, t417, t42, t420, t423, t428, t433, t434, t436, t44, t440, t441, t442, &
2685  t443, t447, t448, t452, t453, t454, t457, t458, t46, t461, t464, t467, t468, t470, t474, &
2686  t475, t476, t48, t480, t481, t482, t483, t487, t489, t49, t491, t496, t5, t500, t503, &
2687  t505, t506, t507, t510, t512, t513, t514, t516, t519, t522, t523, t524, t530, t531, t535, &
2688  t536, t54, t541, t542, t549, t55, t551, t552, t558, t559, t56, t561
2689  REAL(kind=dp) :: t565, t566, t569, t574, t577, t579, t58, t583, t584, t585, t587, t588, &
2690  t591, t595, t596, t6, t60, t603, t604, t605, t607, t608, t61, t612, t615, t620, t622, &
2691  t626, t628, t629, t63, t633, t634, t635, t638, t641, t644, t65, t650, t652, t656, t658, &
2692  t659, t660, t665, t67, t670, t671, t679, t68, t681, t685, t687, t689, t69, t692, t695, &
2693  t697, t699, t7, t70, t702, t705, t709, t71, t710, t714, t72, t723, t725, t727, t73, t733, &
2694  t736, t737, t739, t74, t740, t742, t747, t748, t75, t751, t752, t755, t756, t758, t759, &
2695  t760, t761, t767, t769, t77, t770, t78, t781, t783, t784, t788, t793
2696  REAL(kind=dp) :: t796, t8, t80, t802, t805, t809, t81, t813, t816, t819, t82, t822, t823, &
2697  t83, t830, t833, t839, t84, t85, t852, t860, t862, t87, t875, t88, t886, t9, t90, t903, &
2698  t91, t917, t919, t92, t920, t923, t928, t93, t930, t932, t933, t936, t938, t939, t94, &
2699  t943, t944, t947, t95, t950, t951, t953, t954, t956, t959, t96, t963, t966, t968, t97, &
2700  t972, t976, t979, t982, t985, t987, t988, t989, t99, t992
2701 
2702  IF (order >= 0) THEN
2703  t1 = ndrho**2
2704  t2 = r2**2
2705  t3 = 0.1e1_dp/t2
2706  t4 = t1*t3
2707  t5 = pi**2
2708  t6 = r3*t5
2709  t7 = t6*rho
2710  t8 = t7**(0.1e1_dp/0.3e1_dp)
2711  t9 = t8**2
2712  t10 = 0.1e1_dp/t9
2713  t11 = t4*t10
2714  t12 = rho**2
2715  t13 = 0.1e1_dp/t12
2716  t14 = sscale**2
2717  t15 = t13*t14
2718  t16 = a1*t1
2719  t17 = t16*t3
2720  t18 = t10*t13
2721  t19 = t18*t14
2722  t21 = t1**2
2723  t22 = a2*t21
2724  t23 = t2**2
2725  t24 = 0.1e1_dp/t23
2726  t25 = t22*t24
2727  t27 = 0.1e1_dp/t8/t7
2728  t28 = t12**2
2729  t29 = 0.1e1_dp/t28
2730  t31 = t14**2
2731  t32 = t27*t29*t31
2732  t34 = t17*t19 + t25*t32
2733  t35 = a3*t21
2734  t36 = t35*t24
2735  t38 = t21*ndrho
2736  t39 = a4*t38
2737  t41 = 0.1e1_dp/t23/r2
2738  t42 = t39*t41
2739  t44 = 0.1e1_dp/t9/t7
2740  t46 = 0.1e1_dp/t28/rho
2741  t48 = t31*sscale
2742  t49 = t44*t46*t48
2743  t54 = 0.1e1_dp/t23/t2
2744  t55 = a5*t21*t1*t54
2745  t56 = r3**2
2746  t58 = t5**2
2747  t60 = 0.1e1_dp/t56/t58
2748  t61 = t28**2
2749  t63 = t31*t14
2750  t65 = t60/t61*t63
2751  t67 = r1 + t36*t32 + t42*t49 + t55*t65
2752  t68 = 0.1e1_dp/t67
2753  t69 = t34*t68
2754  t70 = t15*t69
2755  t71 = t11*t70
2756  t72 = omega**2
2757  t73 = beta*t72
2758  t74 = t73*t10
2759  t75 = t71 + t74
2760  t77 = 0.1e1_dp/a
2761  q = f94*t75*t77
2762  t78 = rho**(0.1e1_dp/0.3e1_dp)
2763  t80 = t78*rho*f89
2764  t81 = b*f12
2765  t82 = t71 + dd
2766  t83 = 0.1e1_dp/t82
2767  t84 = t81*t83
2768  t85 = f2*t34
2769  t87 = f1 + t85*t68
2770  t88 = t15*t87
2771  t90 = t11*t88 + r1
2772  t91 = f12*t90
2773  t92 = t82**2
2774  t93 = 0.1e1_dp/t92
2775  t94 = c*t93
2776  t95 = t91*t94
2777  t96 = g2*t1
2778  t97 = t96*t3
2779  t99 = g3*t21
2780  t100 = t99*t24
2781  t102 = g1 + t97*t19 + t100*t32
2782  t103 = t15*t102
2783  t105 = t11*t103 + r1
2784  t106 = t105*e
2785  t108 = 0.1e1_dp/t92/t82
2786  t109 = t106*t108
2787  t110 = f158*e
2788  t111 = t105*t83
2789  t112 = t72*t10
2790  t113 = t71 + dd + t112
2791  t114 = t113**2
2792  t115 = t114**2
2793  t116 = t115*t113
2794  t117 = sqrt(t116)
2795  t118 = 0.1e1_dp/t117
2796  t121 = sqrt(t113)
2797  t122 = 0.1e1_dp/t121
2798  t125 = f68*c
2799  t126 = t90*t83
2800  t127 = t114*t113
2801  t128 = sqrt(t127)
2802  t129 = 0.1e1_dp/t128
2803  t133 = (-t110*t111*t118 - t81*t83*t122 - t125*t126*t129) &
2804  *omega
2805  t134 = 0.1e1_dp/t8
2806  t136 = f52*e
2807  t137 = t105*t93
2808  t140 = f12*c
2809  t141 = t90*t93
2810  t145 = t72*omega
2811  t146 = (-t136*t137*t118 - t140*t141*t129)*t145
2812  t149 = 0.1e1_dp/r3/t5
2813  t151 = t149/rho
2814  t153 = t72**2
2815  t154 = t153*omega
2816  t155 = t118*t154
2817  t156 = t155*t44
2818  t158 = f12*a
2819  t159 = exei(q)
2820  t160 = t71 + dd + t74
2821  t161 = 0.1e1_dp/t160
2822  t163 = log(t75*t161)
2823  t166 = rootpi
2824  t167 = sqrt(t160)
2825  t171 = sqrt(a)
2826  t172 = t171*f34
2827  t173 = exer(q)
2828  t176 = (t158*t166/t167 - t172*t173)*alpha1
2829  t177 = omega*t134
2830  t182 = (t158*t161 - f98*t159)*alpha2
2831  t184 = a*f14
2832  t185 = t160**2
2833  t186 = t185*t160
2834  t187 = sqrt(t186)
2835  t190 = sqrt(t75)
2836  t191 = 0.1e1_dp/t190
2837  t196 = 0.1e1_dp/t171
2838  t200 = (t166*(t184/t187 - f98*t191) + f2716*t173*t196)* &
2839  alpha3*t145
2840  t202 = 0.1e1_dp/t75
2841  t204 = 0.1e1_dp/t185
2842  t206 = f8132*t77
2843  t209 = (-f98*t202 + t158*t204 + t206*t159)*alpha4
2844  t210 = t153*t27
2845  t213 = t75**2
2846  t214 = t213*t75
2847  t215 = sqrt(t214)
2848  t216 = 0.1e1_dp/t215
2849  t218 = f38*a
2850  t219 = t185**2
2851  t220 = t219*t160
2852  t221 = sqrt(t220)
2853  t226 = a**2
2854  t227 = t226*a
2855  t228 = sqrt(t227)
2856  t230 = f24364/t228
2857  t233 = (t166*(t206*t191 - f916*t216 + t218/t221) - t230*t173) &
2858  *alpha5
2859  t234 = t154*t44
2860  t236 = 0.1e1_dp/t186
2861  t238 = 0.1e1_dp/t213
2862  t239 = f98*t238
2863  t243 = f729128/t226
2864  t247 = t153*t72
2865  t248 = (a*t236 - t239 + t206*r1*t202 - t243*t159)*alpha6 &
2866  *t247
2867  t249 = t60*t13
2868  t251 = f1516*a
2869  t252 = t219*t186
2870  t253 = sqrt(t252)
2871  t256 = t213**2
2872  t257 = t256*t75
2873  t258 = sqrt(t257)
2874  t261 = f8164*t77
2875  t266 = t226**2
2876  t268 = sqrt(t266*a)
2877  t270 = f2187256/t268
2878  t273 = (t166*(t251/t253 - f2732/t258 + t261*t216 - t243*t191) &
2879  + t270*t173)*alpha7
2880  t274 = t153*t145
2881  t275 = t56*t58
2882  t276 = t275*t12
2883  t278 = 0.1e1_dp/t8/t276
2884  t279 = t274*t278
2885  t281 = r3*a
2886  t282 = 0.1e1_dp/t219
2887  t284 = 0.1e1_dp/t214
2888  t289 = f6561512/t227
2889  t292 = (t281*t282 - f94*t284 + t206*t238 - t243*t202 + t289 &
2890  *t159)*alpha8
2891  t293 = t153**2
2892  t295 = 0.1e1_dp/t9/t276
2893  t296 = t293*t295
2894  t298 = t84 + t95 + t109 + t133*t134 + t146*t151 - t109*t156 + &
2895  t158*(t159 + t163) + t176*t177 + t182*t112 + t200*t151 + &
2896  t209*t210 + t233*t234 + t248*t249 + t273*t279 + t292*t296
2897  t299 = t298*clda
2898  e_0 = e_0 + (-t80*t299)*sx
2899  END IF
2900  IF (order >= 1 .OR. order == -1) THEN
2901  t301 = t44*t13
2902  t302 = t4*t301
2903  t303 = t14*t34
2904  t305 = t68*r3*t5
2905  t306 = t303*t305
2906  t308 = 0.2e1_dp/0.3e1_dp*t302*t306
2907  t309 = t12*rho
2908  t310 = 0.1e1_dp/t309
2909  t311 = t310*t14
2910  t312 = t311*t69
2911  t314 = 2._dp*t11*t312
2912  t315 = t3*t44
2913  t316 = t16*t315
2914  t317 = t15*t6
2915  t320 = t10*t310
2916  t321 = t320*t14
2917  t324 = t24*t278
2918  t325 = t22*t324
2919  t326 = t29*t31
2920  t327 = t326*t6
2921  t331 = t27*t46*t31
2922  t334 = -0.2e1_dp/0.3e1_dp*t316*t317 - (2._dp*t17*t321) - 0.4e1_dp &
2923  /0.3e1_dp*t325*t327 - (4._dp*t25*t331)
2924  t335 = t334*t68
2925  t336 = t15*t335
2926  t337 = t11*t336
2927  t338 = t4*t18
2928  t339 = t67**2
2929  t340 = 0.1e1_dp/t339
2930  t341 = t35*t324
2931  t346 = t41*t295
2932  t347 = t39*t346
2933  t348 = t46*t48
2934  t349 = t348*t6
2935  t353 = 0.1e1_dp/t28/t12
2936  t355 = t44*t353*t48
2937  t361 = t60/t61/rho*t63
2938  t364 = -0.4e1_dp/0.3e1_dp*t341*t327 - (4._dp*t36*t331) - 0.5e1_dp &
2939  /0.3e1_dp*t347*t349 - (5._dp*t42*t355) - (8._dp*t55*t361)
2940  t365 = t340*t364
2941  t366 = t303*t365
2942  t367 = t338*t366
2943  t369 = t44*r3*t5
2944  t372 = -t308 - t314 + t337 - t367 - 0.2e1_dp/0.3e1_dp*t73*t369
2945  dqrho = f94*t372*t77
2946  t374 = ndrho*t3
2947  t375 = t374*t10
2948  t378 = a1*ndrho
2949  t379 = t378*t3
2950  t382 = t1*ndrho
2951  t383 = a2*t382
2952  t384 = t383*t24
2953  t387 = 2._dp*t379*t19 + 4._dp*t384*t32
2954  t388 = t387*t68
2955  t389 = t15*t388
2956  t391 = a3*t382
2957  t392 = t391*t24
2958  t395 = a4*t21
2959  t396 = t395*t41
2960  t400 = a5*t38*t54
2961  t403 = 4._dp*t392*t32 + 5._dp*t396*t49 + 6._dp*t400*t65
2962  t404 = t340*t403
2963  t405 = t303*t404
2964  t407 = 2._dp*t375*t70 + t11*t389 - t338*t405
2965  dqndrho = f94*t407*t77
2966  t409 = t78*f89
2967  t413 = t27*r3*t5
2968  t416 = t14*t102
2969  t417 = t416*t6
2970  t420 = t311*t102
2971  t423 = t96*t315
2972  t428 = t99*t324
2973  t433 = -0.2e1_dp/0.3e1_dp*t423*t317 - (2._dp*t97*t321) - 0.4e1_dp &
2974  /0.3e1_dp*t428*t327 - (4._dp*t100*t331)
2975  t434 = t15*t433
2976  t436 = -0.2e1_dp/0.3e1_dp*t302*t417 - (2._dp*t11*t420) + (t11 &
2977  *t434)
2978  t440 = t136*t105
2979  t441 = t108*t118
2980  t442 = -t308 - t314 + t337 - t367
2981  t443 = t441*t442
2982  t447 = 0.1e1_dp/t117/t116
2983  t448 = t93*t447
2984  t452 = -t308 - t314 + t337 - t367 - 0.2e1_dp/0.3e1_dp*t72*t44*t6
2985  t453 = t115*t452
2986  t454 = t448*t453
2987  t457 = t14*t87
2988  t458 = t457*t6
2989  t461 = t311*t87
2990  t464 = f2*t334
2991  t467 = t464*t68 - t85*t365
2992  t468 = t15*t467
2993  t470 = -0.2e1_dp/0.3e1_dp*t302*t458 - (2._dp*t11*t461) + (t11 &
2994  *t468)
2995  t474 = t140*t90
2996  t475 = t108*t129
2997  t476 = t475*t442
2998  t480 = 0.1e1_dp/t128/t127
2999  t481 = t93*t480
3000  t482 = t114*t452
3001  t483 = t481*t482
3002  t487 = (-t136*t436*t93*t118 + (2._dp*t440*t443) + 0.5e1_dp/ &
3003  0.2e1_dp*(t440)*(t454) - t140*t470*t93*t129 + (2._dp &
3004  *t474*t476) + 0.3e1_dp/0.2e1_dp*(t474)*(t483))*t145
3005  t489 = t209*t153
3006  t491 = t278*r3*t5
3007  t496 = t166/t167/t160
3008  t500 = dexerrho(q, dqrho)
3009  t503 = (-t158*t496*t372/0.2e1_dp - t172*t500)*alpha1
3010  t505 = t106*t441
3011  t506 = t154*t295
3012  t507 = t506*t6
3013  t510 = f12*t470
3014  t512 = t92**2
3015  t513 = 0.1e1_dp/t512
3016  t514 = t106*t513
3017  t516 = t155*t44*t442
3018  t519 = t149*t13
3019  t522 = 0.1e1_dp/t253/t252
3020  t523 = t219*t185
3021  t524 = t522*t523
3022  t530 = f2732/t258/t257
3023  t531 = t256*t372
3024  t535 = 0.1e1_dp/t215/t214
3025  t536 = t535*t213
3026  t541 = 0.1e1_dp/t190/t75
3027  t542 = t541*t372
3028  t549 = (t166*(-0.7e1_dp/0.2e1_dp*t251*t524*t372 + 0.5e1_dp/0.2e1_dp &
3029  *t530*t531 - 0.3e1_dp/0.2e1_dp*t261*t536*t372 + t243*t542 &
3030  /0.2e1_dp) + t270*t500)*alpha7
3031  t551 = c*t108
3032  t552 = t551*t442
3033  t558 = t436*e
3034  t559 = t558*t108
3035  t561 = 0.1e1_dp/t220
3036  t565 = 0.1e1_dp/t256
3037  t566 = f94*t565
3038  t569 = t284*t372
3039  t574 = dexeirho(q, dqrho)
3040  t577 = (-4._dp*t281*t561*t372 + 3._dp*t566*t372 - 2._dp*t206*t569 &
3041  + t243*t238*t372 + t289*t574)*alpha8
3042  t579 = -t133*t413/0.3e1_dp + t487*t151 - 0.4e1_dp/0.3e1_dp*t489* &
3043  t491 + t503*t177 + 0.5e1_dp/0.3e1_dp*t505*t507 + t510*t94 + (3._dp &
3044  *t514*t516) - t146*t519 + t549*t279 - (2._dp*t91*t552) &
3045  - t81*t93*t442 - t200*t519 - t559*t156 + t577*t296 &
3046  + t559
3047  t583 = t110*t105
3048  t584 = t93*t118
3049  t585 = t584*t442
3050  t587 = t83*t447
3051  t588 = t587*t453
3052  t591 = t93*t122
3053  t595 = 0.1e1_dp/t121/t113
3054  t596 = t83*t595
3055  t603 = t125*t90
3056  t604 = t93*t129
3057  t605 = t604*t442
3058  t607 = t83*t480
3059  t608 = t607*t482
3060  t612 = (-t110*t436*t83*t118 + t583*t585 + 0.5e1_dp/0.2e1_dp*t583 &
3061  *t588 + t81*t591*t442 + t81*t596*t452/0.2e1_dp - t125 &
3062  *t470*t83*t129 + t603*t605 + 0.3e1_dp/0.2e1_dp*t603*t608)* &
3063  omega
3064  t615 = t236*t372
3065  t620 = (t239*t372 - 2._dp*t158*t615 + t206*t574)*alpha4
3066  t622 = t513*t442
3067  t626 = t75*t204
3068  t628 = t372*t161 - t626*t372
3069  t629 = t628*t202
3070  t633 = t233*t154
3071  t634 = t295*r3
3072  t635 = t634*t5
3073  t638 = a*t282
3074  t641 = f98*t284
3075  t644 = r1*t238
3076  t650 = (-3._dp*t638*t372 + 2._dp*t641*t372 - t206*t644*t372 - t243 &
3077  *t574)*alpha6*t247
3078  t652 = t204*t372
3079  t656 = (-t158*t652 - f98*t574)*alpha2
3080  t658 = t108*t447
3081  t659 = t106*t658
3082  t660 = t234*t453
3083  t665 = f916*t535
3084  t670 = 0.1e1_dp/t221/t220
3085  t671 = t670*t219
3086  t679 = (t166*(-t206*t542/0.2e1_dp + 0.3e1_dp/0.2e1_dp*t665*t213 &
3087  *t372 - 0.5e1_dp/0.2e1_dp*t218*t671*t372) - t230*t500)*alpha5
3088  t681 = t292*t293
3089  t685 = t56*r3*t58*t5*t309
3090  t687 = 0.1e1_dp/t9/t685
3091  t689 = t687*r3*t5
3092  t692 = t60*t310
3093  t695 = t273*t274
3094  t697 = 0.1e1_dp/t8/t685
3095  t699 = t697*r3*t5
3096  t702 = t176*omega
3097  t705 = t182*t72
3098  t709 = 0.1e1_dp/t187/t186
3099  t710 = t709*t185
3100  t714 = f98*t541
3101  t723 = (t166*(-0.3e1_dp/0.2e1_dp*t184*t710*t372 + t714*t372/ &
3102  0.2e1_dp) + f2716*t500*t196)*alpha3*t145
3103  t725 = t612*t134 + t620*t210 - (3._dp*t106*t622) + t158*(t574 &
3104  + t629*t160) - 0.5e1_dp/0.3e1_dp*t633*t635 + t650*t249 + &
3105  t656*t112 + 0.5e1_dp/0.2e1_dp*t659*t660 + t679*t234 - 0.8e1_dp/ &
3106  0.3e1_dp*t681*t689 - (2._dp*t248*t692) - 0.7e1_dp/0.3e1_dp*t695 &
3107  *t699 - t702*t413/0.3e1_dp - 0.2e1_dp/0.3e1_dp*t705*t369 + t723 &
3108  *t151
3109  t727 = (t579 + t725)*clda
3110  e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t409*t299 - t80*t727)*sx
3111  t733 = f2*t387
3112  t736 = t733*t68 - t85*t404
3113  t737 = t15*t736
3114  t739 = 2._dp*t375*t88 + t11*t737
3115  t740 = f12*t739
3116  t742 = t551*t407
3117  t747 = g2*ndrho
3118  t748 = t747*t3
3119  t751 = g3*t382
3120  t752 = t751*t24
3121  t755 = 2._dp*t748*t19 + 4._dp*t752*t32
3122  t756 = t15*t755
3123  t758 = 2._dp*t375*t103 + t11*t756
3124  t759 = t758*e
3125  t760 = t759*t108
3126  t761 = t513*t407
3127  t767 = t584*t407
3128  t769 = t115*t407
3129  t770 = t587*t769
3130  t781 = t604*t407
3131  t783 = t114*t407
3132  t784 = t607*t783
3133  t788 = (-t110*t758*t83*t118 + t583*t767 + 0.5e1_dp/0.2e1_dp*t583 &
3134  *t770 + t81*t591*t407 + t81*t596*t407/0.2e1_dp - t125 &
3135  *t739*t83*t129 + t603*t781 + 0.3e1_dp/0.2e1_dp*t603*t784)* &
3136  omega
3137  t793 = t441*t407
3138  t796 = t448*t769
3139  t802 = t475*t407
3140  t805 = t481*t783
3141  t809 = (-t136*t758*t93*t118 + (2._dp*t440*t793) + 0.5e1_dp/ &
3142  0.2e1_dp*(t440)*(t796) - t140*t739*t93*t129 + (2._dp &
3143  *t474*t802) + 0.3e1_dp/0.2e1_dp*(t474)*(t805))*t145
3144  t813 = t155*t44*t407
3145  t816 = t234*t769
3146  t819 = dexeindrho(q, dqndrho)
3147  t822 = t407*t161 - t626*t407
3148  t823 = t822*t202
3149  t830 = dexerndrho(q, dqndrho)
3150  t833 = (-t158*t496*t407/0.2e1_dp - t172*t830)*alpha1
3151  t839 = (-t158*t204*t407 - f98*t819)*alpha2
3152  t852 = (t166*(-0.3e1_dp/0.2e1_dp*t184*t710*t407 + t714*t407/ &
3153  0.2e1_dp) + f2716*t830*t196)*alpha3*t145
3154  t860 = (t239*t407 - 2._dp*t158*t236*t407 + t206*t819)*alpha4
3155  t862 = t541*t407
3156  t875 = (t166*(-t206*t862/0.2e1_dp + 0.3e1_dp/0.2e1_dp*t665*t213 &
3157  *t407 - 0.5e1_dp/0.2e1_dp*t218*t671*t407) - t230*t830)*alpha5
3158  t886 = (-3._dp*t638*t407 + 2._dp*t641*t407 - t206*t644*t407 - t243 &
3159  *t819)*alpha6*t247
3160  t903 = (t166*(-0.7e1_dp/0.2e1_dp*t251*t524*t407 + 0.5e1_dp/0.2e1_dp &
3161  *t530*t256*t407 - 0.3e1_dp/0.2e1_dp*t261*t536*t407 + t243 &
3162  *t862/0.2e1_dp) + t270*t830)*alpha7
3163  t917 = (-4._dp*t281*t561*t407 + 3._dp*t566*t407 - 2._dp*t206*t284 &
3164  *t407 + t243*t238*t407 + t289*t819)*alpha8
3165  t919 = -t81*t93*t407 + t740*t94 - (2._dp*t91*t742) + t760 &
3166  - (3._dp*t106*t761) + t788*t134 + t809*t151 - t760*t156 &
3167  + (3._dp*t514*t813) + 0.5e1_dp/0.2e1_dp*t659*t816 + t158*(t819 &
3168  + t823*t160) + t833*t177 + t839*t112 + t852*t151 + t860 &
3169  *t210 + t875*t234 + t886*t249 + t903*t279 + t917*t296
3170  t920 = t919*clda
3171  e_ndrho = e_ndrho + (-t80*t920)*sx
3172  END IF
3173  IF (order >= 2 .OR. order == -2) THEN
3174  t923 = t4*t295*t13
3175  t928 = 0.10e2_dp/0.9e1_dp*t923*t303*t68*t56*t58
3176  t930 = t4*t44*t310
3177  t932 = 0.8e1_dp/0.3e1_dp*t930*t306
3178  t933 = t14*t334
3179  t936 = 0.4e1_dp/0.3e1_dp*t302*t933*t305
3180  t938 = t4*t301*t14
3181  t939 = t34*t340
3182  t943 = 0.4e1_dp/0.3e1_dp*t938*t939*t6*t364
3183  t944 = t29*t14
3184  t947 = 6._dp*t11*t944*t69
3185  t950 = 4._dp*t11*t311*t335
3186  t951 = t4*t320
3187  t953 = 4._dp*t951*t366
3188  t954 = t3*t295
3189  t956 = t15*t275
3190  t959 = t311*t6
3191  t963 = t10*t29*t14
3192  t966 = t24*t697
3193  t968 = t326*t275
3194  t972 = t46*t31*t6
3195  t976 = t27*t353*t31
3196  t979 = 0.10e2_dp/0.9e1_dp*t16*t954*t956 + 0.8e1_dp/0.3e1_dp*t316* &
3197  t959 + (6._dp*t17*t963) + 0.28e2_dp/0.9e1_dp*t22*t966*t968 + &
3198  0.32e2_dp/0.3e1_dp*t325*t972 + (20._dp*t25*t976)
3199  t982 = t11*t15*t979*t68
3200  t985 = 2._dp*t338*t933*t365
3201  t987 = 0.1e1_dp/t339/t67
3202  t988 = t364**2
3203  t989 = t987*t988
3204  t992 = 2._dp*t338*t303*t989
3205  t1022 = t340*(0.28e2_dp/0.9e1_dp*t35*t966*t968 + 0.32e2_dp/0.3e1_dp &
3206  *t341*t972 + (20._dp*t36*t976) + 0.40e2_dp/0.9e1_dp*t39*t41 &
3207  *t687*t348*t275 + 0.50e2_dp/0.3e1_dp*t347*t353*t48*t6 + &
3208  0.30e2_dp*t42*t44/t28/t309*t48 + (72._dp*t55*t60/t61 &
3209  /t12*t63))
3210  t1024 = t338*t303*t1022
3211  t1026 = t295*t56*t58
3212  t1029 = t928 + t932 - t936 + t943 + t947 - t950 + t953 + t982 - t985 &
3213  + t992 - t1024 + 0.10e2_dp/0.9e1_dp*t73*t1026
3214  d2qrhorho = f94*t1029*t77
3215  t1031 = t374*t301
3216  t1034 = t14*t387
3217  t1061 = -0.4e1_dp/0.3e1_dp*t378*t315*t317 - (4._dp*t379*t321) &
3218  - 0.16e2_dp/0.3e1_dp*t383*t324*t327 - (16._dp*t384*t331)
3219  t1067 = t374*t18
3220  t1073 = t987*t364*t403
3221  t1090 = t340*(-0.16e2_dp/0.3e1_dp*t391*t324*t327 - (16._dp*t392 &
3222  *t331) - 0.25e2_dp/0.3e1_dp*t395*t346*t349 - (25._dp*t396 &
3223  *t355) - (48._dp*t400*t361))
3224  t1093 = -0.4e1_dp/0.3e1_dp*t1031*t306 - 0.2e1_dp/0.3e1_dp*t302*t1034 &
3225  *t305 + 0.2e1_dp/0.3e1_dp*t938*t939*t6*t403 - (4._dp*t375 &
3226  *t312) - (2._dp*t11*t311*t388) + (2._dp*t951*t405) + (2._dp &
3227  *t375*t336) + (t11*t15*t1061*t68) - t338*t933 &
3228  *t404 - (2._dp*t1067*t366) - t338*t1034*t365 + 0.2e1_dp*t338 &
3229  *t303*t1073 - t338*t303*t1090
3230  d2qrhondrho = f94*t1093*t77
3231  t1095 = t3*t10
3232  t1111 = 2._dp*a1*t3*t19 + 12._dp*a2*t1*t24*t32
3233  t1118 = t403**2
3234  t1119 = t987*t1118
3235  t1136 = t340*(12._dp*a3*t1*t24*t32 + 20._dp*a4*t382*t41*t49 &
3236  + 30._dp*a5*t21*t54*t65)
3237  t1139 = 2._dp*t1095*t13*t303*t68 + 4._dp*t375*t389 - 4._dp*t1067 &
3238  *t405 + t11*t15*t1111*t68 - 2._dp*t338*t1034*t404 + 2._dp*t338 &
3239  *t303*t1119 - t338*t303*t1136
3240  d2qndrhondrho = f94*t1139*t77
3241  t1141 = t78**2
3242  t1149 = 0.1e1_dp/t512/t82
3243  t1150 = t106*t1149
3244  t1151 = t442**2
3245  t1157 = 0.1e1_dp/t190/t213
3246  t1158 = t372**2
3247  t1159 = t1157*t1158
3248  t1162 = t541*t1029
3249  t1167 = 0.1e1_dp/t215/t256/t213
3250  t1168 = f916*t1167
3251  t1178 = t219**2
3252  t1181 = 0.1e1_dp/t221/t1178/t185
3253  t1182 = t1181*t1178
3254  t1186 = t670*t186
3255  t1195 = d2exerrhorho(q, dqrho, d2qrhorho)
3256  t1239 = 0.10e2_dp/0.9e1_dp*t923*t416*t275 + 0.8e1_dp/0.3e1_dp*t930 &
3257  *t417 - 0.4e1_dp/0.3e1_dp*t302*t14*t433*t6 + (6._dp*t11*t944 &
3258  *t102) - 0.4e1_dp*(t11)*t311*t433 + (t11)*t15* &
3259  (0.10e2_dp/0.9e1_dp*t96*t954*t956 + 0.8e1_dp/0.3e1_dp*t423*t959 &
3260  + (6._dp*t97*t963) + 0.28e2_dp/0.9e1_dp*t99*t966*t968 + 0.32e2_dp &
3261  /0.3e1_dp*t428*t972 + (20._dp*t100*t976))
3262  t1241 = t1239*e*t108
3263  t1243 = t278*t56*t58
3264  t1251 = t136*t436
3265  t1256 = t513*t118
3266  t1261 = t136*t105*t108
3267  t1262 = t447*t442
3268  t1263 = t1262*t453
3269  t1266 = t928 + t932 - t936 + t943 + t947 - t950 + t953 + t982 - t985 &
3270  + t992 - t1024
3271  t1270 = t115**2
3272  t1273 = 0.1e1_dp/t117/t1270/t114
3273  t1274 = t93*t1273
3274  t1275 = t452**2
3275  t1276 = t1270*t1275
3276  t1280 = t127*t1275
3277  t1287 = t928 + t932 - t936 + t943 + t947 - t950 + t953 + t982 - t985 &
3278  + t992 - t1024 + 0.10e2_dp/0.9e1_dp*t72*t295*t275
3279  t1288 = t115*t1287
3280  t1317 = 0.10e2_dp/0.9e1_dp*t923*t457*t275 + 0.8e1_dp/0.3e1_dp*t930 &
3281  *t458 - 0.4e1_dp/0.3e1_dp*t302*t14*t467*t6 + (6._dp*t11*t944 &
3282  *t87) - 0.4e1_dp*(t11)*t311*t467 + (t11*t15*(f2 &
3283  *t979*t68 - 2._dp*t464*t365 + 2._dp*t85*t989 - t85*t1022))
3284  t1321 = t140*t470
3285  t1326 = t513*t129
3286  t1331 = t140*t90*t108
3287  t1332 = t480*t442
3288  t1333 = t1332*t482
3289  t1341 = 0.1e1_dp/t128/t115/t114
3290  t1342 = t93*t1341
3291  t1343 = t115*t1275
3292  t1347 = t113*t1275
3293  t1351 = t114*t1287
3294  t1355 = -t136*t1239*t93*t118 + (4._dp*t1251*t443) + (5._dp &
3295  *t1251*t454) - (6._dp*t440*t1256*t1151) - (10._dp*t1261 &
3296  *t1263) + (2._dp*t440*t441*t1266) - 0.75e2_dp/0.4e1_dp*(t440) &
3297  *(t1274)*(t1276) + (10._dp*t440*t448*t1280) &
3298  + 0.5e1_dp/0.2e1_dp*(t440)*(t448)*(t1288) - t140 &
3299  *t1317*t93*t129 + (4._dp*t1321*t476) + (3._dp*t1321*t483) &
3300  - (6._dp*t474*t1326*t1151) - (6._dp*t1331*t1333) + &
3301  (2._dp*t474*t475*t1266) - 0.27e2_dp/0.4e1_dp*(t474)*(t1342) &
3302  *(t1343) + (3._dp*t474*t481*t1347) + 0.3e1_dp/0.2e1_dp &
3303  *(t474)*(t481)*(t1351)
3304  t1362 = t106*t658*t154
3305  t1374 = d2exeirhorho(q, dqrho, d2qrhorho)
3306  t1379 = t558*t658
3307  t1382 = t56**2
3308  t1383 = t58**2
3309  t1385 = t1382*t1383*t28
3310  t1392 = -(12._dp*t1150*t155*t44*t1151) + (t166*(0.3e1_dp/0.4e1_dp &
3311  *t206*t1159 - t206*t1162/0.2e1_dp - 0.27e2_dp/0.4e1_dp*t1168 &
3312  *t256*t1158 + 0.3e1_dp*t665*t75*t1158 + 0.3e1_dp/0.2e1_dp*t665 &
3313  *t213*t1029 + 0.75e2_dp/0.4e1_dp*t218*t1182*t1158 - 0.10e2_dp &
3314  *t218*t1186*t1158 - 0.5e1_dp/0.2e1_dp*t218*t671*t1029) - t230 &
3315  *t1195)*alpha5*t234 + 0.28e2_dp/0.9e1_dp*t489*t697*t56 &
3316  *t58 + 0.10e2_dp/0.3e1_dp*t558*t441*t507 + t1241 + 0.4e1_dp/0.9e1_dp &
3317  *t702*t1243 + 0.4e1_dp/0.9e1_dp*t133*t1243 + t1355*t145*t151 &
3318  - (2._dp*t91*t551*t1266) - 0.25e2_dp/0.3e1_dp*t1362*t295 &
3319  *t115*t452*r3*t5 + (0.2e1_dp*t158*t236*t1158 - t158*t204 &
3320  *t1029 - f98*t1374)*alpha2*t112 + (5._dp*t1379*t660) &
3321  + 0.70e2_dp/0.9e1_dp*t695/t8/t1385*t56*t58
3322  t1397 = t106*t108*t1273
3323  t1407 = t110*t436
3324  t1417 = t110*t137
3325  t1426 = t83*t1273
3326  t1430 = t108*t122
3327  t1434 = t81*t93
3328  t1435 = t595*t442
3329  t1438 = -t110*t1239*t83*t118 + (2._dp*t1407*t585) + (5._dp &
3330  *t1407*t588) - (2._dp*t583*t441*t1151) + (t583*t584 &
3331  *t1266) - (5._dp*t1417*t1263) + (10._dp*t583*t587*t1280) &
3332  + 0.5e1_dp/0.2e1_dp*(t583)*(t587)*(t1288) - 0.75e2_dp &
3333  /0.4e1_dp*(t583)*(t1426)*(t1276) - (2._dp*t81 &
3334  *t1430*t1151) - t1434*t1435*t452
3335  t1442 = 0.1e1_dp/t121/t114
3336  t1443 = t83*t1442
3337  t1453 = t125*t470
3338  t1469 = t83*t1341
3339  t1473 = t125*t141
3340  t1476 = t81*t591*(t1266) - 0.3e1_dp/0.4e1_dp*t81*t1443*t1275 &
3341  + t81*t596*t1287/0.2e1_dp - t125*t1317*t83*t129 + (2._dp &
3342  *t1453*t605) + (3._dp*t1453*t608) - (2._dp*t603*t475 &
3343  *t1151) + (t603*t604*t1266) + (3._dp*t603*t607*t1347) &
3344  + 0.3e1_dp/0.2e1_dp*(t603)*(t607)*(t1351) - 0.27e2_dp &
3345  /0.4e1_dp*(t603)*(t1469)*(t1343) - (3._dp*t1473 &
3346  *t1333)
3347  t1517 = -0.16e2_dp/0.3e1_dp*t577*t293*t689 - 0.75e2_dp/0.4e1_dp*t1397 &
3348  *t234*t1276 + 0.5e1_dp/0.2e1_dp*t659*t234*t1288 + (t1438 + &
3349  t1476)*omega*t134 + f12*t1317*t94 - (4._dp*t650*t692) &
3350  - 0.14e2_dp/0.3e1_dp*t549*t274*t699 + (12._dp*t106*t1149* &
3351  t1151) - (3._dp*t106*t513*t1266) - 0.40e2_dp/0.9e1_dp*t505*t154 &
3352  *t687*t275 + ((-2._dp*t641*t1158 + t239*t1029 + 6._dp*t158 &
3353  *t282*t1158 - 2._dp*t158*t236*t1029 + t206*t1374)*alpha4 &
3354  *t210) - (6._dp*t558*t622) + (6._dp*t248*t60*t29) - &
3355  (4._dp*t510*t552)
3356  t1519 = t149*t310
3357  t1538 = t75*t236
3358  t1545 = t628*t238
3359  t1546 = t160*t372
3360  t1552 = 0.1e1_dp/t167/t185
3361  t1553 = t166*t1552
3362  t1577 = (2._dp*t146*t1519) - (2._dp*t723*t519) + 0.10e2_dp/0.9e1_dp &
3363  *t705*t1026 - t1241*t156 - 0.10e2_dp/0.3e1_dp*t679*t154 &
3364  *t635 - 0.2e1_dp/0.3e1_dp*t503*omega*t413 + (2._dp*t200*t1519) &
3365  + (t158*(t1374 + (t1029*t161 - 2._dp*t1158*t204 + 2._dp* &
3366  t1538*t1158 - t626*t1029)*t202*t160 - t1545*t1546 + t629 &
3367  *t372)) + (0.3e1_dp/0.4e1_dp*(t158)*(t1553)*(t1158) &
3368  - (t158*t496*t1029)/0.2e1_dp - t172*t1195)*alpha1*t177 &
3369  - 0.8e1_dp/0.3e1_dp*t620*t153*t491 - t81*t93*t1266 - 0.2e1_dp &
3370  /0.3e1_dp*t612*t413 + 0.88e2_dp/0.9e1_dp*t681/t9/t1385*t56 &
3371  *t58
3372  t1584 = a*t561
3373  t1589 = f98*t565
3374  t1594 = r1*t284
3375  t1613 = 0.1e1_dp/t253/t1178/t523
3376  t1614 = t1178*t219
3377  t1615 = t1613*t1614
3378  t1619 = t522*t220
3379  t1626 = t256**2
3380  t1630 = f2732/t258/t1626/t213
3381  t1640 = t1167*t256
3382  t1644 = t535*t75
3383  t1655 = 0.147e3_dp/0.4e1_dp*t251*t1615*t1158 - 0.21e2_dp*t251*t1619 &
3384  *t1158 - 0.7e1_dp/0.2e1_dp*t251*t524*t1029 - 0.75e2_dp/0.4e1_dp &
3385  *t1630*t1626*t1158 + 0.10e2_dp*t530*t214*t1158 + 0.5e1_dp/ &
3386  0.2e1_dp*t530*t256*t1029 + 0.27e2_dp/0.4e1_dp*t261*t1640*t1158 &
3387  - 0.3e1_dp*t261*t1644*t1158 - 0.3e1_dp/0.2e1_dp*t261*t536*t1029 &
3388  - 0.3e1_dp/0.4e1_dp*t243*t1159 + t243*t1162/0.2e1_dp
3389  t1661 = c*t513
3390  t1666 = 0.1e1_dp/t187/t523
3391  t1667 = t1666*t219
3392  t1671 = t709*t160
3393  t1678 = f98*t1157
3394  t1691 = 0.1e1_dp/t523
3395  t1699 = f94/t257
3396  t1726 = t106*t1256
3397  t1732 = t558*t513
3398  t1736 = t106*t513*t447
3399  t1737 = t442*t115
3400  t1742 = -(2._dp*t487*t519) + 0.40e2_dp/0.9e1_dp*t633*t687*t56 &
3401  *t58 + ((12._dp*t1584*t1158 - 3._dp*t638*t1029 - 6._dp*t1589* &
3402  t1158 + 2._dp*t641*t1029 + 2._dp*t206*t1594*t1158 - t206*t644 &
3403  *t1029 - t243*t1374)*alpha6*t247*t249) - 0.4e1_dp/0.3e1_dp* &
3404  t656*t72*t369 + (2._dp*t81*t108*t1151) + (t166*t1655 &
3405  + t270*t1195)*alpha7*t279 + (6._dp*t91*t1661*t1151) + &
3406  (t166*(0.27e2_dp/0.4e1_dp*(t184)*(t1667)*(t1158) - &
3407  (3._dp*t184*t1671*t1158) - 0.3e1_dp/0.2e1_dp*(t184)*(t710) &
3408  *(t1029) - 0.3e1_dp/0.4e1_dp*(t1678)*(t1158) &
3409  + (t714*t1029)/0.2e1_dp) + f2716*t1195*t196)*alpha3*t145 &
3410  *t151 + ((20._dp*t281*t1691*t1158 - 4._dp*t281*t561*t1029 &
3411  - 12._dp*t1699*t1158 + 3._dp*t566*t1029 + 6._dp*t206*t565*t1158 &
3412  - 2._dp*t206*t284*t1029 - 2._dp*t243*t284*t1158 + t243* &
3413  t238*t1029 + t289*t1374)*alpha8*t296) + (10._dp*t659*t234 &
3414  *t1280) + (3._dp*t514*t155*t44*t1266) - (10._dp*t1726 &
3415  *t506*t442*r3*t5) + (6._dp*t1732*t516) - (15._dp*t1736 &
3416  *t234*t1737*t452)
3417  e_rho_rho = e_rho_rho + (-0.4e1_dp/0.9e1_dp/t1141*f89*t299 - 0.8e1_dp/0.3e1_dp*t409* &
3418  t727 - t80*(t1392 + t1517 + t1577 + t1742)*clda)*sx
3419  t1756 = t372*t407
3420  t1768 = t569*t407
3421  t1773 = d2exeirhondrho(q, dqrho, dqndrho, d2qrhondrho)
3422  t1785 = t1157*t372*t407
3423  t1788 = t541*t1093
3424  t1791 = t531*t407
3425  t1795 = t75*t372*t407
3426  t1816 = d2exerrhondrho(q, dqrho, dqndrho, d2qrhondrho)
3427  t1824 = t759*t658
3428  t1841 = t442*t407
3429  t1850 = ((20._dp*t281*t1691*t372*t407 - 4._dp*t281*t561*t1093 &
3430  - 12._dp*t1699*t1756 + 3._dp*t566*t1093 + 6._dp*t206*t565*t372 &
3431  *t407 - 2._dp*t206*t284*t1093 - 2._dp*t243*t1768 + t243*t238 &
3432  *t1093 + t289*t1773)*alpha8*t296) - t833*omega*t413 &
3433  /0.3e1_dp - 0.2e1_dp/0.3e1_dp*t839*t72*t369 + (t166*(0.3e1_dp/0.4e1_dp &
3434  *(t206)*(t1785) - (t206*t1788)/0.2e1_dp - 0.27e2_dp &
3435  /0.4e1_dp*t1168*t1791 + (3._dp*t665*t1795) + 0.3e1_dp/0.2e1_dp &
3436  *(t665)*(t213)*(t1093) + 0.75e2_dp/0.4e1_dp*(t218) &
3437  *(t1181)*(t1178)*(t372)*(t407) - (10._dp &
3438  *t218*t670*t186*t372*t407) - 0.5e1_dp/0.2e1_dp*(t218) &
3439  *(t671)*(t1093)) - t230*t1816)*alpha5*t234 - (3._dp &
3440  *t106*t513*t1093) + 0.5e1_dp/0.2e1_dp*t1824*t660 - (2._dp &
3441  *t740*t552) - 0.8e1_dp/0.3e1_dp*t917*t293*t689 - 0.7e1_dp/0.3e1_dp &
3442  *t903*t274*t699 - 0.15e2_dp/0.2e1_dp*t1736*t234*t453* &
3443  (t407) - 0.12e2_dp*(t106)*t1149*t118*t234*t1841 + &
3444  0.10e2_dp*t659*t234*t127*t452*(t407)
3445  t1885 = t160*t407
3446  t1938 = -0.5e1_dp/0.3e1_dp*t875*t154*t635 + ((12._dp*t1584*t1756 &
3447  - 3._dp*t638*t1093 - 6._dp*t1589*t1756 + 2._dp*t641*t1093 + 2._dp &
3448  *t206*r1*t1768 - t206*t644*t1093 - t243*t1773)*alpha6 &
3449  *t247*t249) - (2._dp*t510*t742) - (t81*t93*t1093) &
3450  + (t158*(t1773 + (t1093*t161 - 2._dp*t652*t407 + 2._dp*t1538 &
3451  *t1756 - t626*t1093)*t202*t160 - t1545*t1885 + t629*t407)) &
3452  + (0.3e1_dp/0.4e1_dp*(t158)*(t166)*(t1552)*(t372) &
3453  *(t407) - (t158*t496*t1093)/0.2e1_dp - t172* &
3454  t1816)*alpha1*t177 - (3._dp*t759*t622) - 0.15e2_dp/0.2e1_dp* &
3455  (t1736)*(t234)*(t1737)*(t407) + (3._dp*t514 &
3456  *t155*t44*t1093) + ((2._dp*t158*t615*t407 - t158*t204 &
3457  *t1093 - f98*t1773)*alpha2*t112) + ((-2._dp*t641*t1756 &
3458  + t239*t1093 + 6._dp*t158*t282*t372*t407 - 2._dp*t158*t236 &
3459  *t1093 + t206*t1773)*alpha4*t210) + (6._dp*t474*t622 &
3460  *t407)
3461  t1946 = t115*t1093
3462  t1976 = -0.4e1_dp/0.3e1_dp*t1031*t417 - 0.2e1_dp/0.3e1_dp*t302*t14 &
3463  *t755*t6 - (4._dp*t375*t420) - 0.2e1_dp*t11*t311*t755 + &
3464  (2._dp*t375*t434) + t11*t15*(-0.4e1_dp/0.3e1_dp*t747*t315 &
3465  *t317 - (4._dp*t748*t321) - 0.16e2_dp/0.3e1_dp*t751*t324*t327 &
3466  - (16._dp*t752*t331))
3467  t1978 = t1976*e*t108
3468  t2018 = 0.147e3_dp/0.4e1_dp*t251*t1613*t1614*t372*t407 - 0.21e2_dp &
3469  *t251*t522*t220*t372*t407 - 0.7e1_dp/0.2e1_dp*t251*t524 &
3470  *t1093 - 0.75e2_dp/0.4e1_dp*t1630*t1626*t372*t407 + 0.10e2_dp &
3471  *t530*t214*t372*t407 + 0.5e1_dp/0.2e1_dp*t530*t256*t1093 &
3472  + 0.27e2_dp/0.4e1_dp*t261*t1167*t1791 - 0.3e1_dp*t261*t535*t1795 &
3473  - 0.3e1_dp/0.2e1_dp*t261*t536*t1093 - 0.3e1_dp/0.4e1_dp*t243* &
3474  t1785 + t243*t1788/0.2e1_dp
3475  t2053 = -0.4e1_dp/0.3e1_dp*t1031*t458 - 0.2e1_dp/0.3e1_dp*t302*t14 &
3476  *t736*t6 - (4._dp*t375*t461) - 0.2e1_dp*t11*t311*t736 + &
3477  (2._dp*t375*t468) + t11*t15*(f2*t1061*t68 - t464* &
3478  t404 - t733*t365 + 2._dp*t85*t1073 - t85*t1090)
3479  t2056 = -(3._dp*t558*t761) - (2._dp*t91*t551*t1093) - t809 &
3480  *t519 + 0.5e1_dp/0.2e1_dp*t659*t234*t1946 + t1978 + 0.5e1_dp/0.2e1_dp &
3481  *t1379*t816 + (t166*t2018 + t270*t1816)*alpha7*t279 &
3482  - (2._dp*t886*t692) + (3._dp*t1732*t813) - t1978*t156 &
3483  - t852*t519 + f12*t2053*t94
3484  t2060 = t759*t513
3485  t2066 = t1262*t769
3486  t2069 = t125*t126
3487  t2071 = t452*t407
3488  t2072 = t480*t113*t2071
3489  t2076 = t447*t115*t2071
3490  t2084 = t110*t111
3491  t2086 = t1273*t1270*t2071
3492  t2090 = t480*t114*t2071
3493  t2099 = t447*t127*t2071
3494  t2105 = t125*t739
3495  t2111 = t114*t1093
3496  t2115 = -0.5e1_dp/0.2e1_dp*t1417*t2066 + (3._dp*t2069*t2072) - &
3497  0.5e1_dp/0.2e1_dp*t1417*t2076 - (2._dp*t603*t475*t1841) + (t603 &
3498  *t604*t1093) - 0.75e2_dp/0.4e1_dp*t2084*t2086 - 0.3e1_dp/ &
3499  0.2e1_dp*t1473*t2090 - (2._dp*t583*t441*t1841) + (t583 &
3500  *t584*t1093) + 0.10e2_dp*t2084*t2099 + 0.5e1_dp/0.2e1_dp*(t583) &
3501  *(t587)*(t1946) + 0.3e1_dp/0.2e1_dp*t2105*t608 + 0.3e1_dp &
3502  /0.2e1_dp*t1453*t784 + t2105*t605 + 0.3e1_dp/0.2e1_dp*(t603) &
3503  *(t607)*(t2111)
3504  t2133 = t110*t758
3505  t2136 = t1332*t783
3506  t2155 = t1341*t115*t2071
3507  t2158 = -t1434*t595*t452*t407/0.2e1_dp - t110*t1976*t83* &
3508  t118 + t1407*t767 - 0.2e1_dp*t81*t108*t122*t442*t407 - t125 &
3509  *t2053*t83*t129 + t1453*t781 + 0.5e1_dp/0.2e1_dp*t2133*t588 &
3510  - 0.3e1_dp/0.2e1_dp*t1473*t2136 - t1434*t1435*t407/0.2e1_dp &
3511  + t81*t591*t1093 + t81*t596*t1093/0.2e1_dp - 0.3e1_dp/0.4e1_dp &
3512  *t84*t1442*t452*t407 + 0.5e1_dp/0.2e1_dp*t1407*t770 + t2133 &
3513  *t585 - 0.27e2_dp/0.4e1_dp*t2069*t2155
3514  t2180 = t136*t758
3515  t2195 = t136*t137
3516  t2203 = -t136*t1976*t93*t118 + (2._dp*t1251*t793) + 0.5e1_dp &
3517  /0.2e1_dp*(t1251)*(t796) + (2._dp*t2180*t443) - (6._dp &
3518  *t440*t1256*t1841) - (5._dp*t1261*t2066) + (2._dp*t440 &
3519  *t441*t1093) + 0.5e1_dp/0.2e1_dp*(t2180)*(t454) - (5._dp &
3520  *t1261*t2076) - 0.75e2_dp/0.4e1_dp*t2195*t2086 + 0.10e2_dp* &
3521  t2195*t2099 + 0.5e1_dp/0.2e1_dp*(t440)*(t448)*(t1946)
3522  t2211 = t140*t739
3523  t2233 = -t140*t2053*t93*t129 + (2._dp*t1321*t802) + 0.3e1_dp &
3524  /0.2e1_dp*(t1321)*(t805) + (2._dp*t2211*t476) - (6._dp &
3525  *t474*t1326*t1841) - (3._dp*t1331*t2136) + (2._dp*t474 &
3526  *t475*t1093) + 0.3e1_dp/0.2e1_dp*(t2211)*(t483) - (3._dp &
3527  *t1331*t2090) - 0.27e2_dp/0.4e1_dp*t95*t2155 + 0.3e1_dp*t95 &
3528  *t2072 + 0.3e1_dp/0.2e1_dp*(t474)*(t481)*(t2111)
3529  t2274 = -0.4e1_dp/0.3e1_dp*t860*t153*t491 + (3._dp*t2060*t516) &
3530  + 0.5e1_dp/0.3e1_dp*t759*t441*t507 + (t2115 + t2158)*omega* &
3531  t134 + (12._dp*t106*t1149*t442*t407) - 0.75e2_dp/0.4e1_dp*(t1397) &
3532  *(t234)*(t1270)*(t452)*(t407) - &
3533  t788*t413/0.3e1_dp + (t2203 + t2233)*t145*t151 + (t166*(0.27e2_dp &
3534  /0.4e1_dp*(t184)*(t1666)*(t219)*(t372)* &
3535  (t407) - (3._dp*t184*t709*t1546*t407) - 0.3e1_dp/0.2e1_dp &
3536  *(t184)*(t710)*(t1093) - 0.3e1_dp/0.4e1_dp*t1678* &
3537  t1756 + (t714*t1093)/0.2e1_dp) + f2716*t1816*t196)*alpha3 &
3538  *t145*t151 - 0.25e2_dp/0.6e1_dp*(t1362)*(t634)*(t5) &
3539  *(t115)*(t407) + (2._dp*t81*t108*t442*t407) &
3540  - (5._dp*t1726*t506*t6*t407)
3541  e_ndrho_rho = e_ndrho_rho + (-0.4e1_dp/0.3e1_dp*t409*t920 - t80*(t1850 + t1938 + t2056 + &
3542  t2274)*clda)*sx
3543  t2279 = t407**2
3544  t2280 = t1157*t2279
3545  t2283 = t541*t1139
3546  t2306 = d2exerndrhondrho(q, dqndrho, d2qndrhondrho)
3547  t2316 = t127*t2279
3548  t2323 = t1270*t2279
3549  t2336 = d2exeindrhondrho(q, dqndrho, d2qndrhondrho)
3550  t2365 = 2._dp*t1095*t88 + 4._dp*t375*t737 + t11*t15*(f2*t1111 &
3551  *t68 - 2._dp*t733*t404 + 2._dp*t85*t1119 - t85*t1136)
3552  t2391 = (t166*(0.3e1_dp/0.4e1_dp*t206*t2280 - t206*t2283/0.2e1_dp &
3553  - 0.27e2_dp/0.4e1_dp*t1168*t256*t2279 + 0.3e1_dp*t665*t75*t2279 &
3554  + 0.3e1_dp/0.2e1_dp*t665*t213*t1139 + 0.75e2_dp/0.4e1_dp*t218 &
3555  *t1182*t2279 - 0.10e2_dp*t218*t1186*t2279 - 0.5e1_dp/0.2e1_dp* &
3556  t218*t671*t1139) - t230*t2306)*alpha5*t234 + (6._dp*t2060 &
3557  *t813) - 0.2e1_dp*t91*t551*t1139 + 0.10e2_dp*t659*t234* &
3558  t2316 + 0.6e1_dp*t91*t1661*t2279 - 0.75e2_dp/0.4e1_dp*t1397*t234 &
3559  *t2323 + (-0.2e1_dp*t641*t2279 + t239*t1139 + 0.6e1_dp*t158 &
3560  *t282*t2279 - 0.2e1_dp*t158*t236*t1139 + t206*t2336)*alpha4 &
3561  *t210 + 0.3e1_dp*t514*t155*t44*t1139 + (5._dp*t1824* &
3562  t816) - (4._dp*t740*t742) - t81*t93*t1139 + f12*t2365* &
3563  t94 - (6._dp*t759*t761) + 0.2e1_dp*t81*t108*t2279 + (0.12e2_dp &
3564  *t1584*t2279 - 0.3e1_dp*t638*t1139 - 0.6e1_dp*t1589*t2279 + &
3565  0.2e1_dp*t641*t1139 + 0.2e1_dp*t206*t1594*t2279 - t206*t644 &
3566  *t1139 - t243*t2336)*alpha6*t247*t249
3567  t2432 = 0.147e3_dp/0.4e1_dp*t251*t1615*t2279 - 0.21e2_dp*t251*t1619 &
3568  *t2279 - 0.7e1_dp/0.2e1_dp*t251*t524*t1139 - 0.75e2_dp/0.4e1_dp &
3569  *t1630*t1626*t2279 + 0.10e2_dp*t530*t214*t2279 + 0.5e1_dp/ &
3570  0.2e1_dp*t530*t256*t1139 + 0.27e2_dp/0.4e1_dp*t261*t1640*t2279 &
3571  - 0.3e1_dp*t261*t1644*t2279 - 0.3e1_dp/0.2e1_dp*t261*t536*t1139 &
3572  - 0.3e1_dp/0.4e1_dp*t243*t2280 + t243*t2283/0.2e1_dp
3573  t2452 = 2._dp*t1095*t103 + 4._dp*t375*t756 + t11*t15*(2._dp*g2* &
3574  t3*t19 + 12._dp*g3*t1*t24*t32)
3575  t2454 = t2452*e*t108
3576  t2473 = t2279*t115
3577  t2486 = t115*t1139
3578  t2501 = t2279*t114
3579  t2511 = t113*t2279
3580  t2515 = t114*t1139
3581  t2519 = -t136*t2452*t93*t118 + (4._dp*t2180*t793) + (5._dp &
3582  *t2180*t796) - (6._dp*t440*t1256*t2279) - (10._dp*t440 &
3583  *t658*t2473) + (2._dp*t440*t441*t1139) - 0.75e2_dp/0.4e1_dp &
3584  *(t440)*(t1274)*(t2323) + (10._dp*t440*t448 &
3585  *t2316) + 0.5e1_dp/0.2e1_dp*(t440)*(t448)*(t2486) - &
3586  t140*t2365*t93*t129 + (4._dp*t2211*t802) + (3._dp*t2211 &
3587  *t805) - (6._dp*t474*t1326*t2279) - (6._dp*t474*t108 &
3588  *t480*t2501) + (2._dp*t474*t475*t1139) - 0.27e2_dp/0.4e1_dp &
3589  *(t474)*(t1342)*(t2473) + (3._dp*t474*t481* &
3590  t2511) + 0.3e1_dp/0.2e1_dp*(t474)*(t481)*(t2515)
3591  t2571 = -t110*t2452*t83*t118 + (2._dp*t2133*t767) + (5._dp &
3592  *t2133*t770) - (2._dp*t583*t441*t2279) + (t583*t584 &
3593  *t1139) - (5._dp*t583*t448*t2473) + (10._dp*t583*t587 &
3594  *t2316) + 0.5e1_dp/0.2e1_dp*(t583)*(t587)*(t2486) &
3595  - 0.75e2_dp/0.4e1_dp*(t583)*(t1426)*(t2323) - (2._dp &
3596  *t81*t1430*t2279) - (t81*t93*t595*t2279)
3597  t2604 = t81*t591*t1139 - 0.3e1_dp/0.4e1_dp*t81*t1443*t2279 + &
3598  t81*t596*t1139/0.2e1_dp - t125*t2365*t83*t129 + (2._dp* &
3599  t2105*t781) + (3._dp*t2105*t784) - 0.2e1_dp*t603*t475*t2279 &
3600  + t603*t604*t1139 - 0.3e1_dp*t603*t481*t2501 + 0.3e1_dp*t603 &
3601  *t607*t2511 + 0.3e1_dp/0.2e1_dp*t603*t607*t2515 - 0.27e2_dp &
3602  /0.4e1_dp*t603*t1469*t2473
3603  t2668 = ((2._dp*t158*t236*t2279 - t158*t204*t1139 - f98* &
3604  t2336)*alpha2*t112) + (t166*t2432 + t270*t2306)*alpha7 &
3605  *t279 - t2454*t156 - (12._dp*t1150*t155*t44*t2279) + (12._dp &
3606  *t106*t1149*t2279) + t2519*t145*t151 + 0.5e1_dp/0.2e1_dp &
3607  *t659*t234*t2486 - 0.15e2_dp*t1736*t234*t2473 - (3._dp* &
3608  t106*t513*t1139) + (0.3e1_dp/0.4e1_dp*(t158)*(t1553) &
3609  *(t2279) - (t158*t496*t1139)/0.2e1_dp - t172*t2306) &
3610  *alpha1*t177 + t2454 + (t2571 + t2604)*omega*t134 + (t166* &
3611  (0.27e2_dp/0.4e1_dp*(t184)*(t1667)*(t2279) - (3._dp &
3612  *t184*t1671*t2279) - 0.3e1_dp/0.2e1_dp*(t184)*(t710) &
3613  *(t1139) - 0.3e1_dp/0.4e1_dp*(t1678)*(t2279) + (t714 &
3614  *t1139)/0.2e1_dp) + f2716*t2306*t196)*alpha3*t145*t151 &
3615  + (t158*(t2336 + (t1139*t161 - 2._dp*t2279*t204 + 2._dp* &
3616  t1538*t2279 - t626*t1139)*t202*t160 - t822*t238*t1885 &
3617  + t823*t407)) + ((20._dp*t281*t1691*t2279 - 4._dp*t281*t561 &
3618  *t1139 - 12._dp*t1699*t2279 + 3._dp*t566*t1139 + 6._dp*t206*t565 &
3619  *t2279 - 2._dp*t206*t284*t1139 - 2._dp*t243*t284*t2279 + t243 &
3620  *t238*t1139 + t289*t2336)*alpha8*t296)
3621  e_ndrho_ndrho = e_ndrho_ndrho + (-t80*(t2391 + t2668)*clda)*sx
3622  END IF
3623 
3624  END SUBROUTINE xwpbe_lda_calc_2
3625 
3626 ! **************************************************************************************************
3627 !> \brief Evaluates the screened hole averaged PBE exchange functional for lda.
3628 !> \param e_0 ...
3629 !> \param e_rho ...
3630 !> \param e_ndrho ...
3631 !> \param e_rho_rho ...
3632 !> \param e_ndrho_rho ...
3633 !> \param e_ndrho_ndrho ...
3634 !> \param rho , ndrho: density and norm of the density gradient
3635 !> \param ndrho ...
3636 !> \param omega screening parameter
3637 !> \param sscale scaling factor to enforce Lieb-Oxford bound
3638 !> \param sx scaling factor
3639 !> \param order degree of the derivative that should be evaluated,
3640 !> if positive all the derivatives up to the given degree are evaluated,
3641 !> if negative only the given degree is calculated
3642 !> \par History
3643 !> 05.2007 created [Manuel Guidon]
3644 !> \author Manuel Guidon
3645 !> \note
3646 !> This routine evaluates the functional for omega!=0 using a simple
3647 !> gaussian expansion for large ww.
3648 ! **************************************************************************************************
3649  SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, &
3650  e_ndrho_ndrho, rho, ndrho, omega, sscale, sx, order)
3651  REAL(kind=dp), INTENT(INOUT) :: e_0, e_rho, e_ndrho, e_rho_rho, &
3652  e_ndrho_rho, e_ndrho_ndrho
3653  REAL(kind=dp), INTENT(IN) :: rho, ndrho, omega, sscale, sx
3654  INTEGER, INTENT(IN) :: order
3655 
3656  REAL(kind=dp) :: d2qndrhondrho, d2qrhondrho, d2qrhorho, dqndrho, dqrho, q, t1, t10, t1004, &
3657  t1005, t1015, t102, t1025, t1032, t104, t105, t1056, t1060, t1065, t1068, t1079, t108, &
3658  t1080, t109, t1096, t11, t110, t1101, t1102, t111, t1114, t1115, t1121, t1124, t113, &
3659  t1143, t1147, t115, t1154, t1156, t116, t1162, t1169, t117, t1170, t1178, t1179, t118, &
3660  t1189, t119, t1193, t12, t120, t1202, t1203, t1204, t121, t1210, t1213, t1214, t1215, &
3661  t1216, t1220, t123, t1230, t1235, t124, t1240, t1241, t1242, t125, t1250, t1251, t1252, &
3662  t1256, t126, t1260, t1264, t127, t1273, t128, t1288, t129, t1295, t13
3663  REAL(kind=dp) :: t1300, t1304, t1308, t1309, t131, t1315, t1316, t132, t1326, t133, t1331, &
3664  t1337, t1346, t1350, t136, t1363, t1372, t1382, t1386, t1388, t1393, t14, t140, t1400, &
3665  t1401, t1402, t1408, t141, t142, t1437, t144, t1446, t145, t147, t148, t1480, t1482, &
3666  t1488, t149, t15, t150, t151, t1511, t152, t1522, t1535, t154, t155, t156, t1562, t157, &
3667  t1578, t158, t1583, t159, t1592, t1594, t16, t1608, t162, t1620, t1627, t163, t1632, &
3668  t1645, t1652, t166, t167, t1675, t1678, t168, t1685, t1687, t1688, t169, t1692, t1695, &
3669  t17, t170, t1712, t1719, t1731, t1737, t1739, t174, t1747, t1753, t176
3670  REAL(kind=dp) :: t1762, t1765, t177, t1781, t1796, t18, t180, t1804, t181, t1812, t1834, &
3671  t185, t186, t1860, t1878, t1886, t189, t19, t190, t192, t193, t1935, t194, t1945, t195, &
3672  t197, t1979, t198, t1981, t1989, t199, t1999, t2, t200, t2003, t2007, t2013, t202, t2050, &
3673  t206, t2060, t2064, t2068, t208, t209, t21, t210, t2107, t212, t213, t2140, t215, t2159, &
3674  t216, t217, t2174, t218, t219, t22, t221, t222, t223, t224, t227, t228, t23, t231, t232, &
3675  t234, t235, t236, t237, t238, t24, t242, t245, t246, t247, t248, t249, t25, t250, t251, &
3676  t252, t258, t259, t260, t261, t262, t266, t268, t27, t274, t277
3677  REAL(kind=dp) :: t278, t279, t28, t280, t285, t287, t288, t29, t291, t292, t295, t296, t297, &
3678  t3, t300, t301, t302, t304, t305, t308, t309, t31, t313, t316, t317, t318, t32, t320, &
3679  t322, t325, t328, t329, t332, t335, t338, t339, t34, t341, t342, t344, t345, t35, t352, &
3680  t359, t36, t361, t364, t365, t368, t369, t370, t373, t374, t375, t376, t377, t379, t38, &
3681  t380, t381, t383, t384, t388, t39, t391, t395, t396, t397, t398, t399, t4, t400, t401, &
3682  t403, t404, t405, t406, t408, t41, t416, t417, t418, t419, t42, t420, t422, t423, t424, &
3683  t428, t429, t433, t435, t437, t438, t44, t441, t442, t443, t444
3684  REAL(kind=dp) :: t445, t451, t452, t453, t456, t457, t46, t461, t462, t463, t466, t470, &
3685  t471, t478, t479, t48, t480, t483, t484, t485, t486, t49, t490, t493, t499, t5, t500, &
3686  t501, t504, t505, t511, t512, t513, t516, t517, t521, t523, t526, t528, t531, t532, t533, &
3687  t534, t537, t538, t539, t54, t542, t544, t545, t546, t548, t549, t55, t550, t554, t555, &
3688  t56, t561, t564, t565, t567, t568, t570, t58, t584, t586, t589, t590, t592, t593, t595, &
3689  t596, t599, t6, t60, t603, t604, t607, t608, t61, t610, t611, t612, t616, t617, t621, &
3690  t623, t626, t627, t628, t629, t63, t635, t637, t638, t649, t65, t651
3691  REAL(kind=dp) :: t652, t656, t661, t664, t67, t670, t673, t677, t68, t681, t684, t687, t69, &
3692  t690, t691, t695, t696, t698, t699, t7, t70, t704, t705, t706, t708, t709, t71, t712, &
3693  t713, t714, t717, t718, t72, t721, t724, t725, t727, t73, t74, t743, t746, t748, t75, &
3694  t752, t756, t759, t760, t762, t765, t767, t768, t769, t77, t772, t78, t781, t8, t80, &
3695  t803, t804, t806, t81, t811, t813, t816, t82, t820, t83, t84, t843, t844, t849, t85, &
3696  t855, t87, t871, t872, t875, t877, t878, t88, t892, t893, t899, t9, t90, t900, t91, t916, &
3697  t917, t92, t920, t922, t93, t932, t933, t94, t95, t96, t964, t967, t968
3698  REAL(kind=dp) :: t969, t97, t973, t976, t99
3699 
3700  IF (order >= 0) THEN
3701  t1 = ndrho**2
3702  t2 = r2**2
3703  t3 = 0.1e1_dp/t2
3704  t4 = t1*t3
3705  t5 = pi**2
3706  t6 = r3*t5
3707  t7 = t6*rho
3708  t8 = t7**(0.1e1_dp/0.3e1_dp)
3709  t9 = t8**2
3710  t10 = 0.1e1_dp/t9
3711  t11 = t4*t10
3712  t12 = rho**2
3713  t13 = 0.1e1_dp/t12
3714  t14 = sscale**2
3715  t15 = t13*t14
3716  t16 = a1*t1
3717  t17 = t16*t3
3718  t18 = t10*t13
3719  t19 = t18*t14
3720  t21 = t1**2
3721  t22 = a2*t21
3722  t23 = t2**2
3723  t24 = 0.1e1_dp/t23
3724  t25 = t22*t24
3725  t27 = 0.1e1_dp/t8/t7
3726  t28 = t12**2
3727  t29 = 0.1e1_dp/t28
3728  t31 = t14**2
3729  t32 = t27*t29*t31
3730  t34 = t17*t19 + t25*t32
3731  t35 = a3*t21
3732  t36 = t35*t24
3733  t38 = t21*ndrho
3734  t39 = a4*t38
3735  t41 = 0.1e1_dp/t23/r2
3736  t42 = t39*t41
3737  t44 = 0.1e1_dp/t9/t7
3738  t46 = 0.1e1_dp/t28/rho
3739  t48 = t31*sscale
3740  t49 = t44*t46*t48
3741  t54 = 0.1e1_dp/t23/t2
3742  t55 = a5*t21*t1*t54
3743  t56 = r3**2
3744  t58 = t5**2
3745  t60 = 0.1e1_dp/t56/t58
3746  t61 = t28**2
3747  t63 = t31*t14
3748  t65 = t60/t61*t63
3749  t67 = r1 + t36*t32 + t42*t49 + t55*t65
3750  t68 = 0.1e1_dp/t67
3751  t69 = t34*t68
3752  t70 = t15*t69
3753  t71 = t11*t70
3754  t72 = omega**2
3755  t73 = beta2*t72
3756  t74 = t73*t10
3757  t75 = t71 + t74
3758  t77 = 0.1e1_dp/a
3759  q = f94*t75*t77
3760  t78 = rho**(0.1e1_dp/0.3e1_dp)
3761  t80 = t78*rho*f89
3762  t81 = b*f12
3763  t82 = t71 + dd
3764  t83 = 0.1e1_dp/t82
3765  t84 = t81*t83
3766  t85 = f2*t34
3767  t87 = f1 + t85*t68
3768  t88 = t15*t87
3769  t90 = t11*t88 + r1
3770  t91 = f12*t90
3771  t92 = t82**2
3772  t93 = 0.1e1_dp/t92
3773  t94 = c*t93
3774  t95 = t91*t94
3775  t96 = f34*pi
3776  t97 = rootpi
3777  t99 = r6*c
3778  t102 = r4*b
3779  t104 = r8*a
3780  t105 = t92*t82
3781  t108 = t97*(r15*e + t99*t90*t82 + t102*t92 + t104*t105)
3782  t109 = 0.1e1_dp/r16
3783  t110 = sqrt(t82)
3784  t111 = t110*t105
3785  t113 = t109/t111
3786  t115 = sqrt(a)
3787  t116 = f94*t34
3788  t117 = t68*t1
3789  t118 = t116*t117
3790  t119 = t3*t10
3791  t120 = t15*t77
3792  t121 = t119*t120
3793  t123 = exp(t118*t121)
3794  t124 = t115*t123
3795  t125 = f32*ndrho
3796  t126 = 0.1e1_dp/r2
3797  t127 = t125*t126
3798  t128 = 0.1e1_dp/t8
3799  t129 = 0.1e1_dp/rho
3800  t131 = t69*t77
3801  t132 = sqrt(t131)
3802  t133 = sscale*t132
3803  t136 = erfc(t127*t128*t129*t133)
3804  t140 = 0.1e1_dp/f1516
3805  t141 = (t96 + t108*t113 - t96*t124*t136)*t140
3806  t142 = 0.1e1_dp/t97
3807  t144 = 0.1e1_dp/e
3808  t145 = t142*t111*t144
3809  t147 = -t141*t145 + r1
3810  t148 = t147*e
3811  t149 = 0.1e1_dp/t105
3812  t150 = t148*t149
3813  t151 = f158*e
3814  t152 = t147*t83
3815  t154 = t71 + dd + t72*t10
3816  t155 = t154**2
3817  t156 = t155**2
3818  t157 = t156*t154
3819  t158 = sqrt(t157)
3820  t159 = 0.1e1_dp/t158
3821  t162 = sqrt(t154)
3822  t163 = 0.1e1_dp/t162
3823  t166 = f68*c
3824  t167 = t90*t83
3825  t168 = t155*t154
3826  t169 = sqrt(t168)
3827  t170 = 0.1e1_dp/t169
3828  t174 = (-t151*t152*t159 - t81*t83*t163 - t166*t167*t170) &
3829  *omega
3830  t176 = f52*e
3831  t177 = t147*t93
3832  t180 = f12*c
3833  t181 = t90*t93
3834  t185 = t72*omega
3835  t186 = (-t176*t177*t159 - t180*t181*t170)*t185
3836  t189 = 0.1e1_dp/r3/t5
3837  t190 = t189*t129
3838  t192 = t72**2
3839  t193 = t192*omega
3840  t194 = t159*t193
3841  t195 = t194*t44
3842  t197 = f12*a
3843  t198 = exei(q)
3844  t199 = t71 + dd + t74
3845  t200 = 0.1e1_dp/t199
3846  t202 = log(t75*t200)
3847  t206 = (t84 + t95 + t150 + t174*t128 + t186*t190 - t150*t195 &
3848  + t197*(t198 + t202))*clda
3849  e_0 = e_0 + (-t80*t206)*sx
3850  END IF
3851  IF (order >= 1 .OR. order == -1) THEN
3852  t208 = t44*t13
3853  t209 = t4*t208
3854  t210 = t14*t34
3855  t212 = t68*r3*t5
3856  t213 = t210*t212
3857  t215 = 0.2e1_dp/0.3e1_dp*t209*t213
3858  t216 = t12*rho
3859  t217 = 0.1e1_dp/t216
3860  t218 = t217*t14
3861  t219 = t218*t69
3862  t221 = 2._dp*t11*t219
3863  t222 = t3*t44
3864  t223 = t16*t222
3865  t224 = t15*t6
3866  t227 = t10*t217
3867  t228 = t227*t14
3868  t231 = t56*t58
3869  t232 = t231*t12
3870  t234 = 0.1e1_dp/t8/t232
3871  t235 = t24*t234
3872  t236 = t22*t235
3873  t237 = t29*t31
3874  t238 = t237*t6
3875  t242 = t27*t46*t31
3876  t245 = -0.2e1_dp/0.3e1_dp*t223*t224 - (2._dp*t17*t228) - 0.4e1_dp &
3877  /0.3e1_dp*t236*t238 - (4._dp*t25*t242)
3878  t246 = t245*t68
3879  t247 = t15*t246
3880  t248 = t11*t247
3881  t249 = t4*t18
3882  t250 = t67**2
3883  t251 = 0.1e1_dp/t250
3884  t252 = t35*t235
3885  t258 = 0.1e1_dp/t9/t232
3886  t259 = t41*t258
3887  t260 = t39*t259
3888  t261 = t46*t48
3889  t262 = t261*t6
3890  t266 = 0.1e1_dp/t28/t12
3891  t268 = t44*t266*t48
3892  t274 = t60/t61/rho*t63
3893  t277 = -0.4e1_dp/0.3e1_dp*t252*t238 - (4._dp*t36*t242) - 0.5e1_dp &
3894  /0.3e1_dp*t260*t262 - (5._dp*t42*t268) - (8._dp*t55*t274)
3895  t278 = t251*t277
3896  t279 = t210*t278
3897  t280 = t249*t279
3898  t285 = -t215 - t221 + t248 - t280 - 0.2e1_dp/0.3e1_dp*t73*t44*r3 &
3899  *t5
3900  dqrho = f94*t285*t77
3901  t287 = ndrho*t3
3902  t288 = t287*t10
3903  t291 = a1*ndrho
3904  t292 = t291*t3
3905  t295 = t1*ndrho
3906  t296 = a2*t295
3907  t297 = t296*t24
3908  t300 = 2._dp*t292*t19 + 4._dp*t297*t32
3909  t301 = t300*t68
3910  t302 = t15*t301
3911  t304 = a3*t295
3912  t305 = t304*t24
3913  t308 = a4*t21
3914  t309 = t308*t41
3915  t313 = a5*t38*t54
3916  t316 = 4._dp*t305*t32 + 5._dp*t309*t49 + 6._dp*t313*t65
3917  t317 = t251*t316
3918  t318 = t210*t317
3919  t320 = 2._dp*t288*t70 + t11*t302 - t249*t318
3920  dqndrho = f94*t320*t77
3921  t322 = t78*f89
3922  t325 = -t215 - t221 + t248 - t280
3923  t328 = t14*t87
3924  t329 = t328*t6
3925  t332 = t218*t87
3926  t335 = f2*t245
3927  t338 = t335*t68 - t85*t278
3928  t339 = t15*t338
3929  t341 = -0.2e1_dp/0.3e1_dp*t209*t329 - (2._dp*t11*t332) + (t11 &
3930  *t339)
3931  t342 = f12*t341
3932  t344 = c*t149
3933  t345 = t344*t325
3934  t352 = t82*t325
3935  t359 = t97*(t99*t341*t82 + t99*t90*t325 + 2._dp*t102*t352 &
3936  + 3._dp*t104*t92*t325)
3937  t361 = t92**2
3938  t364 = t109/t110/t361
3939  t365 = t364*t325
3940  t368 = t96*t115
3941  t369 = f94*t245
3942  t370 = t369*t117
3943  t373 = t251*t1*t3
3944  t374 = t116*t373
3945  t375 = t14*t77
3946  t376 = t375*t277
3947  t377 = t18*t376
3948  t379 = t117*t3
3949  t380 = t116*t379
3950  t381 = t208*t14
3951  t383 = t77*r3*t5
3952  t384 = t381*t383
3953  t388 = t119*t218*t77
3954  t391 = t370*t121 - t374*t377 - 0.2e1_dp/0.3e1_dp*t380*t384 - (2._dp &
3955  *t118*t388)
3956  t395 = rootpi
3957  t396 = 0.1e1_dp/t395
3958  t397 = t123*t396
3959  t398 = f32**2
3960  t399 = t398*t1
3961  t400 = t399*t119
3962  t401 = t15*t131
3963  t403 = exp(-t400*t401)
3964  t404 = t126*t27
3965  t405 = t125*t404
3966  t406 = t129*sscale
3967  t408 = t132*r3*t5
3968  t416 = t125*t126*t128
3969  t417 = 0.1e1_dp/t132
3970  t418 = t246*t77
3971  t419 = t34*t251
3972  t420 = t77*t277
3973  t422 = t418 - t419*t420
3974  t423 = t417*t422
3975  t424 = t406*t423
3976  t428 = t403*(-t405*t406*t408/0.3e1_dp - t127*t128*t13*t133 &
3977  + t416*t424/0.2e1_dp)
3978  t429 = t397*t428
3979  t433 = (t359*t113 - 0.7e1_dp/0.2e1_dp*t108*t365 - (t368*t391 &
3980  *t123*t136) + (2._dp*t368*t429))*t140
3981  t435 = t141*t142
3982  t437 = t110*t92*t144
3983  t438 = t437*t325
3984  t441 = -t433*t145 - 0.7e1_dp/0.2e1_dp*t435*t438
3985  t442 = t441*e
3986  t443 = t442*t149
3987  t444 = 0.1e1_dp/t361
3988  t445 = t444*t325
3989  t451 = t151*t147
3990  t452 = t93*t159
3991  t453 = t452*t325
3992  t456 = 0.1e1_dp/t158/t157
3993  t457 = t83*t456
3994  t461 = -t215 - t221 + t248 - t280 - 0.2e1_dp/0.3e1_dp*t72*t44*t6
3995  t462 = t156*t461
3996  t463 = t457*t462
3997  t466 = t93*t163
3998  t470 = 0.1e1_dp/t162/t154
3999  t471 = t83*t470
4000  t478 = t166*t90
4001  t479 = t93*t170
4002  t480 = t479*t325
4003  t483 = 0.1e1_dp/t169/t168
4004  t484 = t83*t483
4005  t485 = t155*t461
4006  t486 = t484*t485
4007  t490 = (-t151*t441*t83*t159 + t451*t453 + 0.5e1_dp/0.2e1_dp*t451 &
4008  *t463 + t81*t466*t325 + t81*t471*t461/0.2e1_dp - t166 &
4009  *t341*t83*t170 + t478*t480 + 0.3e1_dp/0.2e1_dp*t478*t486)* &
4010  omega
4011  t493 = t27*r3*t5
4012  t499 = t176*t147
4013  t500 = t149*t159
4014  t501 = t500*t325
4015  t504 = t93*t456
4016  t505 = t504*t462
4017  t511 = t180*t90
4018  t512 = t149*t170
4019  t513 = t512*t325
4020  t516 = t93*t483
4021  t517 = t516*t485
4022  t521 = (-t176*t441*t93*t159 + (2._dp*t499*t501) + 0.5e1_dp/ &
4023  0.2e1_dp*(t499)*(t505) - t180*t341*t93*t170 + (2._dp &
4024  *t511*t513) + 0.3e1_dp/0.2e1_dp*(t511)*(t517))*t185
4025  t523 = t189*t13
4026  t526 = t148*t444
4027  t528 = t194*t44*t325
4028  t531 = t149*t456
4029  t532 = t148*t531
4030  t533 = t193*t44
4031  t534 = t533*t462
4032  t537 = t148*t500
4033  t538 = t193*t258
4034  t539 = t538*t6
4035  t542 = dexeirho(q, dqrho)
4036  t544 = t199**2
4037  t545 = 0.1e1_dp/t544
4038  t546 = t75*t545
4039  t548 = t285*t200 - t546*t285
4040  t549 = 0.1e1_dp/t75
4041  t550 = t548*t549
4042  t554 = -t81*t93*t325 + t342*t94 - (2._dp*t91*t345) + t443 &
4043  - (3._dp*t148*t445) + t490*t128 - t174*t493/0.3e1_dp + t521 &
4044  *t190 - t186*t523 - t443*t195 + (3._dp*t526*t528) + 0.5e1_dp &
4045  /0.2e1_dp*t532*t534 + 0.5e1_dp/0.3e1_dp*t537*t539 + t197*(t542 &
4046  + t550*t199)
4047  t555 = t554*clda
4048  e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t322*t206 - t80*t555)*sx
4049  t561 = f2*t300
4050  t564 = t561*t68 - t85*t317
4051  t565 = t15*t564
4052  t567 = 2._dp*t288*t88 + t11*t565
4053  t568 = f12*t567
4054  t570 = t344*t320
4055  t584 = t97*(t99*t567*t82 + t99*t90*t320 + 2._dp*t102*t82 &
4056  *t320 + 3._dp*t104*t92*t320)
4057  t586 = t364*t320
4058  t589 = f94*t300
4059  t590 = t589*t117
4060  t592 = t375*t316
4061  t593 = t18*t592
4062  t595 = t68*ndrho
4063  t596 = t116*t595
4064  t599 = t590*t121 - t374*t593 + 2._dp*t596*t121
4065  t603 = f32*t126
4066  t604 = t603*t128
4067  t607 = t301*t77
4068  t608 = t77*t316
4069  t610 = t607 - t419*t608
4070  t611 = t417*t610
4071  t612 = t406*t611
4072  t616 = t403*(t604*t406*t132 + t416*t612/0.2e1_dp)
4073  t617 = t397*t616
4074  t621 = (t584*t113 - 0.7e1_dp/0.2e1_dp*t108*t586 - (t368*t599 &
4075  *t123*t136) + (2._dp*t368*t617))*t140
4076  t623 = t437*t320
4077  t626 = -t621*t145 - 0.7e1_dp/0.2e1_dp*t435*t623
4078  t627 = t626*e
4079  t628 = t627*t149
4080  t629 = t444*t320
4081  t635 = t452*t320
4082  t637 = t156*t320
4083  t638 = t457*t637
4084  t649 = t479*t320
4085  t651 = t155*t320
4086  t652 = t484*t651
4087  t656 = (-t151*t626*t83*t159 + t451*t635 + 0.5e1_dp/0.2e1_dp*t451 &
4088  *t638 + t81*t466*t320 + t81*t471*t320/0.2e1_dp - t166 &
4089  *t567*t83*t170 + t478*t649 + 0.3e1_dp/0.2e1_dp*t478*t652)* &
4090  omega
4091  t661 = t500*t320
4092  t664 = t504*t637
4093  t670 = t512*t320
4094  t673 = t516*t651
4095  t677 = (-t176*t626*t93*t159 + (2._dp*t499*t661) + 0.5e1_dp/ &
4096  0.2e1_dp*(t499)*(t664) - t180*t567*t93*t170 + (2._dp &
4097  *t511*t670) + 0.3e1_dp/0.2e1_dp*(t511)*(t673))*t185
4098  t681 = t194*t44*t320
4099  t684 = t533*t637
4100  t687 = dexeindrho(q, dqndrho)
4101  t690 = t320*t200 - t546*t320
4102  t691 = t690*t549
4103  t695 = -t81*t93*t320 + t568*t94 - (2._dp*t91*t570) + t628 &
4104  - (3._dp*t148*t629) + t656*t128 + t677*t190 - t628*t195 &
4105  + (3._dp*t526*t681) + 0.5e1_dp/0.2e1_dp*t532*t684 + t197*(t687 &
4106  + t691*t199)
4107  t696 = t695*clda
4108  e_ndrho = e_ndrho + (-t80*t696)*sx
4109  END IF
4110  IF (order >= 2 .OR. order == -2) THEN
4111  t698 = t258*t13
4112  t699 = t4*t698
4113  t704 = 0.10e2_dp/0.9e1_dp*t699*t210*t68*t56*t58
4114  t705 = t44*t217
4115  t706 = t4*t705
4116  t708 = 0.8e1_dp/0.3e1_dp*t706*t213
4117  t709 = t14*t245
4118  t712 = 0.4e1_dp/0.3e1_dp*t209*t709*t212
4119  t713 = t4*t381
4120  t714 = t6*t277
4121  t717 = 0.4e1_dp/0.3e1_dp*t713*t419*t714
4122  t718 = t29*t14
4123  t721 = 6._dp*t11*t718*t69
4124  t724 = 4._dp*t11*t218*t246
4125  t725 = t4*t227
4126  t727 = 4._dp*t725*t279
4127  t743 = t56*r3*t58*t5*t216
4128  t746 = t24/t8/t743
4129  t748 = t237*t231
4130  t752 = t46*t31*t6
4131  t756 = t27*t266*t31
4132  t759 = 0.10e2_dp/0.9e1_dp*t16*t3*t258*t15*t231 + 0.8e1_dp/0.3e1_dp &
4133  *t223*t218*t6 + (6._dp*t17*t10*t29*t14) + 0.28e2_dp/ &
4134  0.9e1_dp*t22*t746*t748 + 0.32e2_dp/0.3e1_dp*t236*t752 + (20._dp &
4135  *t25*t756)
4136  t760 = t759*t68
4137  t762 = t11*t15*t760
4138  t765 = 2._dp*t249*t709*t278
4139  t767 = 0.1e1_dp/t250/t67
4140  t768 = t277**2
4141  t769 = t767*t768
4142  t772 = 2._dp*t249*t210*t769
4143  t781 = 0.1e1_dp/t9/t743
4144  t803 = 0.28e2_dp/0.9e1_dp*t35*t746*t748 + 0.32e2_dp/0.3e1_dp*t252* &
4145  t752 + (20._dp*t36*t756) + 0.40e2_dp/0.9e1_dp*t39*t41*t781 &
4146  *t261*t231 + 0.50e2_dp/0.3e1_dp*t260*t266*t48*t6 + 0.30e2_dp* &
4147  t42*t44/t28/t216*t48 + (72._dp*t55*t60/t61/t12* &
4148  t63)
4149  t804 = t251*t803
4150  t806 = t249*t210*t804
4151  t811 = t704 + t708 - t712 + t717 + t721 - t724 + t727 + t762 - t765 &
4152  + t772 - t806 + 0.10e2_dp/0.9e1_dp*t73*t258*t56*t58
4153  d2qrhorho = f94*t811*t77
4154  t813 = t287*t208
4155  t816 = t14*t300
4156  t820 = t6*t316
4157  t843 = -0.4e1_dp/0.3e1_dp*t291*t222*t224 - (4._dp*t292*t228) &
4158  - 0.16e2_dp/0.3e1_dp*t296*t235*t238 - (16._dp*t297*t242)
4159  t844 = t843*t68
4160  t849 = t287*t18
4161  t855 = t767*t277*t316
4162  t871 = -0.16e2_dp/0.3e1_dp*t304*t235*t238 - (16._dp*t305*t242) &
4163  - 0.25e2_dp/0.3e1_dp*t308*t259*t262 - (25._dp*t309*t268) - &
4164  (48._dp*t313*t274)
4165  t872 = t251*t871
4166  t875 = -0.4e1_dp/0.3e1_dp*t813*t213 - 0.2e1_dp/0.3e1_dp*t209*t816* &
4167  t212 + 0.2e1_dp/0.3e1_dp*t713*t419*t820 - (4._dp*t288*t219) &
4168  - (2._dp*t11*t218*t301) + (2._dp*t725*t318) + (2._dp* &
4169  t288*t247) + (t11*t15*t844) - t249*t709*t317 - (2._dp &
4170  *t849*t279) - t249*t816*t278 + 0.2e1_dp*t249*t210*t855 &
4171  - t249*t210*t872
4172  d2qrhondrho = f94*t875*t77
4173  t877 = t119*t13
4174  t878 = t210*t68
4175  t892 = 2._dp*a1*t3*t19 + 12._dp*a2*t1*t24*t32
4176  t893 = t892*t68
4177  t899 = t316**2
4178  t900 = t767*t899
4179  t916 = 12._dp*a3*t1*t24*t32 + 20._dp*a4*t295*t41*t49 + 30._dp* &
4180  a5*t21*t54*t65
4181  t917 = t251*t916
4182  t920 = 2._dp*t877*t878 + 4._dp*t288*t302 - 4._dp*t849*t318 + t11* &
4183  t15*t893 - 2._dp*t249*t816*t317 + 2._dp*t249*t210*t900 - t249 &
4184  *t210*t917
4185  d2qndrhondrho = f94*t920*t77
4186  t922 = t78**2
4187  t932 = t704 + t708 - t712 + t717 + t721 - t724 + t727 + t762 - t765 &
4188  + t772 - t806 + 0.10e2_dp/0.9e1_dp*t72*t258*t231
4189  t933 = t156*t932
4190  t964 = 0.10e2_dp/0.9e1_dp*t699*t328*t231 + 0.8e1_dp/0.3e1_dp*t706* &
4191  t329 - 0.4e1_dp/0.3e1_dp*t209*t14*t338*t6 + (6._dp*t11*t718 &
4192  *t87) - 0.4e1_dp*(t11)*t218*t338 + (t11*t15*(f2 &
4193  *t759*t68 - 2._dp*t335*t278 + 2._dp*t85*t769 - t85*t804))
4194  t967 = t361*t82
4195  t968 = 0.1e1_dp/t967
4196  t969 = t325**2
4197  t973 = t442*t444
4198  t976 = t704 + t708 - t712 + t717 + t721 - t724 + t727 + t762 - t765 &
4199  + t772 - t806
4200  t1004 = 0.1e1_dp/t110/t967
4201  t1005 = t109*t1004
4202  t1015 = t369*t373
4203  t1025 = t116*t767*t1*t3
4204  t1032 = t116*t251*t4*t44
4205  t1056 = f94*t759*t117*t121 - (2._dp*t1015*t377) - 0.4e1_dp/ &
4206  0.3e1_dp*t369*t379*t384 - (4._dp*t370*t388) + (2._dp*t1025 &
4207  *t18*t375*t768) + 0.4e1_dp/0.3e1_dp*t1032*t120*t714 + (4._dp &
4208  *t374*t227*t376) - (t374*t18*t375*t803) + 0.10e2_dp &
4209  /0.9e1_dp*t380*t698*t14*t77*t56*t58 + 0.8e1_dp/0.3e1_dp* &
4210  t380*t705*t14*t383 + 0.6e1_dp*t118*t119*t718*t77
4211  t1060 = t391**2
4212  t1065 = t96*t115*t391
4213  t1068 = t96*t124
4214  t1079 = t399*t877
4215  t1080 = t251*t77
4216  t1096 = t13*sscale
4217  t1101 = t125*t404*t129
4218  t1102 = sscale*t417
4219  t1114 = 0.1e1_dp/t132/t131
4220  t1115 = t422**2
4221  t1121 = t245*t251
4222  t1124 = t34*t767
4223  t1143 = t433*t142
4224  t1147 = t110*t82*t144
4225  t1154 = -((t97*(t99*t964*t82 + 2._dp*t99*t341*t325 + t99 &
4226  *t90*t976 + 2._dp*t102*t969 + 2._dp*t102*t82*t976 + 6._dp*t104 &
4227  *t82*t969 + 3._dp*t104*t92*t976)*t113) - (7._dp*t359* &
4228  t365) + 0.63e2_dp/0.4e1_dp*(t108)*(t1005)*(t969) - 0.7e1_dp &
4229  /0.2e1_dp*(t108)*(t364)*(t976) - t368*t1056 &
4230  *t123*t136 - t368*t1060*t123*t136 + (4._dp*t1065*t429) &
4231  + 0.2e1_dp*t1068*t396*(0.2e1_dp/0.3e1_dp*t399*t222*t13*t878 &
4232  *t383 + (2._dp*t400*t218*t131) - (t400*t15*t418) &
4233  + t1079*t210*t1080*t277)*t428 + 0.2e1_dp*t368*t397*t403 &
4234  *(0.4e1_dp/0.9e1_dp*t125*t126*t234*t406*t132*t56*t58 &
4235  + 0.2e1_dp/0.3e1_dp*t405*t1096*t408 - t1101*t1102*t6*t422 &
4236  /0.3e1_dp + (2._dp*t127*t128*t217*t133) - t416*t1096*t423 &
4237  - t416*t406*t1114*t1115/0.4e1_dp + t416*t406*t417*(t760 &
4238  *t77 - 2._dp*t1121*t420 + 2._dp*t1124*t77*t768 - t419* &
4239  t77*t803)/0.2e1_dp))*t140*t145 - (7._dp*t1143*t438) - 0.35e2_dp &
4240  /0.4e1_dp*(t435)*(t1147)*(t969) - 0.7e1_dp/0.2e1_dp &
4241  *(t435)*(t437)*(t976)
4242  t1156 = t1154*e*t149
4243  t1162 = t442*t531
4244  t1169 = t148*t444*t456
4245  t1170 = t325*t156
4246  t1178 = t444*t159
4247  t1179 = t148*t1178
4248  t1189 = 0.5e1_dp/0.2e1_dp*t532*t533*t933 - (6._dp*t442*t445) &
4249  + f12*t964*t94 + (12._dp*t148*t968*t969) + (6._dp*t973 &
4250  *t528) - (3._dp*t148*t444*t976) + t1156 - (t81*t93* &
4251  t976) + (2._dp*t81*t149*t969) + (5._dp*t1162*t534) + 0.10e2_dp &
4252  /0.3e1_dp*(t442)*(t500)*(t539) - 0.15e2_dp*t1169 &
4253  *t533*t1170*t461 - (2._dp*t91*t344*t976) - (10._dp* &
4254  t1179*t538*t325*r3*t5) + 0.4e1_dp/0.9e1_dp*t174*t234*t56 &
4255  *t58
4256  t1193 = t176*t441
4257  t1202 = t176*t147*t149
4258  t1203 = t456*t325
4259  t1204 = t1203*t462
4260  t1210 = t156**2
4261  t1213 = 0.1e1_dp/t158/t1210/t155
4262  t1214 = t93*t1213
4263  t1215 = t461**2
4264  t1216 = t1210*t1215
4265  t1220 = t168*t1215
4266  t1230 = t180*t341
4267  t1235 = t444*t170
4268  t1240 = t180*t90*t149
4269  t1241 = t483*t325
4270  t1242 = t1241*t485
4271  t1250 = 0.1e1_dp/t169/t156/t155
4272  t1251 = t93*t1250
4273  t1252 = t156*t1215
4274  t1256 = t154*t1215
4275  t1260 = t155*t932
4276  t1264 = -t176*t1154*t93*t159 + (4._dp*t1193*t501) + (5._dp &
4277  *t1193*t505) - (6._dp*t499*t1178*t969) - (10._dp*t1202 &
4278  *t1204) + (2._dp*t499*t500*t976) - 0.75e2_dp/0.4e1_dp*(t499) &
4279  *(t1214)*(t1216) + (10._dp*t499*t504*t1220) &
4280  + 0.5e1_dp/0.2e1_dp*(t499)*(t504)*(t933) - t180*t964 &
4281  *t93*t170 + (4._dp*t1230*t513) + (3._dp*t1230*t517) &
4282  - (6._dp*t511*t1235*t969) - (6._dp*t1240*t1242) + (2._dp &
4283  *t511*t512*t976) - 0.27e2_dp/0.4e1_dp*(t511)*(t1251) &
4284  *(t1252) + (3._dp*t511*t516*t1256) + 0.3e1_dp/0.2e1_dp* &
4285  (t511)*(t516)*(t1260)
4286  t1273 = t148*t149*t1213
4287  t1288 = t148*t531*t193
4288  t1295 = t148*t968
4289  t1300 = t83*t1213
4290  t1304 = t149*t163
4291  t1308 = t81*t93
4292  t1309 = t470*t325
4293  t1315 = 0.1e1_dp/t162/t155
4294  t1316 = t83*t1315
4295  t1326 = t166*t341
4296  t1331 = t166*t181
4297  t1337 = -0.75e2_dp/0.4e1_dp*t451*t1300*t1216 - (2._dp*t81*t1304 &
4298  *t969) - t1308*t1309*t461 + (t81*t466*t976) - 0.3e1_dp &
4299  /0.4e1_dp*(t81)*(t1316)*(t1215) + (t81*t471 &
4300  *t932)/0.2e1_dp - t166*t964*t83*t170 + (2._dp*t1326*t480) &
4301  + (3._dp*t1326*t486) - (3._dp*t1331*t1242) - (2._dp* &
4302  t478*t512*t969)
4303  t1346 = t83*t1250
4304  t1350 = t151*t441
4305  t1363 = t151*t177
4306  t1372 = (t478*t479*t976) + (3._dp*t478*t484*t1256) + &
4307  0.3e1_dp/0.2e1_dp*(t478)*(t484)*(t1260) - 0.27e2_dp/0.4e1_dp &
4308  *(t478)*(t1346)*(t1252) + (2._dp*t1350*t453) &
4309  - t151*t1154*t83*t159 + (5._dp*t1350*t463) - (2._dp &
4310  *t451*t500*t969) + (t451*t452*t976) - (5._dp*t1363 &
4311  *t1204) + (10._dp*t451*t457*t1220) + 0.5e1_dp/0.2e1_dp*(t451) &
4312  *(t457)*(t933)
4313  t1382 = c*t444
4314  t1386 = d2exeirhorho(q, dqrho, d2qrhorho)
4315  t1388 = t285**2
4316  t1393 = t75/t544/t199
4317  t1400 = t75**2
4318  t1401 = 0.1e1_dp/t1400
4319  t1402 = t548*t1401
4320  t1408 = t1264*t185*t190 + (10._dp*t532*t533*t1220) - (2._dp &
4321  *t521*t523) - 0.75e2_dp/0.4e1_dp*(t1273)*(t533)*(t1216) &
4322  + (3._dp*t526*t194*t44*t976) - t1156*t195 - 0.2e1_dp &
4323  /0.3e1_dp*t490*t493 + (2._dp*t186*t189*t217) - 0.25e2_dp &
4324  /0.3e1_dp*t1288*t258*t156*t461*r3*t5 - (12._dp*t1295* &
4325  t194*t44*t969) + (t1337 + t1372)*omega*t128 - 0.40e2_dp/0.9e1_dp &
4326  *t537*t193*t781*t231 - (4._dp*t342*t345) + (6._dp* &
4327  t91*t1382*t969) + (t197*(t1386 + (t811*t200 - 2._dp*t1388 &
4328  *t545 + 2._dp*t1393*t1388 - t546*t811)*t549*t199 - t1402 &
4329  *t199*t285 + t550*t285))
4330  e_rho_rho = e_rho_rho + (-0.4e1_dp/0.9e1_dp/t922*f89*t206 - 0.8e1_dp/0.3e1_dp*t322*t555 &
4331  - t80*(t1189 + t1408)*clda)*sx
4332  t1437 = -0.4e1_dp/0.3e1_dp*t813*t329 - 0.2e1_dp/0.3e1_dp*t209*t14* &
4333  t564*t6 - (4._dp*t288*t332) - 0.2e1_dp*t11*t218*t564 + (2._dp &
4334  *t288*t339) + t11*t15*(f2*t843*t68 - t335*t317 &
4335  - t561*t278 + 2._dp*t85*t855 - t85*t872)
4336  t1446 = t320*t325
4337  t1480 = t589*t373
4338  t1482 = t420*t316
4339  t1488 = t116*t251*ndrho*t3
4340  t1511 = (f94*t843*t117*t121) - t1015*t593 + (2._dp*t369 &
4341  *t595*t121) - (t1480*t377) + (2._dp*t1025*t19*t1482) &
4342  - (2._dp*t1488*t377) - (t374*t18*t375*t871) - 0.2e1_dp &
4343  /0.3e1_dp*t589*t379*t384 + 0.2e1_dp/0.3e1_dp*t1032*t120* &
4344  t820 - 0.4e1_dp/0.3e1_dp*t116*(t595)*t3*t384 - (2._dp*t590 &
4345  *t388) + (2._dp*t374*t227*t592) - (4._dp*t596*t388)
4346  t1522 = t96*t115*t599
4347  t1535 = t396*(-2._dp*t398*ndrho*t119*t401 - t400*t15*t607 &
4348  + t1079*t210*t1080*t316)
4349  t1562 = t300*t251
4350  t1578 = (t97*(t99*t1437*t82 + t99*t341*t320 + t99*t567 &
4351  *t325 + t99*t90*t875 + 2._dp*t102*t1446 + 2._dp*t102*t82 &
4352  *t875 + 6._dp*t104*t352*t320 + 3._dp*t104*t92*t875)*t113) - &
4353  0.7e1_dp/0.2e1_dp*t359*t586 - 0.7e1_dp/0.2e1_dp*t584*t365 + 0.63e2_dp &
4354  /0.4e1_dp*(t108)*(t109)*(t1004)*(t325)*(t320) &
4355  - 0.7e1_dp/0.2e1_dp*(t108)*(t364)*(t875) - &
4356  t368*t1511*t123*t136 - t368*t391*t599*t123*t136 + (2._dp &
4357  *t1065*t617) + (2._dp*t1522*t429) + (2._dp*t1068* &
4358  t1535*t428) + 0.2e1_dp*t368*t397*t403*(-t603*t27*t129* &
4359  t133*t6/0.3e1_dp - t1101*t1102*t6*t610/0.6e1_dp - t604*t1096 &
4360  *t132 - t416*t1096*t611/0.2e1_dp + t604*t424/0.2e1_dp - t416 &
4361  *t406*t1114*t422*t610/0.4e1_dp + t416*t406*t417*(t844 &
4362  *t77 - t1121*t608 - t1562*t420 + 2._dp*t1124*t1482 - &
4363  t419*t77*t871)/0.2e1_dp)
4364  t1583 = t621*t142
4365  t1592 = -t1578*t140*t145 - 0.7e1_dp/0.2e1_dp*t1143*t623 - 0.7e1_dp &
4366  /0.2e1_dp*t1583*t438 - 0.35e2_dp/0.4e1_dp*t435*t1147*t1446 - &
4367  0.7e1_dp/0.2e1_dp*t435*t437*t875
4368  t1594 = t1592*e*t149
4369  t1608 = d2exeirhondrho(q, dqrho, dqndrho, d2qrhondrho)
4370  t1620 = t199*t320
4371  t1627 = t627*t444
4372  t1632 = t156*t875
4373  t1645 = t627*t531
4374  t1652 = -t1594*t195 - t656*t493/0.3e1_dp - (3._dp*t442*t629) &
4375  - 0.25e2_dp/0.6e1_dp*t1288*t258*r3*t5*t156*t320 - (3._dp &
4376  *t627*t445) + t197*(t1608 + (t875*t200 - 0.2e1_dp*t285*t545 &
4377  *t320 + 0.2e1_dp*t1393*t285*t320 - t546*t875)*t549*t199 &
4378  - t1402*t1620 + t550*t320) + 0.5e1_dp/0.2e1_dp*t1162*t684 + &
4379  (3._dp*t1627*t528) + (3._dp*t973*t681) + t1594 + 0.5e1_dp/0.2e1_dp &
4380  *t532*t533*t1632 - t677*t523 + 0.5e1_dp/0.3e1_dp*(t627) &
4381  *(t500)*(t539) - 0.12e2_dp*t148*t968*t159*t533 &
4382  *t1446 + 0.5e1_dp/0.2e1_dp*t1645*t534 + 0.2e1_dp*t81*t149*t325 &
4383  *t320
4384  t1675 = t1241*t651
4385  t1678 = t151*t626
4386  t1685 = t151*t152
4387  t1687 = t461*t320
4388  t1688 = t1213*t1210*t1687
4389  t1692 = t483*t155*t1687
4390  t1695 = t1203*t637
4391  t1712 = t155*t875
4392  t1719 = 0.3e1_dp/0.2e1_dp*t1326*t652 - 0.3e1_dp/0.2e1_dp*t1331*t1675 &
4393  + t1678*t453 - (2._dp*t451*t500*t1446) + (t451*t452 &
4394  *t875) - 0.75e2_dp/0.4e1_dp*t1685*t1688 - 0.3e1_dp/0.2e1_dp*t1331 &
4395  *t1692 - 0.5e1_dp/0.2e1_dp*t1363*t1695 + t1350*t635 - 0.3e1_dp/ &
4396  0.4e1_dp*t84*t1315*t461*t320 + 0.5e1_dp/0.2e1_dp*t1678*t463 - &
4397  t1308*t470*t461*t320/0.2e1_dp - t1308*t1309*t320/0.2e1_dp &
4398  + 0.3e1_dp/0.2e1_dp*t478*t484*t1712 - 0.2e1_dp*t478*t512*(t1446)
4399  t1731 = t166*t567
4400  t1737 = t166*t167
4401  t1739 = t483*t154*t1687
4402  t1747 = t1250*t156*t1687
4403  t1753 = t456*t156*t1687
4404  t1762 = t456*t168*t1687
4405  t1765 = (t478*t479*t875) - t166*t1437*t83*t170 + t1326 &
4406  *t649 - (2._dp*t81*t149*t163*t325*t320) + 0.3e1_dp/0.2e1_dp &
4407  *t1731*t486 + 0.5e1_dp/0.2e1_dp*t451*t457*t1632 + (3._dp* &
4408  t1737*t1739) - t151*t1592*t83*t159 + t1731*t480 - 0.27e2_dp &
4409  /0.4e1_dp*(t1737)*(t1747) + (t81*t466*t875) - &
4410  0.5e1_dp/0.2e1_dp*t1363*t1753 + 0.5e1_dp/0.2e1_dp*t1350*t638 + (t81 &
4411  *t471*t875)/0.2e1_dp + (10._dp*t1685*t1762)
4412  t1781 = t176*t626
4413  t1796 = t176*t177
4414  t1804 = -t176*t1592*t93*t159 + (2._dp*t1193*t661) + 0.5e1_dp &
4415  /0.2e1_dp*(t1193)*(t664) + (2._dp*t1781*t501) - (6._dp &
4416  *t499*t1178*t1446) - (5._dp*t1202*t1695) + (2._dp*t499 &
4417  *t500*t875) + 0.5e1_dp/0.2e1_dp*(t1781)*(t505) - (5._dp &
4418  *t1202*t1753) - 0.75e2_dp/0.4e1_dp*t1796*t1688 + 0.10e2_dp* &
4419  t1796*t1762 + 0.5e1_dp/0.2e1_dp*(t499)*(t504)*(t1632)
4420  t1812 = t180*t567
4421  t1834 = -t180*t1437*t93*t170 + (2._dp*t1230*t670) + 0.3e1_dp &
4422  /0.2e1_dp*(t1230)*(t673) + (2._dp*t1812*t513) - (6._dp &
4423  *t511*t1235*t1446) - (3._dp*t1240*t1675) + (2._dp*t511 &
4424  *t512*t875) + 0.3e1_dp/0.2e1_dp*(t1812)*(t517) - (3._dp &
4425  *t1240*t1692) - 0.27e2_dp/0.4e1_dp*t95*t1747 + 0.3e1_dp*t95 &
4426  *t1739 + 0.3e1_dp/0.2e1_dp*(t511)*(t516)*(t1712)
4427  t1860 = (6._dp*t511*t445*t320) + (3._dp*t526*t194*t44* &
4428  t875) - (t81*t93*t875) - (3._dp*t148*t444*t875) - (2._dp &
4429  *t568*t345) + f12*t1437*t94 - (5._dp*t1179*t538* &
4430  t6*t320) + (t1719 + t1765)*omega*t128 - 0.75e2_dp/0.4e1_dp*(t1273) &
4431  *(t533)*(t1210)*(t461)*(t320) + (t1804 &
4432  + t1834)*t185*t190 - 0.15e2_dp/0.2e1_dp*(t1169)*(t533) &
4433  *(t462)*(t320) + (12._dp*t148*t968*t325* &
4434  t320) - (2._dp*t342*t570) - 0.15e2_dp/0.2e1_dp*(t1169)*(t533) &
4435  *(t1170)*(t320) + (10._dp*t532*t533*t168 &
4436  *t461*t320) - (2._dp*t91*t344*t875)
4437  e_ndrho_rho = e_ndrho_rho + (-0.4e1_dp/0.3e1_dp*t322*t696 - t80*(t1652 + t1860)*clda)*sx
4438  t1878 = 2._dp*t119*t88 + 4._dp*t288*t565 + t11*t15*(f2*t892* &
4439  t68 - 2._dp*t561*t317 + 2._dp*t85*t900 - t85*t917)
4440  t1886 = t320**2
4441  t1935 = t599**2
4442  t1945 = t610**2
4443  t1979 = -((t97*(t99*t1878*t82 + 2._dp*t99*t567*t320 + t99 &
4444  *t90*t920 + 2._dp*t102*t1886 + 2._dp*t102*t82*t920 + 6._dp*t104 &
4445  *t82*t1886 + 3._dp*t104*t92*t920)*t113) - (7._dp*t584 &
4446  *t586) + 0.63e2_dp/0.4e1_dp*(t108)*(t1005)*(t1886) &
4447  - 0.7e1_dp/0.2e1_dp*(t108)*(t364)*(t920) - (t368 &
4448  *(f94*t892*t117*t121 - 2._dp*t1480*t593 + 4._dp*t589*t595 &
4449  *t121 + 2._dp*t1025*t18*t375*t899 - 4._dp*t1488*t593 - t374 &
4450  *t18*t375*t916 + 2._dp*t116*t68*t3*t18*t375)*t123*t136) &
4451  - (t368*t1935*t123*t136) + (4._dp*t1522*t617) + &
4452  (2._dp*t1068*t1535*t616) + 0.2e1_dp*(t368)*t397*t403 &
4453  *(t604*t612 - t416*t406*t1114*t1945/0.4e1_dp + t416*t406 &
4454  *t417*(t893*t77 - 2._dp*t1562*t608 + 2._dp*t1124*t77* &
4455  t899 - t419*t77*t916)/0.2e1_dp))*t140*t145 - (7._dp*t1583 &
4456  *t623) - 0.35e2_dp/0.4e1_dp*(t435)*(t1147)*(t1886) &
4457  - 0.7e1_dp/0.2e1_dp*(t435)*(t437)*(t920)
4458  t1981 = t1979*e*t149
4459  t1989 = t1886*t156
4460  t1999 = t168*t1886
4461  t2003 = t156*t920
4462  t2007 = t1210*t1886
4463  t2013 = -t1981*t195 + t1981 + (6._dp*t1627*t681) + (3._dp*t526 &
4464  *t194*t44*t920) - (15._dp*t1169*t533*t1989) + (5._dp &
4465  *t1645*t684) - (12._dp*t1295*t194*t44*t1886) + (10._dp &
4466  *t532*t533*t1999) + 0.5e1_dp/0.2e1_dp*(t532)*(t533) &
4467  *(t2003) - 0.75e2_dp/0.4e1_dp*(t1273)*(t533)*(t2007) &
4468  - (4._dp*t568*t570)
4469  t2050 = t1886*t155
4470  t2060 = t154*t1886
4471  t2064 = t155*t920
4472  t2068 = -t176*t1979*t93*t159 + (4._dp*t1781*t661) + (5._dp &
4473  *t1781*t664) - (6._dp*t499*t1178*t1886) - (10._dp*t499 &
4474  *t531*t1989) + (2._dp*t499*t500*t920) - 0.75e2_dp/0.4e1_dp &
4475  *(t499)*(t1214)*(t2007) + (10._dp*t499*t504* &
4476  t1999) + 0.5e1_dp/0.2e1_dp*(t499)*(t504)*(t2003) - &
4477  t180*t1878*t93*t170 + (4._dp*t1812*t670) + (3._dp*t1812 &
4478  *t673) - (6._dp*t511*t1235*t1886) - (6._dp*t511*t149 &
4479  *t483*t2050) + (2._dp*t511*t512*t920) - 0.27e2_dp/0.4e1_dp* &
4480  (t511)*(t1251)*(t1989) + (3._dp*t511*t516*t2060) &
4481  + 0.3e1_dp/0.2e1_dp*(t511)*(t516)*(t2064)
4482  t2107 = -(2._dp*t451*t500*t1886) + (t451*t452*t920) - &
4483  (5._dp*t451*t504*t1989) + (5._dp*t1678*t638) + (10._dp &
4484  *t451*t457*t1999) + 0.5e1_dp/0.2e1_dp*(t451)*(t457)* &
4485  (t2003) - 0.75e2_dp/0.4e1_dp*(t451)*(t1300)*(t2007) &
4486  - (2._dp*t81*t1304*t1886) - (t81*t93*t470*t1886) &
4487  + (t81*t466*t920) - 0.3e1_dp/0.4e1_dp*(t81)*(t1316) &
4488  *(t1886)
4489  t2140 = t81*t471*t920/0.2e1_dp - t166*t1878*t83*t170 + (2._dp &
4490  *t1731*t649) + (3._dp*t1731*t652) - (2._dp*t478*t512 &
4491  *t1886) + (t478)*t479*t920 - (3._dp*t478*t516*t2050) &
4492  + (3._dp*t478*t484*t2060) + 0.3e1_dp/0.2e1_dp*(t478)* &
4493  (t484)*(t2064) - 0.27e2_dp/0.4e1_dp*(t478)*(t1346) &
4494  *(t1989) - t151*t1979*t83*t159 + (2._dp*t1678*t635)
4495  t2159 = d2exeindrhondrho(q, dqndrho, d2qndrhondrho)
4496  t2174 = t2068*t185*t190 + 6._dp*t91*t1382*t1886 - 2._dp*t91*t344 &
4497  *t920 + (t2107 + t2140)*omega*t128 + f12*t1878*t94 - &
4498  t81*t93*t920 - 6._dp*t627*t629 - 3._dp*t148*t444*t920 + 2._dp* &
4499  t81*t149*t1886 + 12._dp*t148*t968*t1886 + t197*(t2159 + (t920 &
4500  *t200 - 2._dp*t1886*t545 + 2._dp*t1393*t1886 - t546*t920)* &
4501  t549*t199 - t690*t1401*t1620 + t691*t320)
4502  e_ndrho_ndrho = e_ndrho_ndrho + (-t80*(t2013 + t2174)*clda)*sx
4503  END IF
4504 
4505  END SUBROUTINE xwpbe_lda_calc_3
4506 
4507 ! **************************************************************************************************
4508 !> \brief Evaluates the screened hole averaged PBE exchange functional for lda.
4509 !> \param e_0 ...
4510 !> \param e_rho ...
4511 !> \param e_ndrho ...
4512 !> \param e_rho_rho ...
4513 !> \param e_ndrho_rho ...
4514 !> \param e_ndrho_ndrho ...
4515 !> \param rho , ndrho: density and norm of the density gradient
4516 !> \param ndrho ...
4517 !> \param omega screening parameter
4518 !> \param sscale scaling factor to enforce Lieb-Oxford bound
4519 !> \param sx scaling factor
4520 !> \param order degree of the derivative that should be evaluated,
4521 !> if positive all the derivatives up to the given degree are evaluated,
4522 !> if negative only the given degree is calculated
4523 !> \par History
4524 !> 05.2007 created [Manuel Guidon]
4525 !> \author Manuel Guidon
4526 !> \note
4527 !> This routine evaluates the functional for omega!=0 using a simple
4528 !> gaussian expansion for large ww and a taylor expansion for the
4529 !> parameter G.
4530 ! **************************************************************************************************
4531  SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, &
4532  e_ndrho_ndrho, rho, ndrho, omega, sscale, sx, order)
4533  REAL(kind=dp), INTENT(INOUT) :: e_0, e_rho, e_ndrho, e_rho_rho, &
4534  e_ndrho_rho, e_ndrho_ndrho
4535  REAL(kind=dp), INTENT(IN) :: rho, ndrho, omega, sscale, sx
4536  INTEGER, INTENT(IN) :: order
4537 
4538  REAL(kind=dp) :: d2qndrhondrho, d2qrhondrho, d2qrhorho, dqndrho, dqrho, q, t1, t10, t100, &
4539  t1001, t1011, t1017, t102, t1026, t103, t1033, t1035, t1040, t1047, t1048, t1049, t105, &
4540  t106, t1065, t1066, t1071, t1074, t108, t1082, t1089, t109, t1098, t11, t110, t111, &
4541  t1111, t1118, t113, t114, t115, t1155, t1157, t116, t117, t1174, t118, t1181, t1184, &
4542  t1189, t1190, t1198, t12, t1205, t1208, t121, t1210, t1218, t122, t1224, t1231, t125, &
4543  t1255, t126, t1261, t1264, t1266, t127, t1270, t1277, t128, t1288, t129, t1299, t13, &
4544  t1319, t1324, t133, t1336, t134, t1351, t136, t137, t1382, t1397, t14, t140
4545  REAL(kind=dp) :: t1405, t141, t1413, t1435, t1443, t1447, t1448, t145, t1452, t146, t1481, &
4546  t1483, t149, t15, t1500, t151, t1529, t153, t1533, t1537, t154, t155, t1552, t156, t1562, &
4547  t1566, t1570, t1576, t158, t159, t16, t160, t161, t1618, t163, t1652, t167, t1672, t169, &
4548  t17, t170, t171, t173, t174, t176, t177, t178, t179, t18, t180, t182, t183, t184, t185, &
4549  t188, t189, t19, t192, t193, t195, t196, t197, t198, t199, t2, t203, t206, t207, t208, &
4550  t209, t21, t210, t211, t212, t213, t219, t22, t220, t221, t222, t223, t227, t229, t23, &
4551  t235, t238, t239, t24, t240, t241, t246, t248, t249, t25, t252
4552  REAL(kind=dp) :: t253, t256, t257, t258, t261, t262, t263, t265, t266, t269, t27, t270, &
4553  t274, t277, t278, t279, t28, t281, t283, t286, t289, t29, t290, t293, t296, t299, t3, &
4554  t300, t302, t303, t305, t306, t309, t31, t310, t313, t316, t32, t321, t326, t327, t329, &
4555  t330, t331, t332, t333, t334, t34, t340, t341, t342, t345, t346, t35, t350, t351, t352, &
4556  t355, t359, t36, t360, t367, t368, t369, t372, t373, t374, t375, t379, t38, t382, t388, &
4557  t389, t39, t390, t393, t394, t4, t400, t401, t402, t405, t406, t41, t410, t412, t415, &
4558  t417, t42, t420, t421, t422, t423, t426, t427, t428, t431, t433, t434
4559  REAL(kind=dp) :: t435, t437, t438, t439, t44, t443, t444, t450, t453, t454, t456, t457, &
4560  t459, t46, t464, t465, t468, t469, t472, t473, t475, t476, t477, t478, t48, t484, t486, &
4561  t487, t49, t498, t5, t500, t501, t505, t510, t513, t519, t522, t526, t530, t533, t536, &
4562  t539, t54, t540, t544, t545, t548, t55, t553, t555, t557, t558, t56, t561, t563, t564, &
4563  t568, t569, t572, t575, t576, t578, t579, t58, t581, t584, t588, t594, t597, t599, t6, &
4564  t60, t603, t607, t61, t610, t613, t616, t618, t619, t620, t623, t63, t632, t65, t655, &
4565  t657, t662, t664, t667, t67, t68, t69, t694, t7, t70, t700, t706, t71
4566  REAL(kind=dp) :: t72, t723, t726, t728, t73, t74, t744, t75, t751, t752, t769, t77, t772, &
4567  t774, t78, t782, t783, t784, t789, t792, t793, t794, t795, t799, t8, t80, t803, t804, &
4568  t807, t81, t811, t812, t819, t82, t83, t84, t848, t85, t852, t862, t863, t864, t865, &
4569  t868, t87, t872, t878, t879, t88, t880, t9, t90, t91, t916, t92, t920, t93, t930, t931, &
4570  t932, t935, t939, t94, t943, t95, t956, t96, t961, t966, t97, t972, t985, t99, t990, t995
4571 
4572  IF (order >= 0) THEN
4573  t1 = ndrho**2
4574  t2 = r2**2
4575  t3 = 0.1e1_dp/t2
4576  t4 = t1*t3
4577  t5 = pi**2
4578  t6 = r3*t5
4579  t7 = t6*rho
4580  t8 = t7**(0.1e1_dp/0.3e1_dp)
4581  t9 = t8**2
4582  t10 = 0.1e1_dp/t9
4583  t11 = t4*t10
4584  t12 = rho**2
4585  t13 = 0.1e1_dp/t12
4586  t14 = sscale**2
4587  t15 = t13*t14
4588  t16 = a1*t1
4589  t17 = t16*t3
4590  t18 = t10*t13
4591  t19 = t18*t14
4592  t21 = t1**2
4593  t22 = a2*t21
4594  t23 = t2**2
4595  t24 = 0.1e1_dp/t23
4596  t25 = t22*t24
4597  t27 = 0.1e1_dp/t8/t7
4598  t28 = t12**2
4599  t29 = 0.1e1_dp/t28
4600  t31 = t14**2
4601  t32 = t27*t29*t31
4602  t34 = t17*t19 + t25*t32
4603  t35 = a3*t21
4604  t36 = t35*t24
4605  t38 = t21*ndrho
4606  t39 = a4*t38
4607  t41 = 0.1e1_dp/t23/r2
4608  t42 = t39*t41
4609  t44 = 0.1e1_dp/t9/t7
4610  t46 = 0.1e1_dp/t28/rho
4611  t48 = t31*sscale
4612  t49 = t44*t46*t48
4613  t54 = 0.1e1_dp/t23/t2
4614  t55 = a5*t21*t1*t54
4615  t56 = r3**2
4616  t58 = t5**2
4617  t60 = 0.1e1_dp/t56/t58
4618  t61 = t28**2
4619  t63 = t31*t14
4620  t65 = t60/t61*t63
4621  t67 = r1 + t36*t32 + t42*t49 + t55*t65
4622  t68 = 0.1e1_dp/t67
4623  t69 = t34*t68
4624  t70 = t15*t69
4625  t71 = t11*t70
4626  t72 = omega**2
4627  t73 = beta2*t72
4628  t74 = t73*t10
4629  t75 = t71 + t74
4630  t77 = 0.1e1_dp/a
4631  q = f94*t75*t77
4632  t78 = rho**(0.1e1_dp/0.3e1_dp)
4633  t80 = t78*rho*f89
4634  t81 = b*f12
4635  t82 = t71 + dd
4636  t83 = 0.1e1_dp/t82
4637  t84 = t81*t83
4638  t85 = f2*t34
4639  t87 = f1 + t85*t68
4640  t88 = t15*t87
4641  t90 = t11*t88 + r1
4642  t91 = f12*t90
4643  t92 = t82**2
4644  t93 = 0.1e1_dp/t92
4645  t94 = c*t93
4646  t95 = t91*t94
4647  t96 = g2*t1
4648  t97 = t96*t3
4649  t99 = g3*t21
4650  t100 = t99*t24
4651  t102 = g1 + t97*t19 + t100*t32
4652  t103 = t15*t102
4653  t105 = t11*t103 + r1
4654  t106 = t105*e
4655  t108 = 0.1e1_dp/t92/t82
4656  t109 = t106*t108
4657  t110 = f158*e
4658  t111 = t105*t83
4659  t113 = t71 + dd + t72*t10
4660  t114 = t113**2
4661  t115 = t114**2
4662  t116 = t115*t113
4663  t117 = sqrt(t116)
4664  t118 = 0.1e1_dp/t117
4665  t121 = sqrt(t113)
4666  t122 = 0.1e1_dp/t121
4667  t125 = f68*c
4668  t126 = t90*t83
4669  t127 = t114*t113
4670  t128 = sqrt(t127)
4671  t129 = 0.1e1_dp/t128
4672  t133 = (-t110*t111*t118 - t81*t83*t122 - t125*t126*t129) &
4673  *omega
4674  t134 = 0.1e1_dp/t8
4675  t136 = f52*e
4676  t137 = t105*t93
4677  t140 = f12*c
4678  t141 = t90*t93
4679  t145 = t72*omega
4680  t146 = (-t136*t137*t118 - t140*t141*t129)*t145
4681  t149 = 0.1e1_dp/r3/t5
4682  t151 = t149/rho
4683  t153 = t72**2
4684  t154 = t153*omega
4685  t155 = t118*t154
4686  t156 = t155*t44
4687  t158 = f12*a
4688  t159 = exei(q)
4689  t160 = t71 + dd + t74
4690  t161 = 0.1e1_dp/t160
4691  t163 = log(t75*t161)
4692  t167 = (t84 + t95 + t109 + t133*t134 + t146*t151 - t109*t156 &
4693  + t158*(t159 + t163))*clda
4694  e_0 = e_0 + (-t80*t167)*sx
4695  END IF
4696  IF (order >= 1 .OR. order == -1) THEN
4697  t169 = t44*t13
4698  t170 = t4*t169
4699  t171 = t14*t34
4700  t173 = t68*r3*t5
4701  t174 = t171*t173
4702  t176 = 0.2e1_dp/0.3e1_dp*t170*t174
4703  t177 = t12*rho
4704  t178 = 0.1e1_dp/t177
4705  t179 = t178*t14
4706  t180 = t179*t69
4707  t182 = 2._dp*t11*t180
4708  t183 = t3*t44
4709  t184 = t16*t183
4710  t185 = t15*t6
4711  t188 = t10*t178
4712  t189 = t188*t14
4713  t192 = t56*t58
4714  t193 = t192*t12
4715  t195 = 0.1e1_dp/t8/t193
4716  t196 = t24*t195
4717  t197 = t22*t196
4718  t198 = t29*t31
4719  t199 = t198*t6
4720  t203 = t27*t46*t31
4721  t206 = -0.2e1_dp/0.3e1_dp*t184*t185 - (2._dp*t17*t189) - 0.4e1_dp &
4722  /0.3e1_dp*t197*t199 - (4._dp*t25*t203)
4723  t207 = t206*t68
4724  t208 = t15*t207
4725  t209 = t11*t208
4726  t210 = t4*t18
4727  t211 = t67**2
4728  t212 = 0.1e1_dp/t211
4729  t213 = t35*t196
4730  t219 = 0.1e1_dp/t9/t193
4731  t220 = t41*t219
4732  t221 = t39*t220
4733  t222 = t46*t48
4734  t223 = t222*t6
4735  t227 = 0.1e1_dp/t28/t12
4736  t229 = t44*t227*t48
4737  t235 = t60/t61/rho*t63
4738  t238 = -0.4e1_dp/0.3e1_dp*t213*t199 - (4._dp*t36*t203) - 0.5e1_dp &
4739  /0.3e1_dp*t221*t223 - (5._dp*t42*t229) - (8._dp*t55*t235)
4740  t239 = t212*t238
4741  t240 = t171*t239
4742  t241 = t210*t240
4743  t246 = -t176 - t182 + t209 - t241 - 0.2e1_dp/0.3e1_dp*t73*t44*r3 &
4744  *t5
4745  dqrho = f94*t246*t77
4746  t248 = ndrho*t3
4747  t249 = t248*t10
4748  t252 = a1*ndrho
4749  t253 = t252*t3
4750  t256 = t1*ndrho
4751  t257 = a2*t256
4752  t258 = t257*t24
4753  t261 = 2._dp*t253*t19 + 4._dp*t258*t32
4754  t262 = t261*t68
4755  t263 = t15*t262
4756  t265 = a3*t256
4757  t266 = t265*t24
4758  t269 = a4*t21
4759  t270 = t269*t41
4760  t274 = a5*t38*t54
4761  t277 = 4._dp*t266*t32 + 5._dp*t270*t49 + 6._dp*t274*t65
4762  t278 = t212*t277
4763  t279 = t171*t278
4764  t281 = 2._dp*t249*t70 + t11*t263 - t210*t279
4765  dqndrho = f94*t281*t77
4766  t283 = t78*f89
4767  t286 = -t176 - t182 + t209 - t241
4768  t289 = t14*t87
4769  t290 = t289*t6
4770  t293 = t179*t87
4771  t296 = f2*t206
4772  t299 = t296*t68 - t85*t239
4773  t300 = t15*t299
4774  t302 = -0.2e1_dp/0.3e1_dp*t170*t290 - (2._dp*t11*t293) + (t11 &
4775  *t300)
4776  t303 = f12*t302
4777  t305 = c*t108
4778  t306 = t305*t286
4779  t309 = t14*t102
4780  t310 = t309*t6
4781  t313 = t179*t102
4782  t316 = t96*t183
4783  t321 = t99*t196
4784  t326 = -0.2e1_dp/0.3e1_dp*t316*t185 - (2._dp*t97*t189) - 0.4e1_dp &
4785  /0.3e1_dp*t321*t199 - (4._dp*t100*t203)
4786  t327 = t15*t326
4787  t329 = -0.2e1_dp/0.3e1_dp*t170*t310 - (2._dp*t11*t313) + (t11 &
4788  *t327)
4789  t330 = t329*e
4790  t331 = t330*t108
4791  t332 = t92**2
4792  t333 = 0.1e1_dp/t332
4793  t334 = t333*t286
4794  t340 = t110*t105
4795  t341 = t93*t118
4796  t342 = t341*t286
4797  t345 = 0.1e1_dp/t117/t116
4798  t346 = t83*t345
4799  t350 = -t176 - t182 + t209 - t241 - 0.2e1_dp/0.3e1_dp*t72*t44*t6
4800  t351 = t115*t350
4801  t352 = t346*t351
4802  t355 = t93*t122
4803  t359 = 0.1e1_dp/t121/t113
4804  t360 = t83*t359
4805  t367 = t125*t90
4806  t368 = t93*t129
4807  t369 = t368*t286
4808  t372 = 0.1e1_dp/t128/t127
4809  t373 = t83*t372
4810  t374 = t114*t350
4811  t375 = t373*t374
4812  t379 = (-t110*t329*t83*t118 + t340*t342 + 0.5e1_dp/0.2e1_dp*t340 &
4813  *t352 + t81*t355*t286 + t81*t360*t350/0.2e1_dp - t125 &
4814  *t302*t83*t129 + t367*t369 + 0.3e1_dp/0.2e1_dp*t367*t375)* &
4815  omega
4816  t382 = t27*r3*t5
4817  t388 = t136*t105
4818  t389 = t108*t118
4819  t390 = t389*t286
4820  t393 = t93*t345
4821  t394 = t393*t351
4822  t400 = t140*t90
4823  t401 = t108*t129
4824  t402 = t401*t286
4825  t405 = t93*t372
4826  t406 = t405*t374
4827  t410 = (-t136*t329*t93*t118 + (2._dp*t388*t390) + 0.5e1_dp/ &
4828  0.2e1_dp*(t388)*(t394) - t140*t302*t93*t129 + (2._dp &
4829  *t400*t402) + 0.3e1_dp/0.2e1_dp*(t400)*(t406))*t145
4830  t412 = t149*t13
4831  t415 = t106*t333
4832  t417 = t155*t44*t286
4833  t420 = t108*t345
4834  t421 = t106*t420
4835  t422 = t154*t44
4836  t423 = t422*t351
4837  t426 = t106*t389
4838  t427 = t154*t219
4839  t428 = t427*t6
4840  t431 = dexeirho(q, dqrho)
4841  t433 = t160**2
4842  t434 = 0.1e1_dp/t433
4843  t435 = t75*t434
4844  t437 = t246*t161 - t435*t246
4845  t438 = 0.1e1_dp/t75
4846  t439 = t437*t438
4847  t443 = -t81*t93*t286 + t303*t94 - (2._dp*t91*t306) + t331 &
4848  - (3._dp*t106*t334) + t379*t134 - t133*t382/0.3e1_dp + t410 &
4849  *t151 - t146*t412 - t331*t156 + (3._dp*t415*t417) + 0.5e1_dp &
4850  /0.2e1_dp*t421*t423 + 0.5e1_dp/0.3e1_dp*t426*t428 + t158*(t431 &
4851  + t439*t160)
4852  t444 = t443*clda
4853  e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t283*t167 - t80*t444)*sx
4854  t450 = f2*t261
4855  t453 = t450*t68 - t85*t278
4856  t454 = t15*t453
4857  t456 = 2._dp*t249*t88 + t11*t454
4858  t457 = f12*t456
4859  t459 = t305*t281
4860  t464 = g2*ndrho
4861  t465 = t464*t3
4862  t468 = g3*t256
4863  t469 = t468*t24
4864  t472 = 2._dp*t465*t19 + 4._dp*t469*t32
4865  t473 = t15*t472
4866  t475 = 2._dp*t249*t103 + t11*t473
4867  t476 = t475*e
4868  t477 = t476*t108
4869  t478 = t333*t281
4870  t484 = t341*t281
4871  t486 = t115*t281
4872  t487 = t346*t486
4873  t498 = t368*t281
4874  t500 = t114*t281
4875  t501 = t373*t500
4876  t505 = (-t110*t475*t83*t118 + t340*t484 + 0.5e1_dp/0.2e1_dp*t340 &
4877  *t487 + t81*t355*t281 + t81*t360*t281/0.2e1_dp - t125 &
4878  *t456*t83*t129 + t367*t498 + 0.3e1_dp/0.2e1_dp*t367*t501)* &
4879  omega
4880  t510 = t389*t281
4881  t513 = t393*t486
4882  t519 = t401*t281
4883  t522 = t405*t500
4884  t526 = (-t136*t475*t93*t118 + (2._dp*t388*t510) + 0.5e1_dp/ &
4885  0.2e1_dp*(t388)*(t513) - t140*t456*t93*t129 + (2._dp &
4886  *t400*t519) + 0.3e1_dp/0.2e1_dp*(t400)*(t522))*t145
4887  t530 = t155*t44*t281
4888  t533 = t422*t486
4889  t536 = dexeindrho(q, dqndrho)
4890  t539 = t281*t161 - t435*t281
4891  t540 = t539*t438
4892  t544 = -t81*t93*t281 + t457*t94 - (2._dp*t91*t459) + t477 &
4893  - (3._dp*t106*t478) + t505*t134 + t526*t151 - t477*t156 &
4894  + (3._dp*t415*t530) + 0.5e1_dp/0.2e1_dp*t421*t533 + t158*(t536 &
4895  + t540*t160)
4896  t545 = t544*clda
4897  e_ndrho = e_ndrho + (-t80*t545)*sx
4898  END IF
4899  IF (order >= 2 .OR. order == -2) THEN
4900  t548 = t4*t219*t13
4901  t553 = 0.10e2_dp/0.9e1_dp*t548*t171*t68*t56*t58
4902  t555 = t4*t44*t178
4903  t557 = 0.8e1_dp/0.3e1_dp*t555*t174
4904  t558 = t14*t206
4905  t561 = 0.4e1_dp/0.3e1_dp*t170*t558*t173
4906  t563 = t4*t169*t14
4907  t564 = t34*t212
4908  t568 = 0.4e1_dp/0.3e1_dp*t563*t564*t6*t238
4909  t569 = t29*t14
4910  t572 = 6._dp*t11*t569*t69
4911  t575 = 4._dp*t11*t179*t207
4912  t576 = t4*t188
4913  t578 = 4._dp*t576*t240
4914  t579 = t3*t219
4915  t581 = t15*t192
4916  t584 = t179*t6
4917  t588 = t10*t29*t14
4918  t594 = t56*r3*t58*t5*t177
4919  t597 = t24/t8/t594
4920  t599 = t198*t192
4921  t603 = t46*t31*t6
4922  t607 = t27*t227*t31
4923  t610 = 0.10e2_dp/0.9e1_dp*t16*t579*t581 + 0.8e1_dp/0.3e1_dp*t184* &
4924  t584 + (6._dp*t17*t588) + 0.28e2_dp/0.9e1_dp*t22*t597*t599 + &
4925  0.32e2_dp/0.3e1_dp*t197*t603 + (20._dp*t25*t607)
4926  t613 = t11*t15*t610*t68
4927  t616 = 2._dp*t210*t558*t239
4928  t618 = 0.1e1_dp/t211/t67
4929  t619 = t238**2
4930  t620 = t618*t619
4931  t623 = 2._dp*t210*t171*t620
4932  t632 = 0.1e1_dp/t9/t594
4933  t655 = t212*(0.28e2_dp/0.9e1_dp*t35*t597*t599 + 0.32e2_dp/0.3e1_dp &
4934  *t213*t603 + (20._dp*t36*t607) + 0.40e2_dp/0.9e1_dp*t39*t41 &
4935  *t632*t222*t192 + 0.50e2_dp/0.3e1_dp*t221*t227*t48*t6 + &
4936  0.30e2_dp*t42*t44/t28/t177*t48 + (72._dp*t55*t60/t61 &
4937  /t12*t63))
4938  t657 = t210*t171*t655
4939  t662 = t553 + t557 - t561 + t568 + t572 - t575 + t578 + t613 - t616 &
4940  + t623 - t657 + 0.10e2_dp/0.9e1_dp*t73*t219*t56*t58
4941  d2qrhorho = f94*t662*t77
4942  t664 = t248*t169
4943  t667 = t14*t261
4944  t694 = -0.4e1_dp/0.3e1_dp*t252*t183*t185 - (4._dp*t253*t189) &
4945  - 0.16e2_dp/0.3e1_dp*t257*t196*t199 - (16._dp*t258*t203)
4946  t700 = t248*t18
4947  t706 = t618*t238*t277
4948  t723 = t212*(-0.16e2_dp/0.3e1_dp*t265*t196*t199 - (16._dp*t266 &
4949  *t203) - 0.25e2_dp/0.3e1_dp*t269*t220*t223 - (25._dp*t270* &
4950  t229) - (48._dp*t274*t235))
4951  t726 = -0.4e1_dp/0.3e1_dp*t664*t174 - 0.2e1_dp/0.3e1_dp*t170*t667* &
4952  t173 + 0.2e1_dp/0.3e1_dp*t563*t564*t6*t277 - (4._dp*t249* &
4953  t180) - (2._dp*t11*t179*t262) + (2._dp*t576*t279) + (2._dp &
4954  *t249*t208) + (t11*t15*t694*t68) - t210*t558*t278 &
4955  - (2._dp*t700*t240) - t210*t667*t239 + 0.2e1_dp*t210* &
4956  t171*t706 - t210*t171*t723
4957  d2qrhondrho = f94*t726*t77
4958  t728 = t3*t10
4959  t744 = 2._dp*a1*t3*t19 + 12._dp*a2*t1*t24*t32
4960  t751 = t277**2
4961  t752 = t618*t751
4962  t769 = t212*(12._dp*a3*t1*t24*t32 + 20._dp*a4*t256*t41*t49 &
4963  + 30._dp*a5*t21*t54*t65)
4964  t772 = 2._dp*t728*t13*t171*t68 + 4._dp*t249*t263 - 4._dp*t700*t279 &
4965  + t11*t15*t744*t68 - 2._dp*t210*t667*t278 + 2._dp*t210* &
4966  t171*t752 - t210*t171*t769
4967  d2qndrhondrho = f94*t772*t77
4968  t774 = t78**2
4969  t782 = 0.1e1_dp/t332/t82
4970  t783 = t106*t782
4971  t784 = t286**2
4972  t789 = t115**2
4973  t792 = 0.1e1_dp/t117/t789/t114
4974  t793 = t83*t792
4975  t794 = t350**2
4976  t795 = t789*t794
4977  t799 = t108*t122
4978  t803 = t81*t93
4979  t804 = t359*t286
4980  t807 = t553 + t557 - t561 + t568 + t572 - t575 + t578 + t613 - t616 &
4981  + t623 - t657
4982  t811 = 0.1e1_dp/t121/t114
4983  t812 = t83*t811
4984  t819 = t553 + t557 - t561 + t568 + t572 - t575 + t578 + t613 - t616 &
4985  + t623 - t657 + 0.10e2_dp/0.9e1_dp*t72*t219*t192
4986  t848 = 0.10e2_dp/0.9e1_dp*t548*t289*t192 + 0.8e1_dp/0.3e1_dp*t555* &
4987  t290 - 0.4e1_dp/0.3e1_dp*t170*t14*t299*t6 + (6._dp*t11*t569 &
4988  *t87) - 0.4e1_dp*(t11)*t179*t299 + (t11*t15*(f2 &
4989  *t610*t68 - 2._dp*t296*t239 + 2._dp*t85*t620 - t85*t655))
4990  t852 = t125*t302
4991  t862 = -0.75e2_dp/0.4e1_dp*t340*t793*t795 - (2._dp*t81*t799* &
4992  t784) - t803*t804*t350 + (t81*t355*t807) - 0.3e1_dp/0.4e1_dp &
4993  *(t81)*(t812)*(t794) + (t81*t360*t819) &
4994  /0.2e1_dp - t125*t848*t83*t129 + (2._dp*t852*t369) + (3._dp &
4995  *t852*t375) - (2._dp*t367*t401*t784) + (t367*t368 &
4996  *t807)
4997  t863 = t125*t141
4998  t864 = t372*t286
4999  t865 = t864*t374
5000  t868 = t113*t794
5001  t872 = t114*t819
5002  t878 = 0.1e1_dp/t128/t115/t114
5003  t879 = t83*t878
5004  t880 = t115*t794
5005  t916 = 0.10e2_dp/0.9e1_dp*t548*t309*t192 + 0.8e1_dp/0.3e1_dp*t555* &
5006  t310 - 0.4e1_dp/0.3e1_dp*t170*t14*t326*t6 + (6._dp*t11*t569 &
5007  *t102) - 0.4e1_dp*(t11)*t179*t326 + (t11)*t15*(0.10e2_dp &
5008  /0.9e1_dp*t96*t579*t581 + 0.8e1_dp/0.3e1_dp*t316*t584 + &
5009  (6._dp*t97*t588) + 0.28e2_dp/0.9e1_dp*t99*t597*t599 + 0.32e2_dp &
5010  /0.3e1_dp*t321*t603 + (20._dp*t100*t607))
5011  t920 = t110*t329
5012  t930 = t110*t137
5013  t931 = t345*t286
5014  t932 = t931*t351
5015  t935 = t127*t794
5016  t939 = t115*t819
5017  t943 = -(3._dp*t863*t865) + (3._dp*t367*t373*t868) + 0.3e1_dp &
5018  /0.2e1_dp*(t367)*(t373)*(t872) - 0.27e2_dp/0.4e1_dp &
5019  *(t367)*(t879)*(t880) - t110*t916*t83*t118 &
5020  + (2._dp*t920*t342) + (5._dp*t920*t352) - (2._dp*t340* &
5021  t389*t784) + (t340*t341*t807) - (5._dp*t930*t932) + &
5022  (10._dp*t340*t346*t935) + 0.5e1_dp/0.2e1_dp*(t340)*(t346) &
5023  *(t939)
5024  t956 = t136*t329
5025  t961 = t333*t118
5026  t966 = t136*t105*t108
5027  t972 = t93*t792
5028  t985 = t140*t302
5029  t990 = t333*t129
5030  t995 = t140*t90*t108
5031  t1001 = t93*t878
5032  t1011 = -t136*t916*t93*t118 + (4._dp*t956*t390) + (5._dp &
5033  *t956*t394) - (6._dp*t388*t961*t784) - (10._dp*t966*t932) &
5034  + (2._dp*t388*t389*t807) - 0.75e2_dp/0.4e1_dp*(t388) &
5035  *(t972)*(t795) + (10._dp*t388*t393*t935) + 0.5e1_dp &
5036  /0.2e1_dp*(t388)*(t393)*(t939) - t140*t848*t93 &
5037  *t129 + (4._dp*t985*t402) + (3._dp*t985*t406) - (6._dp* &
5038  t400*t990*t784) - (6._dp*t995*t865) + (2._dp*t400*t401 &
5039  *t807) - 0.27e2_dp/0.4e1_dp*(t400)*(t1001)*(t880) &
5040  + (3._dp*t400*t405*t868) + 0.3e1_dp/0.2e1_dp*(t400)*(t405) &
5041  *(t872)
5042  t1017 = t106*t961
5043  t1026 = t106*t420*t154
5044  t1033 = d2exeirhorho(q, dqrho, d2qrhorho)
5045  t1035 = t246**2
5046  t1040 = t75/t433/t160
5047  t1047 = t75**2
5048  t1048 = 0.1e1_dp/t1047
5049  t1049 = t437*t1048
5050  t1065 = t106*t333*t345
5051  t1066 = t286*t115
5052  t1071 = t330*t420
5053  t1074 = -(12._dp*t783*t155*t44*t784) + (t862 + t943)*omega &
5054  *t134 + f12*t848*t94 + 0.4e1_dp/0.9e1_dp*t133*t195*t56* &
5055  t58 + t1011*t145*t151 + (12._dp*t106*t782*t784) - (10._dp &
5056  *t1017*t427*t286*r3*t5) - (t81*t93*t807) - 0.25e2_dp &
5057  /0.3e1_dp*(t1026)*(t219)*(t115)*(t350)* &
5058  (r3)*(t5) + (t158*(t1033 + (t662*t161 - 2._dp*t1035 &
5059  *t434 + 2._dp*t1040*t1035 - t435*t662)*t438*t160 - t1049 &
5060  *t160*t246 + t439*t246)) + (3._dp*t415*t155*t44*t807) &
5061  + (2._dp*t81*t108*t784) - (4._dp*t303*t306) - (15._dp* &
5062  t1065*t422*t1066*t350) + (5._dp*t1071*t423)
5063  t1082 = t106*t108*t792
5064  t1089 = t330*t333
5065  t1098 = t916*e*t108
5066  t1111 = c*t333
5067  t1118 = 0.5e1_dp/0.2e1_dp*t421*t422*t939 + (2._dp*t146*t149* &
5068  t178) - 0.75e2_dp/0.4e1_dp*t1082*t422*t795 - (3._dp*t106*t333 &
5069  *t807) + (6._dp*t1089*t417) + 0.10e2_dp*t421*t422*t935 &
5070  - 0.2e1_dp/0.3e1_dp*t379*t382 + t1098 - 0.40e2_dp/0.9e1_dp*t426*t154 &
5071  *t632*t192 - (2._dp*t410*t412) - (2._dp*t91*t305*t807) &
5072  - (6._dp*t330*t334) - t1098*t156 + (6._dp*t91*t1111 &
5073  *t784) + 0.10e2_dp/0.3e1_dp*(t330)*(t389)*(t428)
5074  e_rho_rho = e_rho_rho + (-0.4e1_dp/0.9e1_dp/t774*f89*t167 - 0.8e1_dp/0.3e1_dp*t283*t444 &
5075  - t80*(t1074 + t1118)*clda)*sx
5076  t1155 = -0.4e1_dp/0.3e1_dp*t664*t310 - 0.2e1_dp/0.3e1_dp*t170*t14* &
5077  t472*t6 - (4._dp*t249*t313) - 0.2e1_dp*t11*t179*t472 + (2._dp &
5078  *t249*t327) + t11*t15*(-0.4e1_dp/0.3e1_dp*t464*t183* &
5079  t185 - (4._dp*t465*t189) - 0.16e2_dp/0.3e1_dp*t468*t196*t199 &
5080  - (16._dp*t469*t203))
5081  t1157 = t1155*e*t108
5082  t1174 = t476*t333
5083  t1181 = t931*t486
5084  t1184 = t114*t726
5085  t1189 = t350*t281
5086  t1190 = t372*t114*t1189
5087  t1198 = t115*t726
5088  t1205 = t110*t475
5089  t1208 = t110*t111
5090  t1210 = t792*t789*t1189
5091  t1218 = t286*t281
5092  t1224 = t125*t456
5093  t1231 = -0.5e1_dp/0.2e1_dp*t930*t1181 + 0.3e1_dp/0.2e1_dp*t367*t373 &
5094  *t1184 - 0.3e1_dp/0.2e1_dp*t863*t1190 - t803*t804*t281/0.2e1_dp &
5095  + t81*t355*t726 + 0.5e1_dp/0.2e1_dp*t340*t346*t1198 + t81 &
5096  *t360*t726/0.2e1_dp + 0.5e1_dp/0.2e1_dp*t1205*t352 - 0.75e2_dp/0.4e1_dp &
5097  *t1208*t1210 - 0.2e1_dp*t81*t108*t122*t286*t281 - 0.2e1_dp &
5098  *t340*t389*t1218 + t340*t341*t726 + 0.3e1_dp/0.2e1_dp* &
5099  t1224*t375 - t110*t1155*t83*t118 + t920*t484
5100  t1255 = -0.4e1_dp/0.3e1_dp*t664*t290 - 0.2e1_dp/0.3e1_dp*t170*t14* &
5101  t453*t6 - (4._dp*t249*t293) - 0.2e1_dp*t11*t179*t453 + (2._dp &
5102  *t249*t300) + t11*t15*(f2*t694*t68 - t296*t278 &
5103  - t450*t239 + 2._dp*t85*t706 - t85*t723)
5104  t1261 = t345*t115*t1189
5105  t1264 = t125*t126
5106  t1266 = t878*t115*t1189
5107  t1270 = t345*t127*t1189
5108  t1277 = t372*t113*t1189
5109  t1288 = t864*t500
5110  t1299 = -t125*t1255*t83*t129 + t852*t498 - 0.5e1_dp/0.2e1_dp* &
5111  t930*t1261 - 0.27e2_dp/0.4e1_dp*t1264*t1266 + (10._dp*t1208* &
5112  t1270) + 0.3e1_dp/0.2e1_dp*t852*t501 + t1224*t369 + 0.3e1_dp*t1264 &
5113  *t1277 - 0.3e1_dp/0.4e1_dp*t84*t811*t350*t281 - t803*t359 &
5114  *t350*t281/0.2e1_dp - 0.3e1_dp/0.2e1_dp*t863*t1288 - (2._dp*t367 &
5115  *t401*t1218) + (t367*t368*t726) + 0.5e1_dp/0.2e1_dp*t920 &
5116  *t487 + t1205*t342
5117  t1319 = -0.75e2_dp/0.4e1_dp*t1082*t422*t789*t350*t281 - t1157 &
5118  *t156 - 0.15e2_dp/0.2e1_dp*t1065*t422*t1066*t281 + t1157 - (2._dp &
5119  *t303*t459) + 0.5e1_dp/0.3e1_dp*t476*t389*t428 - 0.25e2_dp &
5120  /0.6e1_dp*t1026*t219*r3*t5*t115*t281 + (3._dp*t1174* &
5121  t417) - t526*t412 - (2._dp*t91*t305*t726) + (t1231 + t1299) &
5122  *omega*t134 + 0.6e1_dp*t400*t334*t281 - 0.5e1_dp*t1017*t427 &
5123  *t6*t281 + 0.10e2_dp*t421*t422*t127*t350*t281 - (2._dp &
5124  *t457*t306) + 0.5e1_dp/0.2e1_dp*t1071*t533
5125  t1324 = d2exeirhondrho(q, dqrho, dqndrho, d2qrhondrho)
5126  t1336 = t160*t281
5127  t1351 = t476*t420
5128  t1382 = t136*t475
5129  t1397 = t136*t137
5130  t1405 = -t136*t1155*t93*t118 + (2._dp*t956*t510) + 0.5e1_dp &
5131  /0.2e1_dp*(t956)*(t513) + (2._dp*t1382*t390) - (6._dp &
5132  *t388*t961*t1218) - (5._dp*t966*t1181) + (2._dp*t388 &
5133  *t389*t726) + 0.5e1_dp/0.2e1_dp*(t1382)*(t394) - (5._dp &
5134  *t966*t1261) - 0.75e2_dp/0.4e1_dp*t1397*t1210 + 0.10e2_dp*t1397 &
5135  *t1270 + 0.5e1_dp/0.2e1_dp*(t388)*(t393)*(t1198)
5136  t1413 = t140*t456
5137  t1435 = -t140*t1255*t93*t129 + (2._dp*t985*t519) + 0.3e1_dp &
5138  /0.2e1_dp*(t985)*(t522) + (2._dp*t1413*t402) - (6._dp &
5139  *t400*t990*t1218) - (3._dp*t995*t1288) + (2._dp*t400 &
5140  *t401*t726) + 0.3e1_dp/0.2e1_dp*(t1413)*(t406) - (3._dp &
5141  *t995*t1190) - 0.27e2_dp/0.4e1_dp*t95*t1266 + 0.3e1_dp*t95*t1277 &
5142  + 0.3e1_dp/0.2e1_dp*(t400)*(t405)*(t1184)
5143  t1443 = -0.15e2_dp/0.2e1_dp*t1065*t422*t351*t281 + t158*(t1324 &
5144  + (t726*t161 - 0.2e1_dp*t246*t434*t281 + 0.2e1_dp*t1040*t246 &
5145  *t281 - t435*t726)*t438*t160 - t1049*t1336 + t439*t281) &
5146  - 0.12e2_dp*t106*t782*t118*t422*t1218 + 0.5e1_dp/0.2e1_dp* &
5147  t421*t422*t1198 - (3._dp*t330*t478) + 0.5e1_dp/0.2e1_dp*t1351 &
5148  *t423 + 0.12e2_dp*t106*t782*t286*t281 - 0.3e1_dp*t106*t333 &
5149  *t726 - t81*t93*t726 + f12*t1255*t94 + (3._dp*t1089 &
5150  *t530) - (3._dp*t476*t334) + 0.2e1_dp*t81*t108*t286*t281 &
5151  - t505*t382/0.3e1_dp + (t1405 + t1435)*t145*t151 + 0.3e1_dp*t415 &
5152  *t155*t44*t726
5153  e_ndrho_rho = e_ndrho_rho + (-0.4e1_dp/0.3e1_dp*t283*t545 - t80*(t1319 + t1443)*clda)*sx
5154  t1447 = t281**2
5155  t1448 = t1447*t115
5156  t1452 = d2exeindrhondrho(q, dqndrho, d2qndrhondrho)
5157  t1481 = 2._dp*t728*t103 + 4._dp*t249*t473 + t11*t15*(2._dp*g2*t3 &
5158  *t19 + 12._dp*g3*t1*t24*t32)
5159  t1483 = t1481*e*t108
5160  t1500 = 2._dp*t728*t88 + 4._dp*t249*t454 + t11*t15*(f2*t744* &
5161  t68 - 2._dp*t450*t278 + 2._dp*t85*t752 - t85*t769)
5162  t1529 = t789*t1447
5163  t1533 = t127*t1447
5164  t1537 = t115*t772
5165  t1552 = t1447*t114
5166  t1562 = t113*t1447
5167  t1566 = t114*t772
5168  t1570 = -t136*t1481*t93*t118 + (4._dp*t1382*t510) + (5._dp &
5169  *t1382*t513) - (6._dp*t388*t961*t1447) - (10._dp*t388 &
5170  *t420*t1448) + (2._dp*t388*t389*t772) - 0.75e2_dp/0.4e1_dp* &
5171  (t388)*(t972)*(t1529) + (10._dp*t388*t393*t1533) &
5172  + 0.5e1_dp/0.2e1_dp*(t388)*(t393)*(t1537) - t140 &
5173  *t1500*t93*t129 + (4._dp*t1413*t519) + (3._dp*t1413 &
5174  *t522) - (6._dp*t400*t990*t1447) - (6._dp*t400*t108*t372 &
5175  *t1552) + (2._dp*t400*t401*t772) - 0.27e2_dp/0.4e1_dp*(t400) &
5176  *(t1001)*(t1448) + (3._dp*t400*t405*t1562) &
5177  + 0.3e1_dp/0.2e1_dp*(t400)*(t405)*(t1566)
5178  t1576 = -15._dp*t1065*t422*t1448 + t158*(t1452 + (t772*t161 - &
5179  2._dp*t1447*t434 + 2._dp*t1040*t1447 - t435*t772)*t438*t160 &
5180  - t539*t1048*t1336 + t540*t281) + t1483 - t81*t93*t772 &
5181  + f12*t1500*t94 + 2._dp*t81*t108*t1447 - 6._dp*t476*t478 - 3._dp &
5182  *t106*t333*t772 - 4._dp*t457*t459 + t1570*t145*t151 + 10._dp &
5183  *t421*t422*t1533
5184  t1618 = -(2._dp*t81*t799*t1447) - (t81*t93*t359*t1447) &
5185  + (t81*t355*t772) - 0.3e1_dp/0.4e1_dp*(t81)*(t812) &
5186  *(t1447) + (t81*t360*t772)/0.2e1_dp - t125*t1500 &
5187  *t83*t129 + (2._dp*t1224*t498) + (3._dp*t1224*t501) - &
5188  (2._dp*t367*t401*t1447) + (t367*t368*t772) - (3._dp &
5189  *t367*t405*t1552)
5190  t1652 = (3._dp*t367*t373*t1562) + 0.3e1_dp/0.2e1_dp*(t367) &
5191  *(t373)*(t1566) - 0.27e2_dp/0.4e1_dp*(t367)*(t879) &
5192  *(t1448) - t110*t1481*t83*t118 + (2._dp*t1205*t484) &
5193  + (5._dp*t1205*t487) - (2._dp*t340*t389*t1447) + (t340 &
5194  *t341*t772) - (5._dp*t340*t393*t1448) + (10._dp* &
5195  t340*t346*t1533) + 0.5e1_dp/0.2e1_dp*(t340)*(t346)* &
5196  (t1537) - 0.75e2_dp/0.4e1_dp*(t340)*(t793)*(t1529)
5197  t1672 = 0.5e1_dp/0.2e1_dp*t421*t422*t1537 - 0.75e2_dp/0.4e1_dp*t1082 &
5198  *t422*t1529 + (6._dp*t91*t1111*t1447) - (2._dp*t91* &
5199  t305*t772) + (t1618 + t1652)*omega*t134 + (12._dp*t106*t782 &
5200  *t1447) - t1483*t156 + (6._dp*t1174*t530) + (5._dp*t1351 &
5201  *t533) - (12._dp*t783*t155*t44*t1447) + (3._dp*t415 &
5202  *t155*t44*t772)
5203  e_ndrho_ndrho = e_ndrho_ndrho + (-t80*(t1576 + t1672)*clda)*sx
5204  END IF
5205 
5206  END SUBROUTINE xwpbe_lda_calc_4
5207 
5208 ! **************************************************************************************************
5209 !> \brief return various information on the functional
5210 !> \param reference string with the reference of the actual functional
5211 !> \param shortform string with the shortform of the functional name
5212 !> \param needs the components needed by this functional are set to
5213 !> true (does not set the unneeded components to false)
5214 !> \param max_deriv ...
5215 !> \par History
5216 !> 05.2007 created [Manuel Guidon]
5217 !> \author Manuel Guidon
5218 ! **************************************************************************************************
5219  SUBROUTINE xwpbe_lsd_info(reference, shortform, needs, max_deriv)
5220  CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: reference, shortform
5221  TYPE(xc_rho_cflags_type), INTENT(inout), OPTIONAL :: needs
5222  INTEGER, INTENT(out), OPTIONAL :: max_deriv
5223 
5224  IF (PRESENT(reference)) THEN
5225  reference = "Jochen Heyd and Gustavo E. Scuseria, J. Chem. Phys., 120, 7274 {LSD version}"
5226  END IF
5227  IF (PRESENT(shortform)) THEN
5228  shortform = "shortrange part of PBE exchange {LSD}"
5229  END IF
5230  IF (PRESENT(needs)) THEN
5231  needs%rho_spin = .true.
5232  needs%norm_drho_spin = .true.
5233  END IF
5234  IF (PRESENT(max_deriv)) max_deriv = 2
5235  END SUBROUTINE xwpbe_lsd_info
5236 
5237 ! **************************************************************************************************
5238 !> \brief evaluates the screened hole averaged PBE exchange functional for lsd
5239 !> \param rho_set the density where you want to evaluate the functional
5240 !> \param deriv_set place where to store the functional derivatives (they are
5241 !> added to the derivatives)
5242 !> \param order degree of the derivative that should be evaluated,
5243 !> if positive all the derivatives up to the given degree are evaluated,
5244 !> if negative only the given degree is calculated
5245 !> \param xwpbe_params input parameters (scaling,omega)
5246 !> \par History
5247 !> 05.2007 created [Manuel Guidon]
5248 !> \author Manuel Guidon
5249 !> \note
5250 !> The current version provides code for derivatives up to second order.
5251 !> Using the maple sheet in cp2k/doc it is straightforward to produce routines
5252 !> for higher derivatives.
5253 ! **************************************************************************************************
5254  SUBROUTINE xwpbe_lsd_eval(rho_set, deriv_set, order, xwpbe_params)
5255 
5256  TYPE(xc_rho_set_type), INTENT(IN) :: rho_set
5257  TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
5258  INTEGER, INTENT(IN) :: order
5259  TYPE(section_vals_type), POINTER :: xwpbe_params
5260 
5261  CHARACTER(len=*), PARAMETER :: routinen = 'xwpbe_lsd_eval'
5262 
5263  INTEGER :: handle, npoints
5264  INTEGER, DIMENSION(2, 3) :: bo
5265  REAL(kind=dp) :: epsilon_norm_drho, epsilon_rho, omega, &
5266  sx, sx0
5267  REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :, :), POINTER :: dummy, e_0, e_ndrhoa, &
5268  e_ndrhoa_ndrhoa, e_ndrhoa_rhoa, e_ndrhob, e_ndrhob_ndrhob, e_ndrhob_rhob, e_rhoa, &
5269  e_rhoa_rhoa, e_rhob, e_rhob_rhob, norm_drhoa, norm_drhob, rhoa, rhob
5270  TYPE(xc_derivative_type), POINTER :: deriv
5271 
5272  CALL timeset(routinen, handle)
5273 
5274  CALL cite_reference(heyd2004)
5275 
5276  CALL section_vals_val_get(xwpbe_params, "SCALE_X", r_val=sx)
5277  CALL section_vals_val_get(xwpbe_params, "SCALE_X0", r_val=sx0)
5278  CALL section_vals_val_get(xwpbe_params, "OMEGA", r_val=omega)
5279 
5280  CALL xc_rho_set_get(rho_set, rhoa=rhoa, rhob=rhob, norm_drhoa=norm_drhoa, &
5281  norm_drhob=norm_drhob, local_bounds=bo, rho_cutoff=epsilon_rho, &
5282  drho_cutoff=epsilon_norm_drho)
5283  npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1)
5284 
5285  dummy => rhoa
5286 
5287  e_0 => dummy
5288  e_rhoa => dummy
5289  e_rhob => dummy
5290  e_ndrhoa => dummy
5291  e_ndrhob => dummy
5292  e_rhoa_rhoa => dummy
5293  e_rhob_rhob => dummy
5294  e_ndrhoa_rhoa => dummy
5295  e_ndrhob_rhob => dummy
5296  e_ndrhoa_ndrhoa => dummy
5297  e_ndrhob_ndrhob => dummy
5298 
5299  IF (order >= 0) THEN
5300  deriv => xc_dset_get_derivative(deriv_set, [INTEGER::], &
5301  allocate_deriv=.true.)
5302  CALL xc_derivative_get(deriv, deriv_data=e_0)
5303  END IF
5304  IF (order >= 1 .OR. order == -1) THEN
5305  deriv => xc_dset_get_derivative(deriv_set, [deriv_rhoa], &
5306  allocate_deriv=.true.)
5307  CALL xc_derivative_get(deriv, deriv_data=e_rhoa)
5308  deriv => xc_dset_get_derivative(deriv_set, [deriv_rhob], &
5309  allocate_deriv=.true.)
5310  CALL xc_derivative_get(deriv, deriv_data=e_rhob)
5311  deriv => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa], &
5312  allocate_deriv=.true.)
5313  CALL xc_derivative_get(deriv, deriv_data=e_ndrhoa)
5314  deriv => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob], &
5315  allocate_deriv=.true.)
5316  CALL xc_derivative_get(deriv, deriv_data=e_ndrhob)
5317  END IF
5318  IF (order >= 2 .OR. order == -2) THEN
5319  deriv => xc_dset_get_derivative(deriv_set, [deriv_rhoa, deriv_rhoa], &
5320  allocate_deriv=.true.)
5321  CALL xc_derivative_get(deriv, deriv_data=e_rhoa_rhoa)
5322  deriv => xc_dset_get_derivative(deriv_set, [deriv_rhob, deriv_rhob], &
5323  allocate_deriv=.true.)
5324  CALL xc_derivative_get(deriv, deriv_data=e_rhob_rhob)
5325  deriv => xc_dset_get_derivative(deriv_set, [deriv_norm_drhoa, deriv_rhoa], &
5326  allocate_deriv=.true.)
5327  CALL xc_derivative_get(deriv, deriv_data=e_ndrhoa_rhoa)
5328  deriv => xc_dset_get_derivative(deriv_set, [deriv_norm_drhob, deriv_rhob], &
5329  allocate_deriv=.true.)
5330  CALL xc_derivative_get(deriv, deriv_data=e_ndrhob_rhob)
5331  deriv => xc_dset_get_derivative(deriv_set, &
5332  [deriv_norm_drhoa, deriv_norm_drhoa], allocate_deriv=.true.)
5333  CALL xc_derivative_get(deriv, deriv_data=e_ndrhoa_ndrhoa)
5334  deriv => xc_dset_get_derivative(deriv_set, &
5335  [deriv_norm_drhob, deriv_norm_drhob], allocate_deriv=.true.)
5336  CALL xc_derivative_get(deriv, deriv_data=e_ndrhob_ndrhob)
5337  END IF
5338  IF (order > 2 .OR. order < -2) THEN
5339  cpabort("derivatives bigger than 2 not implemented")
5340  END IF
5341 
5342 !$OMP PARALLEL DEFAULT(NONE) &
5343 !$OMP SHARED(npoints, order, rhoa, norm_drhoa, e_0, e_rhoa, e_ndrhoa) &
5344 !$OMP SHARED(e_rhoa_rhoa, e_ndrhoa_rhoa, e_ndrhoa_ndrhoa, epsilon_rho) &
5345 !$OMP SHARED(sx, sx0, omega) &
5346 !$OMP SHARED(rhob, norm_drhob, e_rhob, e_ndrhob, e_rhob_rhob) &
5347 !$OMP SHARED(e_ndrhob_rhob, e_ndrhob_ndrhob)
5348 
5349  !Call lsd_calc for alpha - and beta - spins
5350 
5351  CALL xwpbe_lsd_calc(npoints, order, rho=rhoa, norm_drho=norm_drhoa, &
5352  e_0=e_0, e_rho=e_rhoa, e_ndrho=e_ndrhoa, e_rho_rho=e_rhoa_rhoa, &
5353  e_ndrho_rho=e_ndrhoa_rhoa, e_ndrho_ndrho=e_ndrhoa_ndrhoa, &
5354  epsilon_rho=epsilon_rho, &
5355  sx=sx, sx0=sx0, omega=omega)
5356  CALL xwpbe_lsd_calc(npoints, order, rho=rhob, norm_drho=norm_drhob, &
5357  e_0=e_0, e_rho=e_rhob, e_ndrho=e_ndrhob, e_rho_rho=e_rhob_rhob, &
5358  e_ndrho_rho=e_ndrhob_rhob, e_ndrho_ndrho=e_ndrhob_ndrhob, &
5359  epsilon_rho=epsilon_rho, &
5360  sx=sx, sx0=sx0, omega=omega)
5361 
5362 !$OMP END PARALLEL
5363 
5364  CALL timestop(handle)
5365 
5366  END SUBROUTINE xwpbe_lsd_eval
5367 
5368 ! **************************************************************************************************
5369 !> \brief evaluates the screened hole averaged PBE exchange functional for lsd.
5370 !> \param npoints ...
5371 !> \param order degree of the derivative that should be evaluated,
5372 !> if positive all the derivatives up to the given degree are evaluated,
5373 !> if negative only the given degree is calculated
5374 !> \param rho , ndrho: density and norm of the density gradient
5375 !> \param norm_drho ...
5376 !> \param e_0 ...
5377 !> \param e_rho ...
5378 !> \param e_ndrho ...
5379 !> \param e_rho_rho ...
5380 !> \param e_ndrho_rho ...
5381 !> \param e_ndrho_ndrho ...
5382 !> \param epsilon_rho ...
5383 !> \param sx , sx0: scaling factor for omega!=0 and omega=0
5384 !> \param sx0 ...
5385 !> \param omega screening parameter
5386 !> \par History
5387 !> 05.2007 created [Manuel Guidon]
5388 !> \author Manuel Guidon
5389 !> \note
5390 !> - The lsd part is calculated using the spin-scaling relations for the
5391 !> exchange energy:
5392 !>
5393 !> Ex[na,nb] = 0.5 * Ex[2*na] + 0.5 * Ex[2*nb].
5394 !>
5395 !> - In order to avoid numerical instabilities, this routine calls different
5396 !> subroutines. There are 4 routines for the case omega!=0 and 2 routines
5397 !> for omega=0.
5398 ! **************************************************************************************************
5399  SUBROUTINE xwpbe_lsd_calc(npoints, order, rho, norm_drho, e_0, e_rho, e_ndrho, &
5400  e_rho_rho, e_ndrho_rho, e_ndrho_ndrho, &
5401  epsilon_rho, sx, sx0, omega)
5402 
5403  INTEGER, INTENT(in) :: npoints, order
5404  REAL(kind=dp), DIMENSION(1:npoints), INTENT(inout) :: rho, norm_drho, e_0, e_rho, e_ndrho, &
5405  e_rho_rho, e_ndrho_rho, e_ndrho_ndrho
5406  REAL(kind=dp), INTENT(in) :: epsilon_rho, sx, sx0, omega
5407 
5408  INTEGER :: ip
5409  REAL(dp) :: e_0_temp, my_ndrho, my_rho
5410  REAL(kind=dp) :: ss, ss2, sscale, t1, t2, t3, t4, t5, t6, &
5411  t7, t8, ww
5412 
5413 !$OMP DO
5414 
5415  DO ip = 1, npoints
5416  !According to spin-scaling relation, we need twice the density and its gradient
5417  my_rho = 2.0_dp*max(rho(ip), 0.0_dp)
5418  IF (my_rho > epsilon_rho) THEN
5419  my_ndrho = 2.0_dp*max(norm_drho(ip), 0.0_dp)
5420 
5421  !Do some precalculation in order to catch the correct branch afterwards
5422  sscale = 1.0_dp
5423  t1 = pi**2
5424  t2 = t1*my_rho
5425  t3 = t2**(0.1e1_dp/0.3e1_dp)
5426  t4 = 0.1e1_dp/t3
5427  t5 = omega*t4
5428  ww = 0.6933612743506347048433524e0_dp*t5
5429  t6 = my_ndrho*t4
5430  t7 = 0.1e1_dp/my_rho
5431  t8 = t7*sscale
5432  ss = 0.3466806371753173524216762e0_dp*t6*t8
5433  IF (ss > scutoff) THEN
5434  ss2 = ss*ss
5435  sscale = ((smax)*ss2 - (sconst))/(ss2*ss)
5436  END IF
5437  e_0_temp = 0.0_dp
5438  IF (sx0 /= 0.0_dp) THEN
5439  !original PBE hole
5440  IF (ss*sscale > gcutoff) THEN
5441  CALL xwpbe_lda_calc_0(e_0_temp, e_rho(ip), e_ndrho(ip), e_rho_rho(ip), &
5442  e_ndrho_rho(ip), e_ndrho_ndrho(ip), my_rho, &
5443  my_ndrho, sscale, sx0, order)
5444  ELSE
5445  CALL xwpbe_lda_calc_01(e_0_temp, e_rho(ip), e_ndrho(ip), e_rho_rho(ip), &
5446  e_ndrho_rho(ip), e_ndrho_ndrho(ip), my_rho, &
5447  my_ndrho, sscale, sx0, order)
5448  END IF
5449  !According to spin-scaling relation, we need only half of the energy
5450  e_0(ip) = e_0(ip) + 0.5_dp*e_0_temp
5451  END IF
5452  e_0_temp = 0.0_dp
5453  IF (sx /= 0.0_dp) THEN
5454  IF (ww < wcutoff .AND. ss*sscale > gcutoff) THEN
5455  CALL xwpbe_lda_calc_1(e_0_temp, e_rho(ip), e_ndrho(ip), e_rho_rho(ip), &
5456  e_ndrho_rho(ip), e_ndrho_ndrho(ip), my_rho, &
5457  my_ndrho, omega, sscale, sx, order)
5458  ELSE IF (ww < wcutoff .AND. ss*sscale <= gcutoff) THEN
5459  CALL xwpbe_lda_calc_2(e_0_temp, e_rho(ip), e_ndrho(ip), e_rho_rho(ip), &
5460  e_ndrho_rho(ip), e_ndrho_ndrho(ip), my_rho, &
5461  my_ndrho, omega, sscale, sx, order)
5462  ELSE IF (ww >= wcutoff .AND. ss*sscale > gcutoff) THEN
5463  CALL xwpbe_lda_calc_3(e_0_temp, e_rho(ip), e_ndrho(ip), e_rho_rho(ip), &
5464  e_ndrho_rho(ip), e_ndrho_ndrho(ip), my_rho, &
5465  my_ndrho, omega, sscale, sx, order)
5466  ELSE
5467  CALL xwpbe_lda_calc_4(e_0_temp, e_rho(ip), e_ndrho(ip), e_rho_rho(ip), &
5468  e_ndrho_rho(ip), e_ndrho_ndrho(ip), my_rho, &
5469  my_ndrho, omega, sscale, sx, order)
5470  END IF
5471  !According to spin-scaling relation, we need only half of the energy
5472  END IF
5473  e_0(ip) = e_0(ip) + 0.5_dp*e_0_temp
5474  END IF
5475  END DO
5476 
5477 !$OMP END DO
5478 
5479  END SUBROUTINE xwpbe_lsd_calc
5480 
5481 ! **************************************************************************************************
5482 !> \brief These functions evaluate products exp(x)*Ei(x) and pi*exp(x)*erfc(sqrt(x)),
5483 !> as well as their derivatives with respect to various combinations of
5484 !> rho and norm_drho.
5485 !> \param Q , dQrho, dQndrho, d2Qrhondrho :
5486 !> Argument Q and derivatives with respect to various combinations of
5487 !> rho and norm_drho
5488 !> \return ...
5489 !> \par History
5490 !> 05.2007 created [Manuel Guidon]
5491 !> \author Manuel Guidon
5492 !> \note
5493 !> - In order to avoid numerical instabilities, these routines use Taylor-
5494 !> expansions for the above core-products for large arguments.
5495 !> - When adapting this module for higher order derivatives, appropriate
5496 !> functions have to be provided!
5497 ! **************************************************************************************************
5498  FUNCTION exei(Q)
5499  REAL(dp), INTENT(IN) :: q
5500  REAL(dp) :: exei
5501 
5502  exei = 0.0_dp
5503  IF (q < expcutoff) THEN
5504  !Use exact product
5505  exei = exp(q)*expint(1, q)
5506  ELSE
5507  !Use approximation
5508  exei = (1._dp/q)*(q*q + exei1*q + exei2)/(q*q + exei3*q + exei4)
5509  END IF
5510  END FUNCTION exei
5511 
5512 ! **************************************************************************************************
5513 !> \brief ...
5514 !> \param Q ...
5515 !> \return ...
5516 ! **************************************************************************************************
5517  FUNCTION exer(Q)
5518  REAL(dp), INTENT(IN) :: q
5519  REAL(dp) :: exer
5520 
5521  REAL(dp) :: q3, q5
5522 
5523  exer = 0.0_dp
5524  IF (q < expcutoff) THEN
5525  !Use exact expression
5526  exer = pi*exp(q)*erfc(sqrt(q))
5527  ELSE
5528  !Use approximation
5529  q3 = q*q*q
5530  q5 = q3*q*q
5531  exer = pi*(1.0_dp/sqrt(q*pi) - 1.0_dp/(2.0_dp*sqrt(pi*q3)) + 3.0_dp/(4.0_dp*(sqrt(pi*q5))))
5532  END IF
5533  END FUNCTION exer
5534 
5535 ! **************************************************************************************************
5536 !> \brief ...
5537 !> \param Q ...
5538 !> \param dQrho ...
5539 !> \return ...
5540 ! **************************************************************************************************
5541  FUNCTION dexeirho(Q, dQrho)
5542  REAL(dp), INTENT(IN) :: q, dqrho
5543  REAL(dp) :: dexeirho
5544 
5545  dexeirho = dqrho*(exei(q) - 1.0_dp/q)
5546  END FUNCTION dexeirho
5547 
5548 ! **************************************************************************************************
5549 !> \brief ...
5550 !> \param Q ...
5551 !> \param dQndrho ...
5552 !> \return ...
5553 ! **************************************************************************************************
5554  FUNCTION dexeindrho(Q, dQndrho)
5555  REAL(dp), INTENT(IN) :: q, dqndrho
5556  REAL(dp) :: dexeindrho
5557 
5558  dexeindrho = dqndrho*(exei(q) - 1.0_dp/q)
5559  END FUNCTION dexeindrho
5560 
5561 ! **************************************************************************************************
5562 !> \brief ...
5563 !> \param Q ...
5564 !> \param dQrho ...
5565 !> \return ...
5566 ! **************************************************************************************************
5567  FUNCTION dexerrho(Q, dQrho)
5568  REAL(dp), INTENT(IN) :: q, dqrho
5569  REAL(dp) :: dexerrho
5570 
5571  dexerrho = dqrho*exer(q) - dqrho*rootpi/sqrt(q)
5572  END FUNCTION dexerrho
5573 
5574 ! **************************************************************************************************
5575 !> \brief ...
5576 !> \param Q ...
5577 !> \param dQndrho ...
5578 !> \return ...
5579 ! **************************************************************************************************
5580  FUNCTION dexerndrho(Q, dQndrho)
5581  REAL(dp), INTENT(IN) :: q, dqndrho
5582  REAL(dp) :: dexerndrho
5583 
5584  dexerndrho = dqndrho*exer(q) - dqndrho*rootpi/sqrt(q)
5585  END FUNCTION dexerndrho
5586 
5587 ! **************************************************************************************************
5588 !> \brief ...
5589 !> \param Q ...
5590 !> \param dQrho ...
5591 !> \param d2Qrhorho ...
5592 !> \return ...
5593 ! **************************************************************************************************
5594  FUNCTION d2exeirhorho(Q, dQrho, d2Qrhorho)
5595  REAL(dp), INTENT(IN) :: q, dqrho, d2qrhorho
5596  REAL(dp) :: d2exeirhorho
5597 
5598  d2exeirhorho = exei(q)*(d2qrhorho + dqrho*dqrho) + &
5599  1.0_dp/(q*q)*(-q*dqrho*dqrho - q*d2qrhorho + dqrho*dqrho)
5600  END FUNCTION d2exeirhorho
5601 
5602 ! **************************************************************************************************
5603 !> \brief ...
5604 !> \param Q ...
5605 !> \param dQrho ...
5606 !> \param d2Qrhorho ...
5607 !> \return ...
5608 ! **************************************************************************************************
5609  FUNCTION d2exerrhorho(Q, dQrho, d2Qrhorho)
5610  REAL(dp), INTENT(IN) :: q, dqrho, d2qrhorho
5611  REAL(dp) :: d2exerrhorho
5612 
5613  REAL(dp) :: pi12, q12
5614 
5615  q12 = sqrt(q)
5616  pi12 = rootpi
5617 
5618  d2exerrhorho = exer(q)*(d2qrhorho + dqrho*dqrho) - dqrho*dqrho/(pi12*q12) + &
5619  0.5_dp*dqrho*dqrho/(pi12*q*q12) - d2qrhorho/(pi12*q12)
5620  END FUNCTION d2exerrhorho
5621 
5622 ! **************************************************************************************************
5623 !> \brief ...
5624 !> \param Q ...
5625 !> \param dQrho ...
5626 !> \param dQndrho ...
5627 !> \param d2Qrhondrho ...
5628 !> \return ...
5629 ! **************************************************************************************************
5630  FUNCTION d2exeirhondrho(Q, dQrho, dQndrho, d2Qrhondrho)
5631  REAL(dp), INTENT(IN) :: q, dqrho, dqndrho, d2qrhondrho
5632  REAL(dp) :: d2exeirhondrho
5633 
5634  d2exeirhondrho = exei(q)*(d2qrhondrho + dqrho*dqndrho) - &
5635  1.0_dp/q*(dqrho*dqndrho + d2qrhondrho) + 1.0_dp/(q*q)*dqrho*dqndrho
5636  END FUNCTION d2exeirhondrho
5637 
5638 ! **************************************************************************************************
5639 !> \brief ...
5640 !> \param Q ...
5641 !> \param dQrho ...
5642 !> \param dQndrho ...
5643 !> \param d2Qrhondrho ...
5644 !> \return ...
5645 ! **************************************************************************************************
5646  FUNCTION d2exerrhondrho(Q, dQrho, dQndrho, d2Qrhondrho)
5647  REAL(dp), INTENT(IN) :: q, dqrho, dqndrho, d2qrhondrho
5648  REAL(dp) :: d2exerrhondrho
5649 
5650  REAL(dp) :: pi12, q12
5651 
5652  q12 = sqrt(q)
5653  pi12 = rootpi
5654 
5655  d2exerrhondrho = exer(q)*(d2qrhondrho + dqrho*dqndrho) - 1.0_dp/(pi12*q12)*dqrho*dqndrho &
5656  + 0.5_dp/(pi12*q12*q)*dqrho*dqndrho - 1.0_dp/(pi12*q12)*d2qrhondrho
5657  END FUNCTION d2exerrhondrho
5658 
5659 ! **************************************************************************************************
5660 !> \brief ...
5661 !> \param Q ...
5662 !> \param dQndrho ...
5663 !> \param d2Qndrhondrho ...
5664 !> \return ...
5665 ! **************************************************************************************************
5666  FUNCTION d2exeindrhondrho(Q, dQndrho, d2Qndrhondrho)
5667  REAL(dp), INTENT(IN) :: q, dqndrho, d2qndrhondrho
5668  REAL(dp) :: d2exeindrhondrho
5669 
5670  d2exeindrhondrho = exei(q)*(d2qndrhondrho + dqndrho*dqndrho) + &
5671  1.0_dp/(q*q)*(-q*dqndrho*dqndrho - q*d2qndrhondrho + dqndrho*dqndrho)
5672  END FUNCTION d2exeindrhondrho
5673 
5674 ! **************************************************************************************************
5675 !> \brief ...
5676 !> \param Q ...
5677 !> \param dQndrho ...
5678 !> \param d2Qndrhondrho ...
5679 !> \return ...
5680 ! **************************************************************************************************
5681  FUNCTION d2exerndrhondrho(Q, dQndrho, d2Qndrhondrho)
5682  REAL(dp), INTENT(IN) :: q, dqndrho, d2qndrhondrho
5683  REAL(dp) :: d2exerndrhondrho
5684 
5685  REAL(dp) :: pi12, q12
5686 
5687  q12 = sqrt(q)
5688  pi12 = rootpi
5689 
5690  d2exerndrhondrho = exer(q)*(d2qndrhondrho + dqndrho*dqndrho) - dqndrho*dqndrho/(pi12*q12) &
5691  + 0.5_dp*dqndrho*dqndrho/(pi12*q*q12) - d2qndrhondrho/(pi12*q12)
5692  END FUNCTION d2exerndrhondrho
5693 
5694 END MODULE xc_xwpbe
5695 
bibliography
collects all references to literature in CP2K as new algorithms / method are included from literature...
Definition: bibliography.F:28
bibliography::heyd2004
integer, save, public heyd2004
Definition: bibliography.F:43
input_section_types
objects that represent the structure of input sections and the data contained in an input section
Definition: input_section_types.F:15
input_section_types::section_vals_val_get
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
Definition: input_section_types.F:1040
kinds
Defines the basic variable types.
Definition: kinds.F:23
kinds::dp
integer, parameter, public dp
Definition: kinds.F:34
mathconstants
Definition of mathematical constants and functions.
Definition: mathconstants.F:16
mathconstants::pi
real(kind=dp), parameter, public pi
Definition: mathconstants.F:110
mathconstants::rootpi
real(kind=dp), parameter, public rootpi
Definition: mathconstants.F:114
mathlib
Collection of simple mathematical functions and subroutines.
Definition: mathlib.F:15
mathlib::expint
elemental impure real(dp) function, public expint(n, x)
computes the exponential integral En(x) = Int(exp(-x*t)/t^n,t=1..infinity) x>0, n=0,...
Definition: mathlib.F:1404
xc_derivative_desc
Module with functions to handle derivative descriptors. derivative description are strings have the f...
Definition: xc_derivative_desc.F:26
xc_derivative_desc::deriv_norm_drho
integer, parameter, public deriv_norm_drho
Definition: xc_derivative_desc.F:35
xc_derivative_desc::deriv_norm_drhoa
integer, parameter, public deriv_norm_drhoa
Definition: xc_derivative_desc.F:35
xc_derivative_desc::deriv_rhob
integer, parameter, public deriv_rhob
Definition: xc_derivative_desc.F:35
xc_derivative_desc::deriv_rhoa
integer, parameter, public deriv_rhoa
Definition: xc_derivative_desc.F:35
xc_derivative_desc::deriv_rho
integer, parameter, public deriv_rho
Definition: xc_derivative_desc.F:35
xc_derivative_desc::deriv_norm_drhob
integer, parameter, public deriv_norm_drhob
Definition: xc_derivative_desc.F:35
xc_derivative_set_types
represent a group ofunctional derivatives
Definition: xc_derivative_set_types.F:14
xc_derivative_set_types::xc_dset_get_derivative
type(xc_derivative_type) function, pointer, public xc_dset_get_derivative(derivative_set, description, allocate_deriv)
returns the requested xc_derivative
Definition: xc_derivative_set_types.F:66
xc_derivative_types
Provides types for the management of the xc-functionals and their derivatives.
Definition: xc_derivative_types.F:12
xc_derivative_types::xc_derivative_get
subroutine, public xc_derivative_get(deriv, split_desc, order, deriv_data, accept_null_data)
returns various information on the given derivative
Definition: xc_derivative_types.F:103
xc_rho_cflags_types
contains the structure
Definition: xc_rho_cflags_types.F:14
xc_rho_set_types
contains the structure
Definition: xc_rho_set_types.F:14
xc_rho_set_types::xc_rho_set_get
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
Definition: xc_rho_set_types.F:281
xc_xwpbe
Calculates short range exchange part for wPBE functional and averaged PBE exchange-hole functional (o...
Definition: xc_xwpbe.F:15
xc_xwpbe::xwpbe_lda_eval
subroutine, public xwpbe_lda_eval(rho_set, deriv_set, order, xwpbe_params)
evaluates the screened hole averaged PBE exchange functional for lda
Definition: xc_xwpbe.F:150
xc_xwpbe::xwpbe_lsd_eval
subroutine, public xwpbe_lsd_eval(rho_set, deriv_set, order, xwpbe_params)
evaluates the screened hole averaged PBE exchange functional for lsd
Definition: xc_xwpbe.F:5255
xc_xwpbe::xwpbe_lda_info
subroutine, public xwpbe_lda_info(reference, shortform, needs, max_deriv)
return various information on the functional
Definition: xc_xwpbe.F:113
xc_xwpbe::xwpbe_lsd_info
subroutine, public xwpbe_lsd_info(reference, shortform, needs, max_deriv)
return various information on the functional
Definition: xc_xwpbe.F:5220