1 /*
2 This file is part of MADNESS.
3
4 Copyright (C) 2007,2010 Oak Ridge National Laboratory
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19
20 For more information please contact:
21
22 Robert J. Harrison
23 Oak Ridge National Laboratory
24 One Bethel Valley Road
25 P.O. Box 2008, MS-6367
26
27 email: harrisonrj@ornl.gov
28 tel: 865-241-3937
29 fax: 865-572-0680
30 */
31
32 /*
33 * lda.h
34 *
35 * Created on: Nov 10, 2008
36 * Author: wsttiger
37 */
38
39 #ifndef LDA_H_
40 #define LDA_H_
41
42 //#define WORLD_INSTANTIATE_STATIC_TEMPLATES
43 #include <madness/mra/mra.h>
44 #include <madness/world/MADworld.h>
45 #include <math.h>
46 #include <madness/madness_config.h>
47
48 typedef double doublereal;
49 typedef MADNESS_FORINT integer;
50 typedef int logical;
51
52 #define max(a,b) ((a)>=(b)?(a):(b))
53
54 /* static double pow_dd(doublereal* a, doublereal* b) { */
55 /* return pow(*a,*b); */
56 /* } */
57
58 using namespace madness;
59
60 /* lda.f -- translated by f2c (version 20050501).
61 You must link the resulting object file with libf2c:
62 on Microsoft Windows system, link with libf2c.lib;
63 on Linux or Unix systems, link with .../path/to/libf2c.a -lm
64 or, if you install libf2c.a in a standard place, with -lf2c -lm
65 -- in that order, at the end of the command line, as in
66 cc *.o -lf2c -lm
67 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
68
69 http://www.netlib.org/f2c/libf2c.zip
70 */
71
72
73 /* Table of constant values */
74
75 #include <cmath>
76
pow(const double * a,const double * b)77 static inline double pow(const double* a, const double* b) {
78 return pow(*a, *b);
79 }
80
81 static double c_b2 = .333333333333333333333333333333333;
82 static double c_b7 = .333333333333333333333333333333;
83 static double c_b8 = .5;
84 static double c_b14 = 1.333333333333333333333333333333;
85
86
x_rks_s__(const double * r__,double * f,double * dfdra)87 inline /* Subroutine */ int x_rks_s__(const double *r__, double *f, double *
88 dfdra)
89 {
90
91 /* Local variables */
92 double ra13;
93
94
95 /* This subroutine evaluates the spin polarised exchange functional */
96 /* in the Local Density Approximation [1], and the corresponding */
97 /* potential. Often this functional is referred to as the Dirac */
98 /* functional [2] or Slater functional. */
99
100 /* [1] F. Bloch, Zeitschrift fuer Physik, Vol. 57 (1929) 545. */
101
102 /* [2] P.A.M. Dirac, Proceedings of the Cambridge Philosophical */
103 /* Society, Vol. 26 (1930) 376. */
104
105 /* Parameters: */
106
107 /* r the total electron density */
108 /* f On return the functional value */
109 /* dfdra On return the derivative of f with respect to alpha electron */
110 /* density */
111
112
113 /* Ax = -3/4*(6/pi)**(1/3) */
114 /* Bx = -(6/pi)**(1/3) */
115 /* C = (1/2)**(1/3) */
116
117
118
119
120 ra13 = pow(r__, &c_b2) * .793700525984099737375852819636154;
121 *f = *r__ * -.930525736349100025002010218071667 * ra13;
122 *dfdra = ra13 * -1.24070098179880003333601362409556;
123
124 return 0;
125 } /* x_rks_s__ */
126
127 /* ----------------------------------------------------------------------- */
x_uks_s__(double * ra,double * rb,double * f,double * dfdra,double * dfdrb)128 inline /* Subroutine */ int x_uks_s__(double *ra, double *rb, double *f,
129 double *dfdra, double *dfdrb)
130 {
131 /* Local variables */
132 double ra13, rb13;
133
134
135 /* This subroutine evaluates the spin polarised exchange functional */
136 /* in the Local Density Approximation [1], and the corresponding */
137 /* potential. Often this functional is referred to as the Dirac */
138 /* functional [2] or Slater functional. */
139
140 /* [1] F. Bloch, Zeitschrift fuer Physik, Vol. 57 (1929) 545. */
141
142 /* [2] P.A.M. Dirac, Proceedings of the Cambridge Philosophical */
143 /* Society, Vol. 26 (1930) 376. */
144
145 /* Parameters: */
146
147 /* ra the alpha electron density */
148 /* rb the beta electron density */
149 /* f On return the functional value */
150 /* dfdra On return the derivative of f with respect to ra */
151 /* dfdrb On return the derivative of f with respect to rb */
152
153
154 /* Ax = -3/4*(6/pi)**(1/3) */
155 /* Bx = -(6/pi)**(1/3) */
156
157
158
159
160 ra13 = pow(ra, &c_b2);
161 rb13 = pow(rb, &c_b2);
162 *f = (*ra * ra13 + *rb * rb13) * -.930525736349100025002010218071667;
163 *dfdra = ra13 * -1.24070098179880003333601362409556;
164 *dfdrb = rb13 * -1.24070098179880003333601362409556;
165
166 return 0;
167 } /* x_uks_s__ */
168
c_rks_vwn5__(const double * r__,double * f,double * dfdra)169 inline /* Subroutine */ int c_rks_vwn5__(const double *r__, double *f, double *
170 dfdra)
171 {
172 /* Local variables */
173 double a2, b2, c2, d2, i1, i2, i3, p1, p2, p3, p4, t4, t5, t6,
174 t7, iv, alpha_rho13__, iv2, pp1, pp2, inv, srho, srho13;
175
176
177 /* This subroutine evaluates the Vosko, Wilk and Nusair correlation */
178 /* functional number 5 [1] for the closed shell case, with the */
179 /* parametrisation as given in table 5. */
180
181 /* The original code was obtained from Dr. Phillip Young, */
182 /* with corrections from Dr. Paul Sherwood. */
183
184 /* [1] S.H. Vosko, L. Wilk, and M. Nusair */
185 /* "Accurate spin-dependent electron liquid correlation energies */
186 /* for local spin density calculations: a critical analysis", */
187 /* Can.J.Phys, Vol. 58 (1980) 1200-1211. */
188
189 /* Parameters: */
190
191 /* r the total electron density */
192 /* f On return the functional value */
193 /* dfdra On return the derivative of f with respect to the alpha */
194 /* electron density */
195
196
197
198
199 /* VWN interpolation parameters */
200
201 /* paramagnetic */
202 a2 = .0621814;
203 b2 = 3.72744;
204 c2 = 12.9352;
205 d2 = -.10498;
206
207 /* t4 = (1/(4/3)*pi)**(1/3) */
208 t4 = .620350490899399531;
209
210 /* t5 = 0.5/(2**(1/3)-1) */
211 t5 = 1.92366105093153617;
212
213 /* t6 = 2/(3*(2**(1/3)-1)) */
214 t6 = 2.56488140124204822;
215
216 /* t7 = 2.25*(2**(1/3)-1) */
217 t7 = .584822362263464735;
218
219 /* Paramagnetic interpolation constants */
220
221 p1 = 6.1519908197590798;
222 p2 = a2 * .5;
223 p3 = 9.6902277115443745e-4;
224 p4 = .038783294878113009;
225
226 /* closed shell case */
227 srho = *r__;
228 srho13 = pow(&srho, &c_b7);
229 alpha_rho13__ = pow(&c_b8, &c_b7) * srho;
230 iv2 = t4 / srho13;
231 iv = sqrt(iv2);
232
233 /* paramagnetic */
234 inv = 1. / (iv2 + b2 * iv + c2);
235 i1 = log(iv2 * inv);
236 i2 = log((iv - d2) * (iv - d2) * inv);
237 /* corrected b1->b2 ps Apr98 */
238 i3 = atan(p1 / (iv * 2. + b2));
239 pp1 = p2 * i1 + p3 * i2 + p4 * i3;
240 pp2 = a2 * (1. / iv - iv * inv * (b2 / (iv - d2) + 1.));
241
242 *f = pp1 * srho;
243 *dfdra = pp1 - iv * .166666666666666666666666666666 * pp2;
244
245 return 0;
246 } /* c_rks_vwn5__ */
247
248 /* ----------------------------------------------------------------------- */
c_uks_vwn5__(double * ra,double * rb,double * f,double * dfdra,double * dfdrb)249 inline /* Subroutine */ int c_uks_vwn5__(double *ra, double *rb, double *
250 f, double *dfdra, double *dfdrb)
251 {
252 /* System generated locals */
253 double d__1, d__2;
254
255 /* Local variables */
256 double v, beta_rho13__, a1, b1, c1, d1, a2, b2, c2, d2, a3, b3,
257 c3, d3, f1, f2, f3, p1, p2, p3, s1, t1, t2, s2, t4, t5, t6, t7,
258 s3, s4, p4, f4, i1, i2, i3, iv, alpha_rho13__, ff1, ff2, iv2, pp1,
259 pp2, ss1, ss2, tau, inv, vwn1, vwn2, dtau, zeta, srho, zeta3,
260 zeta4, srho13, inter1, inter2;
261
262
263 /* This subroutine evaluates the Vosko, Wilk and Nusair correlation */
264 /* functional number 5 [1], with the parametrisation as given in */
265 /* table 5. */
266
267 /* The original code was obtained from Dr. Phillip Young, */
268 /* with corrections from Dr. Paul Sherwood. */
269
270 /* [1] S.H. Vosko, L. Wilk, and M. Nusair */
271 /* "Accurate spin-dependent electron liquid correlation energies */
272 /* for local spin density calculations: a critical analysis", */
273 /* Can.J.Phys, Vol. 58 (1980) 1200-1211. */
274
275 /* Parameters: */
276
277 /* ra the alpha-electron density */
278 /* rb the beta-electron density */
279 /* f On return the functional value */
280 /* dfdra On return the derivative of f with respect to ra */
281 /* dfdrb On return the derivative of f with respect to rb */
282
283
284
285 /* tn13 = 2**(1/3) */
286 /* tn43 = 2**(4/3) */
287
288 /* VWN interpolation parameters */
289
290 /* spin stiffness */
291 a1 = -.0337737278807791058;
292 b1 = 1.13107;
293 c1 = 13.0045;
294 d1 = -.0047584;
295 /* paramagnetic */
296 a2 = .0621814;
297 b2 = 3.72744;
298 c2 = 12.9352;
299 d2 = -.10498;
300 /* ferromagnetic */
301 /* try cadpac/nwchem value (.5*a2) */
302 a3 = .0310907;
303 b3 = 7.06042;
304 c3 = 18.0578;
305 d3 = -.325;
306
307 /* t4 = (1/(4/3)*pi)**(1/3) */
308 t4 = .620350490899399531;
309
310 /* t5 = 0.5/(2**(1/3)-1) */
311 t5 = 1.92366105093153617;
312
313 /* t6 = 2/(3*(2**(1/3)-1)) */
314 t6 = 2.56488140124204822;
315
316 /* t7 = 2.25*(2**(1/3)-1) */
317 t7 = .584822362263464735;
318
319 /* Spin stiffness interpolation constants */
320
321 s1 = 7.12310891781811772;
322 s2 = a1 * .5;
323 s3 = -6.9917323507644313e-6;
324 s4 = -.0053650918488835769;
325
326 /* Paramagnetic interpolation constants */
327
328 p1 = 6.1519908197590798;
329 p2 = a2 * .5;
330 p3 = 9.6902277115443745e-4;
331 p4 = .038783294878113009;
332
333 /* Ferromagnetic interpolation constants */
334
335 f1 = 4.73092690956011364;
336 f2 = a3 * .5;
337
338 /* F3 = -0.244185082989490298d-02 *0.5d0 */
339 /* F4 = -0.570212323620622186d-01 *0.5d0 */
340
341 /* try nwchem values */
342
343 f3 = .00224786709554261133;
344 f4 = .0524913931697809227;
345
346 /* Interpolation intervals */
347
348 inter1 = .99999999989999999;
349 inter2 = -.99999999989999999;
350
351 /* open shell case */
352 alpha_rho13__ = pow(ra, &c_b7);
353 beta_rho13__ = pow(rb, &c_b7);
354 srho = *ra + *rb;
355 srho13 = pow(&srho, &c_b7);
356 iv2 = t4 / srho13;
357 iv = sqrt(iv2);
358
359 /* spin-stiffness */
360 inv = 1. / (iv2 + b1 * iv + c1);
361 i1 = log(iv2 * inv);
362 i2 = log((iv - d1) * (iv - d1) * inv);
363 i3 = atan(s1 / (iv * 2. + b1));
364 ss1 = s2 * i1 + s3 * i2 + s4 * i3;
365 ss2 = a1 * (1. / iv - iv * inv * (b1 / (iv - d1) + 1.));
366
367 /* paramagnetic */
368 inv = 1. / (iv2 + b2 * iv + c2);
369 i1 = log(iv2 * inv);
370 i2 = log((iv - d2) * (iv - d2) * inv);
371 /* corrected b1->b2 ps Apr98 */
372 i3 = atan(p1 / (iv * 2. + b2));
373 pp1 = p2 * i1 + p3 * i2 + p4 * i3;
374 pp2 = a2 * (1. / iv - iv * inv * (b2 / (iv - d2) + 1.));
375
376 /* ferromagnetic */
377 inv = 1. / (iv2 + b3 * iv + c3);
378 i1 = log(iv2 * inv);
379 i2 = log((iv - d3) * (iv - d3) * inv);
380 i3 = atan(f1 / (iv * 2. + b3));
381 ff1 = f2 * i1 + f3 * i2 + f4 * i3;
382 ff2 = a3 * (1. / iv - iv * inv * (b3 / (iv - d3) + 1.));
383
384 /* polarisation function */
385
386 zeta = (*ra - *rb) / srho;
387 zeta3 = zeta * zeta * zeta;
388 zeta4 = zeta3 * zeta;
389 if (zeta > inter1) {
390 vwn1 = t5 * .51984209978974638;
391 vwn2 = t6 * 1.25992104989487316476721060727823;
392 } else if (zeta < inter2) {
393 vwn1 = t5 * .51984209978974638;
394 vwn2 = t6 * -1.25992104989487316476721060727823;
395 } else {
396 d__1 = zeta + 1.;
397 d__2 = 1. - zeta;
398 vwn1 = (pow(&d__1, &c_b14) + pow(&d__2, &c_b14) - 2.) * t5;
399 d__1 = zeta + 1.;
400 d__2 = 1. - zeta;
401 vwn2 = (pow(&d__1, &c_b7) - pow(&d__2, &c_b7)) * t6;
402 }
403 ss1 *= t7;
404 ss2 *= t7;
405 tau = ff1 - pp1 - ss1;
406 dtau = ff2 - pp2 - ss2;
407
408 v = pp1 + vwn1 * (ss1 + tau * zeta4);
409 *f = v * srho;
410
411 t1 = v - iv * .166666666666666666666666666667 * (pp2 + vwn1 * (ss2 + dtau
412 * zeta4));
413 t2 = vwn2 * (ss1 + tau * zeta4) + vwn1 * 4. * tau * zeta3;
414 *dfdra = t1 + t2 * (1. - zeta);
415 *dfdrb = t1 - t2 * (zeta + 1.);
416
417 return 0;
418 } /* c_uks_vwn5__ */
419
420 ////***************************************************************************
421 //int rks_x_lda__ (integer *ideriv, integer *npt, doublereal *rhoa1,
422 // doublereal *sigmaaa1, doublereal *zk, doublereal *vrhoa,
423 // doublereal *vsigmaaa, doublereal *v2rhoa2, doublereal *v2rhoasigmaaa,
424 // doublereal *v2sigmaaa2);
425 ////***************************************************************************
426 //
427 ////***************************************************************************
428 //int rks_c_vwn5__ (integer *ideriv, integer *npt, doublereal *rhoa1,
429 // doublereal *sigmaaa1, doublereal *zk, doublereal *vrhoa,
430 // doublereal *vsigmaaa, doublereal *v2rhoa2, doublereal *v2rhoasigmaaa,
431 // doublereal *v2sigmaaa2);
432 ////***************************************************************************
433
rks_c_vwn5__(integer * ideriv,integer * npt,doublereal * rhoa1,doublereal * sigmaaa1,doublereal * zk,doublereal * vrhoa,doublereal * vsigmaaa,doublereal * v2rhoa2,doublereal * v2rhoasigmaaa,doublereal * v2sigmaaa2)434 inline /* Subroutine */ int rks_c_vwn5__(integer *ideriv, integer *npt, doublereal *
435 rhoa1, doublereal *sigmaaa1, doublereal *zk, doublereal *vrhoa,
436 doublereal *vsigmaaa, doublereal *v2rhoa2, doublereal *v2rhoasigmaaa,
437 doublereal *v2sigmaaa2)
438 {
439 // WSTHORNTON
440 static doublereal c_b2 = .16666666666666666;
441 static doublereal c_b3 = .33333333333333331;
442 /* System generated locals */
443 integer i__1;
444 doublereal d__1, d__2;
445
446 /* Builtin functions */
447 double pow_dd(doublereal *, doublereal *), log(doublereal), atan(
448 doublereal);
449
450 /* Local variables */
451 static integer i__;
452 static doublereal s1, t1, t2, t4, t6, t7, t10, t20, t11, t22, t13, t23,
453 t16, t17, t25, t19, t26, t28, t29, t32, t33, t37, t38, t40, t41,
454 t43, t51, t52, t27, t34, t39, t46, t47, t48, t49, t53, t55, t56,
455 t58, t60, t63, t66, t67, t68, t69, t77, t79, t80, t81, t88, t92,
456 t94, t102, t103, t105, t107, t125, t134, t138, rho;
457
458
459 /* S.H. Vosko, L. Wilk, and M. Nusair */
460 /* Accurate spin-dependent electron liquid correlation energies for */
461 /* local spin density calculations: a critical analysis */
462 /* Can. J. Phys. 58 (1980) 1200-1211 */
463
464
465 /* CITATION: */
466
467 /* Functionals were obtained from the Density Functional Repository */
468 /* as developed and distributed by the Quantum Chemistry Group, */
469 /* CCLRC Daresbury Laboratory, Daresbury, Cheshire, WA4 4AD */
470 /* United Kingdom. Contact Huub van Dam (h.j.j.vandam@dl.ac.uk) or */
471 /* Paul Sherwood for further information. */
472
473 /* COPYRIGHT: */
474
475 /* Users may incorporate the source code into software packages and */
476 /* redistribute the source code provided the source code is not */
477 /* changed in anyway and is properly cited in any documentation or */
478 /* publication related to its use. */
479
480 /* ACKNOWLEDGEMENT: */
481
482 /* The source code was generated using Maple 8 through a modified */
483 /* version of the dfauto script published in: */
484
485 /* R. Strange, F.R. Manby, P.J. Knowles */
486 /* Automatic code generation in density functional theory */
487 /* Comp. Phys. Comm. 136 (2001) 310-318. */
488
489 /* Parameter adjustments */
490 --v2sigmaaa2;
491 --v2rhoasigmaaa;
492 --v2rhoa2;
493 --vsigmaaa;
494 --vrhoa;
495 --zk;
496 --sigmaaa1;
497 --rhoa1;
498
499 /* Function Body */
500 if (*ideriv == 0) {
501 i__1 = *npt;
502 for (i__ = 1; i__ <= i__1; ++i__) {
503 /* Computing MAX */
504 d__1 = 0., d__2 = rhoa1[i__];
505 rho = max(d__1,d__2);
506 if (rho > 1e-20) {
507 t1 = 1 / rho;
508 t2 = pow_dd(&t1, &c_b3);
509 t4 = pow_dd(&t1, &c_b2);
510 t7 = 1 / (t2 * .6203504908994 + t4 * 2.935818660072219 +
511 12.9352);
512 t10 = log(t2 * .6203504908994 * t7);
513 t16 = atan(6.15199081975908 / (t4 * 1.575246635799487 +
514 3.72744));
515 /* Computing 2nd power */
516 d__1 = t4 * .7876233178997433 + .10498;
517 t20 = d__1 * d__1;
518 t22 = log(t20 * t7);
519 zk[i__] = rho * (t10 * .0310907 + t16 * .03878329487811301 +
520 t22 * 9.690227711544374e-4);
521 } else {
522 /* rho */
523 zk[i__] = 0.;
524 }
525 /* rho */
526 }
527 } else if (*ideriv == 1) {
528 i__1 = *npt;
529 for (i__ = 1; i__ <= i__1; ++i__) {
530 /* Computing MAX */
531 d__1 = 0., d__2 = rhoa1[i__];
532 rho = max(d__1,d__2);
533 if (rho > 1e-20) {
534 t1 = 1 / rho;
535 t2 = pow_dd(&t1, &c_b3);
536 t4 = pow_dd(&t1, &c_b2);
537 t6 = t2 * .6203504908994 + t4 * 2.935818660072219 + 12.9352;
538 t7 = 1 / t6;
539 t10 = log(t2 * .6203504908994 * t7);
540 t11 = t10 * .0310907;
541 t13 = t4 * 1.575246635799487 + 3.72744;
542 t16 = atan(6.15199081975908 / t13);
543 t17 = t16 * .03878329487811301;
544 t19 = t4 * .7876233178997433 + .10498;
545 /* Computing 2nd power */
546 d__1 = t19;
547 t20 = d__1 * d__1;
548 t22 = log(t20 * t7);
549 t23 = t22 * 9.690227711544374e-4;
550 zk[i__] = rho * (t11 + t17 + t23);
551 /* Computing 2nd power */
552 d__1 = t2;
553 t25 = d__1 * d__1;
554 t26 = 1 / t25;
555 /* Computing 2nd power */
556 d__1 = rho;
557 t28 = d__1 * d__1;
558 t29 = 1 / t28;
559 /* Computing 2nd power */
560 d__1 = t6;
561 t32 = d__1 * d__1;
562 t33 = 1 / t32;
563 /* Computing 2nd power */
564 d__1 = t4;
565 t37 = d__1 * d__1;
566 /* Computing 2nd power */
567 d__1 = t37;
568 t38 = d__1 * d__1;
569 t40 = 1 / t38 / t4;
570 t41 = t40 * t29;
571 t43 = t26 * -.2067834969664667 * t29 - t41 *
572 .4893031100120365;
573 /* Computing 2nd power */
574 d__1 = t13;
575 t51 = d__1 * d__1;
576 t52 = 1 / t51;
577 vrhoa[i__] = t11 + t17 + t23 + rho * ((t26 *
578 -.2067834969664667 * t7 * t29 - t2 * .6203504908994 *
579 t33 * t43) * .05011795824473985 / t2 * t6 + t52 *
580 .0626408570946439 * t40 * t29 / (t52 * 37.8469910464
581 + 1.) + (t19 * -.2625411059665811 * t7 * t41 - t20 *
582 1. * t33 * t43) * 9.690227711544374e-4 / t20 * t6);
583 } else {
584 /* rho */
585 zk[i__] = 0.;
586 vrhoa[i__] = 0.;
587 }
588 /* rho */
589 }
590 } else if (*ideriv == 2) {
591 i__1 = *npt;
592 for (i__ = 1; i__ <= i__1; ++i__) {
593 /* Computing MAX */
594 d__1 = 0., d__2 = rhoa1[i__];
595 rho = max(d__1,d__2);
596 if (rho > 1e-20) {
597 t1 = 1 / rho;
598 t2 = pow_dd(&t1, &c_b3);
599 t4 = pow_dd(&t1, &c_b2);
600 t6 = t2 * .6203504908994 + t4 * 2.935818660072219 + 12.9352;
601 t7 = 1 / t6;
602 t10 = log(t2 * .6203504908994 * t7);
603 t11 = t10 * .0310907;
604 t13 = t4 * 1.575246635799487 + 3.72744;
605 t16 = atan(6.15199081975908 / t13);
606 t17 = t16 * .03878329487811301;
607 t19 = t4 * .7876233178997433 + .10498;
608 /* Computing 2nd power */
609 d__1 = t19;
610 t20 = d__1 * d__1;
611 t22 = log(t20 * t7);
612 t23 = t22 * 9.690227711544374e-4;
613 zk[i__] = rho * (t11 + t17 + t23);
614 /* Computing 2nd power */
615 d__1 = t2;
616 t25 = d__1 * d__1;
617 t26 = 1 / t25;
618 t27 = t26 * t7;
619 /* Computing 2nd power */
620 d__1 = rho;
621 t28 = d__1 * d__1;
622 t29 = 1 / t28;
623 /* Computing 2nd power */
624 d__1 = t6;
625 t32 = d__1 * d__1;
626 t33 = 1 / t32;
627 t34 = t2 * t33;
628 /* Computing 2nd power */
629 d__1 = t4;
630 t37 = d__1 * d__1;
631 /* Computing 2nd power */
632 d__1 = t37;
633 t38 = d__1 * d__1;
634 t39 = t38 * t4;
635 t40 = 1 / t39;
636 t41 = t40 * t29;
637 t43 = t26 * -.2067834969664667 * t29 - t41 *
638 .4893031100120365;
639 t46 = t27 * -.2067834969664667 * t29 - t34 * .6203504908994 *
640 t43;
641 t47 = 1 / t2;
642 t48 = t46 * t47;
643 t49 = t48 * t6;
644 /* Computing 2nd power */
645 d__1 = t13;
646 t51 = d__1 * d__1;
647 t52 = 1 / t51;
648 t53 = t52 * t40;
649 t55 = t52 * 37.8469910464 + 1.;
650 t56 = 1 / t55;
651 t58 = t53 * t29 * t56;
652 t60 = t19 * t7;
653 t63 = t20 * t33;
654 t66 = t60 * -.2625411059665811 * t41 - t63 * 1. * t43;
655 t67 = 1 / t20;
656 t68 = t66 * t67;
657 t69 = t68 * t6;
658 vrhoa[i__] = t11 + t17 + t23 + rho * (t49 *
659 .05011795824473985 + t58 * .0626408570946439 + t69 *
660 9.690227711544374e-4);
661 t77 = 1 / t25 / t1;
662 /* Computing 2nd power */
663 d__1 = t28;
664 t79 = d__1 * d__1;
665 t80 = 1 / t79;
666 t81 = t77 * t7 * t80;
667 t88 = 1 / t28 / rho;
668 t92 = 1 / t32 / t6;
669 /* Computing 2nd power */
670 d__1 = t43;
671 t94 = d__1 * d__1;
672 t102 = 1 / t39 / t1;
673 t103 = t102 * t80;
674 t105 = t40 * t88;
675 t107 = t77 * -.1378556646443111 * t80 + t26 *
676 .4135669939329333 * t88 - t103 * .4077525916766971 +
677 t105 * .978606220024073;
678 t125 = t80 * t56;
679 /* Computing 2nd power */
680 d__1 = t51;
681 t134 = d__1 * d__1;
682 /* Computing 2nd power */
683 d__1 = t55;
684 t138 = d__1 * d__1;
685 s1 = t49 * .2004718329789594 + t58 * .2505634283785756;
686 v2rhoa2[i__] = s1 + t69 * .00387609108461775 + rho * 2. * ((
687 t81 * -.1378556646443111 + t26 * .4135669939329333 *
688 t33 * t29 * t43 + t27 * .4135669939329333 * t88 + t2 *
689 1.2407009817988 * t92 * t94 - t34 * .6203504908994 *
690 t107) * .05011795824473985 * t47 * t6 + t46 *
691 .01670598608157995 / t2 / t1 * t6 * t29 + t48 *
692 .05011795824473985 * t43 + .03289159980064473 / t51 /
693 t13 * t77 * t125 + t52 * .05220071424553658 * t102 *
694 t125 - t53 * .1252817141892878 * t88 * t56 -
695 1.244848083156773 / t134 / t13 * t77 * t80 / t138 + (
696 t81 * .03446391616107778 + t19 * .5250822119331622 *
697 t33 * t41 * t43 - t60 * .2187842549721509 * t103 +
698 t60 * .5250822119331622 * t105 + t20 * 2. * t92 * t94
699 - t63 * 1. * t107) * 9.690227711544374e-4 * t67 * t6
700 + t66 * 2.544083100456872e-4 / t20 / t19 * t6 * t40 *
701 t29 + t68 * 9.690227711544374e-4 * t43);
702 } else {
703 /* rho */
704 zk[i__] = 0.;
705 vrhoa[i__] = 0.;
706 v2rhoa2[i__] = 0.;
707 }
708 /* rho */
709 }
710 }
711 /* ideriv */
712 return 0;
713 } /* rks_c_vwn5__ */
714
rks_x_lda__(integer * ideriv,integer * npt,doublereal * rhoa1,doublereal * sigmaaa1,doublereal * zk,doublereal * vrhoa,doublereal * vsigmaaa,doublereal * v2rhoa2,doublereal * v2rhoasigmaaa,doublereal * v2sigmaaa2)715 inline /* Subroutine */ int rks_x_lda__(integer *ideriv, integer *npt, doublereal *
716 rhoa1, doublereal *sigmaaa1, doublereal *zk, doublereal *vrhoa,
717 doublereal *vsigmaaa, doublereal *v2rhoa2, doublereal *v2rhoasigmaaa,
718 doublereal *v2sigmaaa2)
719 {
720 // WSTHORNTON
721 static doublereal c_b2 = .33333333333333331;
722
723 /* System generated locals */
724 integer i__1;
725 doublereal d__1, d__2;
726
727 /* Builtin functions */
728 double pow_dd(doublereal *, doublereal *);
729
730 /* Local variables */
731 static integer i__;
732 static doublereal t1, t5, rho;
733
734
735 /* P.A.M. Dirac */
736 /* Proceedings of the Cambridge Philosophical Society, 26 (1930) 376 */
737
738
739 /* CITATION: */
740
741 /* Functionals were obtained from the Density Functional Repository */
742 /* as developed and distributed by the Quantum Chemistry Group, */
743 /* CCLRC Daresbury Laboratory, Daresbury, Cheshire, WA4 4AD */
744 /* United Kingdom. Contact Huub van Dam (h.j.j.vandam@dl.ac.uk) or */
745 /* Paul Sherwood for further information. */
746
747 /* COPYRIGHT: */
748
749 /* Users may incorporate the source code into software packages and */
750 /* redistribute the source code provided the source code is not */
751 /* changed in anyway and is properly cited in any documentation or */
752 /* publication related to its use. */
753
754 /* ACKNOWLEDGEMENT: */
755
756 /* The source code was generated using Maple 8 through a modified */
757 /* version of the dfauto script published in: */
758
759 /* R. Strange, F.R. Manby, P.J. Knowles */
760 /* Automatic code generation in density functional theory */
761 /* Comp. Phys. Comm. 136 (2001) 310-318. */
762
763 /* Parameter adjustments */
764 --v2sigmaaa2;
765 --v2rhoasigmaaa;
766 --v2rhoa2;
767 --vsigmaaa;
768 --vrhoa;
769 --zk;
770 --sigmaaa1;
771 --rhoa1;
772
773 /* Function Body */
774 if (*ideriv == 0) {
775 i__1 = *npt;
776 for (i__ = 1; i__ <= i__1; ++i__) {
777 /* Computing MAX */
778 d__1 = 0., d__2 = rhoa1[i__];
779 rho = max(d__1,d__2);
780 if (rho > 1e-20) {
781 t1 = pow_dd(&rho, &c_b2);
782 zk[i__] = t1 * -.7385587663820224 * rho;
783 } else {
784 /* rho */
785 zk[i__] = 0.;
786 }
787 /* rho */
788 }
789 } else if (*ideriv == 1) {
790 i__1 = *npt;
791 for (i__ = 1; i__ <= i__1; ++i__) {
792 /* Computing MAX */
793 d__1 = 0., d__2 = rhoa1[i__];
794 rho = max(d__1,d__2);
795 if (rho > 1e-20) {
796 t1 = pow_dd(&rho, &c_b2);
797 zk[i__] = t1 * -.7385587663820224 * rho;
798 vrhoa[i__] = t1 * -.9847450218426965;
799 } else {
800 /* rho */
801 zk[i__] = 0.;
802 vrhoa[i__] = 0.;
803 }
804 /* rho */
805 }
806 } else if (*ideriv == 2) {
807 i__1 = *npt;
808 for (i__ = 1; i__ <= i__1; ++i__) {
809 /* Computing MAX */
810 d__1 = 0., d__2 = rhoa1[i__];
811 rho = max(d__1,d__2);
812 if (rho > 1e-20) {
813 t1 = pow_dd(&rho, &c_b2);
814 zk[i__] = t1 * -.7385587663820224 * rho;
815 vrhoa[i__] = t1 * -.9847450218426965;
816 /* Computing 2nd power */
817 d__1 = t1;
818 t5 = d__1 * d__1;
819 v2rhoa2[i__] = -.6564966812284644 / t5;
820 } else {
821 /* rho */
822 zk[i__] = 0.;
823 vrhoa[i__] = 0.;
824 v2rhoa2[i__] = 0.;
825 }
826 /* rho */
827 }
828 }
829 /* ideriv */
830 return 0;
831 } /* rks_x_lda__ */
832
833 const double THRESH_RHO = 1e-8;
834 const double THRESH_GRHO = 1e-20;
835
wst_munge_grho(int npoint,double * rho,double * grho)836 inline void wst_munge_grho(int npoint, double *rho, double *grho) {
837 for (int i=0; i<npoint; i++) {
838 if (rho[i]<THRESH_RHO) rho[i] = THRESH_RHO;
839 if ((rho[i] <=THRESH_RHO) ||
840 (grho[i] < THRESH_GRHO)) grho[i] = THRESH_GRHO;
841 }
842 }
843
wst_munge_rho(int npoint,double * rho)844 inline void wst_munge_rho(int npoint, double *rho) {
845 for (int i=0; i<npoint; i++) {
846 if (rho[i]<THRESH_RHO) rho[i] = THRESH_RHO;
847 }
848 }
849
850 //***************************************************************************
xc_rks_generic_lda(Tensor<double> rho_alpha,Tensor<double> f,Tensor<double> df_drho)851 inline void xc_rks_generic_lda(Tensor<double> rho_alpha, ///< Alpha-spin density at each grid point
852 Tensor<double> f, ///< Value of functional at each grid point
853 Tensor<double> df_drho) ///< Derivative of functional w.r.t. rho_alpha
854 {
855 MADNESS_ASSERT(rho_alpha.iscontiguous());
856 MADNESS_ASSERT(f.iscontiguous());
857 MADNESS_ASSERT(df_drho.iscontiguous());
858
859 rho_alpha = rho_alpha.flat();
860 f = f.flat();
861 df_drho = df_drho.flat();
862
863 integer ideriv = 2;
864 integer npt = rho_alpha.dim(0);
865
866 Tensor<double> gamma_alpha(npt);
867 Tensor<double> tf(npt);
868 Tensor<double> tdf_drho(npt);
869 Tensor<double> tdf_dgamma(npt);
870 Tensor<double> td2f_drho2(npt);
871 Tensor<double> td2f_drhodgamma(npt);
872 Tensor<double> td2f_dgamma2(npt);
873
874 wst_munge_rho(npt, rho_alpha.ptr());
875
876 f.fill(0.0);
877 df_drho.fill(0.0);
878
879 int returnvalue = ::rks_x_lda__(&ideriv, &npt, rho_alpha.ptr(), gamma_alpha.ptr(),
880 tf.ptr(),
881 tdf_drho.ptr(), tdf_dgamma.ptr(),
882 td2f_drho2.ptr(), td2f_drhodgamma.ptr(), td2f_dgamma2.ptr());
883
884 f.gaxpy(1.0, tf, 1.0);
885 df_drho.gaxpy(1.0, tdf_drho, 1.0);
886
887 tf.fill(0.0);
888 tdf_drho.fill(0.0);
889
890 returnvalue = ::rks_c_vwn5__(&ideriv, &npt, rho_alpha.ptr(), gamma_alpha.ptr(),
891 tf.ptr(),
892 tdf_drho.ptr(), tdf_dgamma.ptr(),
893 td2f_drho2.ptr(), td2f_drhodgamma.ptr(), td2f_dgamma2.ptr());
894
895 f.gaxpy(1.0, tf, 1.0);
896 df_drho.gaxpy(1.0, tdf_drho, 1.0);
897
898 }
899 //***************************************************************************
900
901 //***************************************************************************
902 template <int NDIM>
dft_xc_lda_V(const Key<NDIM> & key,Tensor<double> & t)903 inline void dft_xc_lda_V(const Key<NDIM>& key, Tensor<double>& t)
904 {
905 Tensor<double> enefunc = copy(t);
906 Tensor<double> V = copy(t);
907 ::xc_rks_generic_lda(t, enefunc, V);
908 t(___) = V(___);
909 }
910 //***************************************************************************
911
912 //***************************************************************************
913 template <int NDIM>
dft_xc_lda_ene(const Key<NDIM> & key,Tensor<double> & t)914 inline void dft_xc_lda_ene(const Key<NDIM>& key, Tensor<double>& t)
915 {
916 Tensor<double> V = copy(t);
917 Tensor<double> enefunc = copy(t);
918 ::xc_rks_generic_lda(t, enefunc, V);
919 t(___) = enefunc(___);
920 }
921 //***************************************************************************
922
923 // //***************************************************************************
924 // static double munge(double r) {
925 // if (r < 1e-12) r = 1e-12;
926 // return r;
927 // }
928 // //***************************************************************************
929 //
930 // //***************************************************************************
931 // static void ldaop(const Key<3>& key, Tensor<double>& t) {
932 // UNARY_OPTIMIZED_ITERATOR(double, t, double r=munge(2.0* *_p0); double q; double dq1; double dq2;x_rks_s__(&r, &q, &dq1);c_rks_vwn5__(&r, &q, &dq2); *_p0 = dq1+dq2);
933 // }
934 // //***************************************************************************
935 //
936 // //***************************************************************************
937 // static void ldaeop(const Key<3>& key, Tensor<double>& t) {
938 // UNARY_OPTIMIZED_ITERATOR(double, t, double r=munge(2.0* *_p0); double q1; double q2; double dq;x_rks_s__(&r, &q1, &dq);c_rks_vwn5__(&r, &q2, &dq); *_p0 = q1+q2);
939 // }
940 // //***************************************************************************
941
942
943
944 #endif /* LDA_H_ */
945