~ubuntu-branches/ubuntu/saucy/nwchem/saucy

« back to all changes in this revision

Viewing changes to src/tools/ga-4-3/global/examples/scf/integ.F

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Michael Banck, Daniel Leidert
  • Date: 2012-02-09 20:02:41 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20120209200241-jgk03qfsphal4ug2
Tags: 6.1-1
* New upstream release.

[ Michael Banck ]
* debian/patches/02_makefile_flags.patch: Updated.
* debian/patches/02_makefile_flags.patch: Use internal blas and lapack code.
* debian/patches/02_makefile_flags.patch: Define GCC4 for LINUX and LINUX64
  (Closes: #632611 and LP: #791308).
* debian/control (Build-Depends): Added openssh-client.
* debian/rules (USE_SCALAPACK, SCALAPACK): Removed variables (Closes:
  #654658).
* debian/rules (LIBDIR, USE_MPIF4, ARMCI_NETWORK): New variables.
* debian/TODO: New file.
* debian/control (Build-Depends): Removed libblas-dev, liblapack-dev and
  libscalapack-mpi-dev.
* debian/patches/04_show_testsuite_diff_output.patch: New patch, shows the
  diff output for failed tests.
* debian/patches/series: Adjusted.
* debian/testsuite: Optionally run all tests if "all" is passed as option.
* debian/rules: Run debian/testsuite with "all" if DEB_BUILD_OPTIONS
  contains "checkall".

[ Daniel Leidert ]
* debian/control: Used wrap-and-sort. Added Vcs-Svn and Vcs-Browser fields.
  (Priority): Moved to extra according to policy section 2.5.
  (Standards-Version): Bumped to 3.9.2.
  (Description): Fixed a typo.
* debian/watch: Added.
* debian/patches/03_hurd-i386_define_path_max.patch: Added.
  - Define MAX_PATH if not defines to fix FTBFS on hurd.
* debian/patches/series: Adjusted.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
      double precision function exprjh(x)
 
2
C$Id: integ.F,v 1.1 2005-03-08 23:58:03 d3g293 Exp $
 
3
      double precision x
 
4
c     
 
5
c     dumb solution to underflow problems on sun
 
6
c
 
7
      if (x.lt.-37.0d0) then
 
8
         exprjh = 0.0d0
 
9
      else
 
10
         exprjh = exp(x)
 
11
      endif
 
12
      end
 
13
      subroutine setfm
 
14
      implicit double precision (a-h,o-z)
 
15
      common/values/fm(2001,5),rdelta,delta,delo2
 
16
      dimension t(2001),et(2001)
 
17
c
 
18
c     initalize common block for computation of f0 by recursion down
 
19
c     from f200
 
20
c
 
21
      delta=28.0d0/2000.0d0
 
22
      delo2=delta*0.5d0
 
23
      rdelta=1.0d0/delta
 
24
      maxm=4
 
25
      do 10 i=1,2001
 
26
          tt=delta*dble(i-1)
 
27
          et(i)=exprjh(-tt)
 
28
          t(i)=2.0d0*tt
 
29
          fm(i,maxm+1)=0.0d0
 
30
10    continue
 
31
      do 20 i=200,maxm,-1
 
32
          rr=1.0d0/dble(2*i+1)
 
33
          do 30 ii=1,2001
 
34
              fm(ii,maxm+1)=(et(ii)+t(ii)*fm(ii,maxm+1))*rr
 
35
30        continue
 
36
20    continue
 
37
      do 40 i=maxm,1,-1
 
38
          rr=1.0d0/dble(2*i-1)
 
39
          do 50 ii=1,2001
 
40
            fm(ii,i)=(et(ii)+t(ii)*fm(ii,i+1))*rr
 
41
50        continue
 
42
40    continue
 
43
c
 
44
      end
 
45
      subroutine f0(value, t)
 
46
      implicit real*8   (a-h,o-z)
 
47
      common/values/fm(2001,5),rdelta,delta,delo2
 
48
      parameter(fac0=0.88622692545276d0,
 
49
     $          rhalf=0.5d0,rthird=0.3333333333333333d0,rquart=0.25d0)
 
50
      data t0/28.d0/
 
51
c
 
52
c     computes f0 to a relative accuracy of better than 4.e-13 for all t.
 
53
c     uses 4th order taylor expansion on grid out to t=28.0
 
54
c     asymptotic expansion accurate for t greater than 28
 
55
c
 
56
      if(t.ge.t0) then
 
57
          value = fac0 / sqrt(t)
 
58
      else
 
59
          n = idint((t+delo2)*rdelta)
 
60
          x = delta*dble(n)-t
 
61
          n = n+1
 
62
          value = fm(n,1)+x*(fm(n,2)+rhalf*x*(fm(n,3)+
 
63
     $             rthird*x*(fm(n,4)+rquart*x*fm(n,5))))
 
64
      endif
 
65
c
 
66
      end
 
67
      subroutine addin(g, i, j, k, l, fock, dens, iky)
 
68
      implicit double precision (a-h, o-z)
 
69
      dimension fock(*), dens(*), iky(*)
 
70
c
 
71
c     add (ij|kl) into the fock matrix
 
72
c
 
73
      gg = g
 
74
      g2 = gg+gg
 
75
      g4 = g2+g2
 
76
      ik = iky(i) + k
 
77
      il = iky(i) + l
 
78
      ij = iky(i) + j
 
79
      jk = iky(max(j,k)) + min(j,k)
 
80
      jl = iky(max(j,l)) + min(j,l)
 
81
      kl = iky(k) + l
 
82
      aij = g4*dens(kl)+fock(ij)
 
83
      fock(kl) = g4*dens(ij)+fock(kl)
 
84
      fock(ij) = aij
 
85
      gil=gg
 
86
      if(i.eq.k.or.j.eq.l) gg = g2
 
87
      if(j.eq.k) gil = g2
 
88
      ajk = fock(jk) - gil*dens(il)
 
89
      ail = fock(il) - gil*dens(jk)
 
90
      aik = fock(ik) - gg*dens(jl)
 
91
      fock(jl) = fock(jl) - gg*dens(ik)
 
92
      fock(jk) = ajk
 
93
      fock(il) = ail
 
94
      fock(ik) = aik
 
95
c
 
96
      end
 
97
      subroutine dfill(n,val,a,ia)
 
98
      implicit real*8 (a-h,o-z)
 
99
      dimension a(*)
 
100
c
 
101
c     initialise double precision array to scalar value
 
102
c
 
103
      if (ia.eq.1) then
 
104
         do 10 i = 1, n
 
105
            a(i) = val
 
106
 10      continue
 
107
      else
 
108
         do 20 i = 1,(n-1)*ia+1,ia
 
109
            a(i) = val
 
110
 20      continue
 
111
      endif
 
112
c
 
113
      end