← Back to branch summary

~ubuntu-branches/ubuntu/trusty/nwchem/trusty-proposed

« back to all changes in this revision

Viewing changes to src/tools/ga-5-2/gfutex/examples/scf/integ.c

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Daniel Leidert, Andreas Tille, Michael Banck
  • Date: 2013-07-04 12:14:55 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130704121455-5tvsx2qabor3nrui
Tags: 6.3-1
http://bugs.debian.org/696361
* New upstream release.
* Fixes anisotropic properties (Closes: #696361).
* New features include:
  + Multi-reference coupled cluster (MRCC) approaches
  + Hybrid DFT calculations with short-range HF 
  + New density-functionals including Minnesota (M08, M11) and HSE hybrid
    functionals
  + X-ray absorption spectroscopy (XAS) with TDDFT
  + Analytical gradients for the COSMO solvation model
  + Transition densities from TDDFT 
  + DFT+U and Electron-Transfer (ET) methods for plane wave calculations
  + Exploitation of space group symmetry in plane wave geometry optimizations
  + Local density of states (LDOS) collective variable added to Metadynamics
  + Various new XC functionals added for plane wave calculations, including
    hybrid and range-corrected ones
  + Electric field gradients with relativistic corrections 
  + Nudged Elastic Band optimization method
  + Updated basis sets and ECPs 

[ Daniel Leidert ]
* debian/watch: Fixed.

[ Andreas Tille ]
* debian/upstream: References

[ Michael Banck ]
* debian/upstream (Name): New field.
* debian/patches/02_makefile_flags.patch: Refreshed.
* debian/patches/06_statfs_kfreebsd.patch: Likewise.
* debian/patches/07_ga_target_force_linux.patch: Likewise.
* debian/patches/05_avoid_inline_assembler.patch: Removed, no longer needed.
* debian/patches/09_backported_6.1.1_fixes.patch: Likewise.
* debian/control (Build-Depends): Added gfortran-4.7 and gcc-4.7.
* debian/patches/10_force_gcc-4.7.patch: New patch, explicitly sets
  gfortran-4.7 and gcc-4.7, fixes test suite hang with gcc-4.8 (Closes:
  #701328, #713262).
* debian/testsuite: Added tests for COSMO analytical gradients and MRCC.
* debian/rules (MRCC_METHODS): New variable, required to enable MRCC methods.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/tools/ga-5-2/gfutex/examples/scf/integ.c
 
1
#include <math.h>
 
2
#include "cscc.h"
 
3
#include "ga.h"
 
4
 
 
5
double fm[2001][5];
 
6
double rdelta, delta, delo2;
 
7
 
 
8
double exprjh(double x)
 
9
{
 
10
//$Id: integ.F,v 1.1 2005-03-08 23:58:03 d3g293 Exp $
 
11
  double ret;
 
12
     
 
13
//     dumb solution to underflow problems on sun
 
14
 
 
15
  if (x < -37.0)  {
 
16
    ret = 0.0;
 
17
  } 
 
18
  else {
 
19
    ret = exp(x);
 
20
  }
 
21
 
 
22
  return ret;
 
23
}
 
24
 
 
25
void setfm(void)
 
26
{
 
27
  int i, ii;
 
28
  double t[2001];
 
29
  double et[2001], rr, tt;
 
30
  int MAXm;
 
31
 
 
32
  delta = 0.014;
 
33
  delo2 = delta * 0.5;
 
34
  rdelta = 1.0 / delta;
 
35
  //MAXm = 4;
 
36
  MAXm = 3; //Fortran Array Index 1==> C Array Index 0==>
 
37
 
 
38
  for (i = 0; i < 2001; i++) {
 
39
    tt = delta * (double)i; //i-1 ---> i
 
40
    et[i] = exprjh(-tt);
 
41
    t[i] = tt * 2.0;
 
42
    fm[i][MAXm + 1] = 0.0;
 
43
  }
 
44
 
 
45
  for (i = 199; i > MAXm; i--) {
 
46
    rr = 1.0 / (double)(2 * i + 1); //+1 ---> +1
 
47
    for (ii = 0; ii < 2001; ii++) {
 
48
      fm[ii][MAXm + 1] = (et[ii] + t[ii] * fm[ii][MAXm + 1]) * rr;
 
49
    }
 
50
  }
 
51
 
 
52
  for (i = MAXm; i >= 0; i--) {
 
53
    rr = 1.0 / (double) (2 * i + 1); //-1 ---> +1
 
54
    for (ii = 0; ii < 2001; ii++) {
 
55
      fm[ii][i] = (et[ii] + t[ii] * fm[ii][i+1]) * rr;
 
56
    }
 
57
  }
 
58
 
 
59
  return;
 
60
}
 
61
 
 
62
void f0(double *value, double t)
 
63
{
 
64
  const double fac0 = 0.88622692545276;
 
65
  const double rhalf = 0.5;
 
66
  const double rthird = (1.0 / 3.0);
 
67
  const double rquart = 0.25;
 
68
 
 
69
  double t0 = 28.0; //fortran: data --> C: long double or double?
 
70
 
 
71
  int n;
 
72
  double x;
 
73
 
 
74
  //     computes f0 to a relative accuracy of better than 4.e-13 for all t.
 
75
  //     uses 4th order taylor expansion on grid out to t=28.0
 
76
  //     asymptotic expansion accurate for t greater than 28
 
77
 
 
78
  if (t >= t0)
 
79
    *value = fac0 / sqrt(t);
 
80
  else {
 
81
    n = (int) ((t + delo2) * rdelta);
 
82
    x = delta * (double) n - t;
 
83
    //n=n+1; //c index 0, fortran index 1
 
84
    *value = fm[n][0] + x * (fm[n][1] + x * rhalf *
 
85
                             (fm[n][2] + x * rthird * (fm[n][3] + x * rquart * fm[n][4])));
 
86
  }
 
87
 
 
88
  return;
 
89
}
 
90
 
 
91
void addin(double *g, int *i, int *j, int *k, int *l, double *fock, double *dens, int *iky) //seems unused
 
92
{
 
93
    static double g2, g4, gg;
 
94
    static int ij, ik, il, jk, jl, kl;
 
95
    static double aij, aik, ajk, ail, gil;
 
96
 
 
97
    gg = *g;
 
98
    g2 = gg + gg;
 
99
    g4 = g2 + g2;
 
100
    ik = iky[*i] + *k;
 
101
    il = iky[*i] + *l;
 
102
    ij = iky[*i] + *j;
 
103
    jk = iky[MAX(*j,*k)] + MIN(*j,*k);
 
104
    jl = iky[MAX(*j,*l)] + MIN(*j,*l);
 
105
    kl = iky[*k] + *l;
 
106
    aij = g4 * dens[kl] + fock[ij];
 
107
    fock[kl] = g4 * dens[ij] + fock[kl];
 
108
    fock[ij] = aij;
 
109
    gil = gg;
 
110
    if (*i == *k || *j == *l) 
 
111
   {
 
112
        gg = g2;
 
113
    }
 
114
    if (*j == *k) 
 
115
    {
 
116
        gil = g2;
 
117
    }
 
118
    ajk = fock[jk] - gil * dens[il];
 
119
    ail = fock[il] - gil * dens[jk];
 
120
    aik = fock[ik] - gg * dens[jl];
 
121
    fock[jl] -= gg * dens[ik];
 
122
    fock[jk] = ajk;
 
123
    fock[il] = ail;
 
124
    fock[ik] = aik;
 
125
 
 
126
    return;
 
127
}
 
128
 
 
129
void dfill(int *n, double *val, double *a, int *ia) //seems unused
 
130
{
 
131
    int i;
 
132
 
 
133
    if (*ia == 1) 
 
134
    {
 
135
        for (i = 0; i < *n; i++) 
 
136
        {
 
137
            a[i] = *val;
 
138
        }
 
139
    } 
 
140
    else 
 
141
    {
 
142
        for (i = 0; i < (*n - 1) * (*ia) + 1; i += *ia) 
 
143
        {
 
144
            a[i] = *val;
 
145
        }
 
146
    }
 
147
 
 
148
    return;
 
149
}