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