[0b990d] | 1 |
|
---|
| 2 | #include <math.h>
|
---|
| 3 | #include <float.h>
|
---|
| 4 |
|
---|
| 5 | #include <chemistry/qc/intv3/fjt.h>
|
---|
| 6 | #include <util/misc/formio.h>
|
---|
| 7 |
|
---|
| 8 | using namespace std;
|
---|
| 9 | using namespace sc;
|
---|
| 10 |
|
---|
| 11 | // this should only be used for x < a + 1
|
---|
| 12 | static double
|
---|
| 13 | mgamma_small_x(double a, double x)
|
---|
| 14 | {
|
---|
| 15 | const int nterm = 1000;
|
---|
| 16 | // n = 0
|
---|
| 17 | double xn = 1.0;
|
---|
| 18 | double an = a;
|
---|
| 19 | double c0 = xn/an;
|
---|
| 20 | int n = 1;
|
---|
| 21 | double sum = c0;
|
---|
| 22 | double contrib;
|
---|
| 23 | double c0eps = c0 * DBL_EPSILON;
|
---|
| 24 | do {
|
---|
| 25 | an *= a+n;
|
---|
| 26 | xn *= x;
|
---|
| 27 | contrib = xn/an;
|
---|
| 28 | n++;
|
---|
| 29 | sum += contrib;
|
---|
| 30 | } while(contrib > c0eps);
|
---|
| 31 | return sum * exp(-x);
|
---|
| 32 | }
|
---|
| 33 |
|
---|
| 34 | static double
|
---|
| 35 | Gamma_m(int m, double x)
|
---|
| 36 | {
|
---|
| 37 | double a = m+0.5;
|
---|
| 38 | const double tiny = DBL_EPSILON * DBL_EPSILON;
|
---|
| 39 | // iteration 0
|
---|
| 40 | double f = tiny;
|
---|
| 41 | double c = f;
|
---|
| 42 | double d = 0.0;
|
---|
| 43 | double delta;
|
---|
| 44 | // iteration 1 +
|
---|
| 45 | int j=1;
|
---|
| 46 | double ac = 1.0;
|
---|
| 47 | double bc = x + 1.0 - a;
|
---|
| 48 | do {
|
---|
| 49 | d = bc + ac * d;
|
---|
| 50 | if (d == 0.0) d = tiny;
|
---|
| 51 | c = bc + ac/c;
|
---|
| 52 | if (c == 0.0) c = tiny;
|
---|
| 53 | d = 1.0/d;
|
---|
| 54 | delta = c*d;
|
---|
| 55 | f = f*delta;
|
---|
| 56 | ac = - j * (j - a);
|
---|
| 57 | bc += 2.0;
|
---|
| 58 | j++;
|
---|
| 59 | } while (fabs(delta-1.0) > DBL_EPSILON);
|
---|
| 60 | return exp(-x)*pow(x,a)*f;
|
---|
| 61 | }
|
---|
| 62 |
|
---|
| 63 | static double
|
---|
| 64 | Gamma_m(int m)
|
---|
| 65 | {
|
---|
| 66 | double a = m+0.5;
|
---|
| 67 | const double c[6] = { 76.18009172947146,
|
---|
| 68 | -86.50532032941677,
|
---|
| 69 | 24.01409824083091,
|
---|
| 70 | -1.231739572450155,
|
---|
| 71 | 0.1208650973866179e-2,
|
---|
| 72 | -0.5395239384953e-5};
|
---|
| 73 | double x,y,tmp,ser;
|
---|
| 74 | int j;
|
---|
| 75 | y = x = a;
|
---|
| 76 | tmp = x + 5.5;
|
---|
| 77 | tmp -= (x+0.5)*log(tmp);
|
---|
| 78 | ser = 1.000000000190015;
|
---|
| 79 | for (j=0; j<=5; j++) ser += c[j]/++y;
|
---|
| 80 | return exp(-tmp+log(2.5066282746310005*ser/x));
|
---|
| 81 | }
|
---|
| 82 |
|
---|
| 83 | static double
|
---|
| 84 | gamma_m_large_x(int m, double x)
|
---|
| 85 | {
|
---|
| 86 | return Gamma_m(m) - Gamma_m(m,x);
|
---|
| 87 | }
|
---|
| 88 |
|
---|
| 89 | static double
|
---|
| 90 | mgamma_m(int m, double x)
|
---|
| 91 | {
|
---|
| 92 | double a = m+0.5;
|
---|
| 93 | if (x < a + 1.0) return mgamma_small_x(a,x);
|
---|
| 94 | return gamma_m_large_x(m,x)/pow(x,a);
|
---|
| 95 | }
|
---|
| 96 |
|
---|
| 97 | static double
|
---|
| 98 | Fjt(int j, double t)
|
---|
| 99 | {
|
---|
| 100 | //return gamma(j+0.5,sqrt(t))/(2.0*pow(t,j+0.5));
|
---|
| 101 | return 0.5 * mgamma_m(j,t);
|
---|
| 102 | }
|
---|
| 103 |
|
---|
| 104 | int
|
---|
| 105 | main(int,char**)
|
---|
| 106 | {
|
---|
| 107 | int maxj = 18;
|
---|
| 108 | Ref<FJT> fjt = new FJT(maxj+1);
|
---|
| 109 |
|
---|
| 110 | double tinc = 0.1;
|
---|
| 111 | for (double T=0.0; T<1000.0; T+=tinc) {
|
---|
| 112 | double *values = fjt->values(maxj,T);
|
---|
| 113 | for (int j=0; j<=maxj; j+=1) {
|
---|
| 114 | double v1 = values[j];
|
---|
| 115 | double v2 = Fjt(j,T);
|
---|
| 116 | double error = fabs((v1-v2)/v1);
|
---|
| 117 | if (error > DBL_EPSILON*10.0) {
|
---|
| 118 | cout << scprintf("F(%2d,%5.2f) = %15.12f %15.12f e = %18.15f",
|
---|
| 119 | j,T,v1,v2, error) << endl;
|
---|
| 120 | }
|
---|
| 121 | else {
|
---|
| 122 | cout << scprintf("F(%2d,%5.2f) = %15.12f %15.12f",
|
---|
| 123 | j,T,v1,v2) << endl;
|
---|
| 124 | }
|
---|
| 125 | }
|
---|
| 126 | if (T > 10.0) tinc = 10.0;
|
---|
| 127 | if (T > 100.0) tinc = 100.0;
|
---|
| 128 | }
|
---|
| 129 |
|
---|
| 130 | return 0;
|
---|
| 131 | }
|
---|