← Back to branch summary

~ubuntu-branches/ubuntu/utopic/nwchem/utopic

« back to all changes in this revision

Viewing changes to src/nwpw/nwpwlib/utilities/paw_utilities/nwpw_SpecialKummer.F

  • 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/nwpw/nwpwlib/utilities/paw_utilities/nwpw_SpecialKummer.F
 
1
c
 
2
c $Id: nwpw_SpecialKummer.F 21176 2011-10-10 06:35:49Z d3y133 $
 
3
c
 
4
 
 
5
*     ******************************************************
 
6
*     *                                                    *
 
7
*     *             nwpw_SpecialKummer                     *
 
8
*     *                                                    *
 
9
*     ******************************************************
 
10
*
 
11
*     Calculates a special case of the Kummer confluent hypergeometric 
 
12
*     function, M(n+1/2,l+3/2,z) for z .LE. 0
 
13
*
 
14
*     This function was created by  Marat Valiev, and  modified by Eric Bylaska.
 
15
*     See Abramowitz and Stegun for the formulas used in this function.
 
16
*
 
17
      real*8 function nwpw_SpecialKummer(n,l,z)
 
18
      implicit none
 
19
      integer n,l
 
20
      real*8  z
 
21
 
 
22
*     *** local variables ***
 
23
      real*8 eps
 
24
      parameter (eps=1.0d-16)
 
25
 
 
26
      integer i
 
27
      real*8 a,b,m1,m3,s
 
28
 
 
29
*     **** external functions ****
 
30
      real*8   util_gamma,util_gammp
 
31
      external util_gamma,util_gammp
 
32
 
 
33
      nwpw_SpecialKummer = 0.0d0
 
34
 
 
35
*    *** cannot handle positive z ***
 
36
      if (z.gt.0.0d0) then
 
37
         call errquit('nwpw_SpecialKummer:invalid parameter, z>0',0,1)
 
38
      end if
 
39
 
 
40
 
 
41
*    *** solution for z==0 ***
 
42
      if (z.eq.0.0d0) then
 
43
         nwpw_SpecialKummer = 1.0d0
 
44
         return 
 
45
      end if
 
46
 
 
47
*     ***** M(a,a+1,z) = a * (-z)**(-a) * igamma(a,-z) = a * (-z)**(-a) * P(a,-z) *Gamma(a)  where z is real and a = (n+0.5)  ****
 
48
      if (n.eq.l) then
 
49
         nwpw_SpecialKummer = util_gammp(n+0.5d0,(-z))
 
50
     >                       *(n+0.5d0) 
 
51
     >                       *((-z)**((-n)- 0.5d0))
 
52
     >                       *util_gamma(n+0.5d0)
 
53
         return 
 
54
 
 
55
*     ***** M(a,a,z) = exp(z)  where a = (n+0.5)  ****
 
56
      else if (n.eq.(l+1)) then
 
57
         nwpw_SpecialKummer = dexp(z)
 
58
         return 
 
59
      end if
 
60
 
 
61
!     *** do inifinite series for small z
 
62
      if (dabs(z).le.1.0d0) then
 
63
 
 
64
         nwpw_SpecialKummer = 1.0d0
 
65
         s = 1.0d0
 
66
         a = n + 0.5d0
 
67
         b = l + 1.5d0
 
68
         do i=1,10000
 
69
            s = s*(a+i-1)*z/((b+i-1)*i)
 
70
            nwpw_SpecialKummer = nwpw_SpecialKummer + s
 
71
            if (dabs(s).lt.eps) return 
 
72
         end do
 
73
         call errquit("nwpw_SpecialKummer:cannot converge",0,1)
 
74
         return 
 
75
      end if
 
76
 
 
77
      if (n.lt.l) then
 
78
 
 
79
      !*** starting point n=l or b=a+1***
 
80
         a = n + 0.5d0
 
81
         b = n + 1.5d0
 
82
 
 
83
      !*** m1 = M(a,b-1) ***
 
84
      !*** m2 = M(a,b,z) ***
 
85
         m1 = dexp(z)
 
86
         nwpw_SpecialKummer = util_gammp(a,(-z))*a/(-z)**a*util_gamma(a)
 
87
 
 
88
      !**********************************************
 
89
      ! using recursion formula
 
90
      ! z(a-b)M(a,b+1,z)=b(b-1)M(a,b-1,z)+b(1-b-z)M(a,b,z)
 
91
      ! obtain M(1/2,3/2+l  ,z) --> m2
 
92
      !        M(1/2,3/2+l-1,z) --> m2
 
93
      !**********************************************
 
94
         do i=1,l-n
 
95
            m3=(b*(b-1.0d0)*m1+b*(1.0d0-b-z)*nwpw_SpecialKummer)
 
96
     >         /(z*(a-b))
 
97
            b = b + 1
 
98
            m1 = nwpw_SpecialKummer
 
99
            nwpw_SpecialKummer = m3
 
100
         end do
 
101
 
 
102
      else if (n.gt.(l+1)) then
 
103
 
 
104
      !*** starting point n=l+1 or b=a ***
 
105
         a = l + 1.5d0
 
106
         b = l + 1.5d0
 
107
 
 
108
      !*** m1 = M(a-1,b) ***
 
109
      !*** m2 = M(a,a,z) ***
 
110
         m1 = util_gammp(a-1.0d0,(-z))*(a-1.0d0)/(-z)**(a-1.0d0)*
 
111
     >      util_gamma(a-1.0d0)
 
112
         nwpw_SpecialKummer = dexp(z)
 
113
 
 
114
      !**********************************************
 
115
      ! using recursion formula
 
116
      ! aM(a+1,b,z)=(b-a)M(a-1,b,z)+(2a-b+z)M(a,b,z)
 
117
      ! obtain M(n+1/2-1,3/2,z)   --> m1
 
118
      !        M(n+1/2  ,3/2,z)   --> m2
 
119
      !**********************************************
 
120
         do i=1,n-l-1
 
121
            m3 = ((b-a)*m1+(2*a-b+z)*nwpw_SpecialKummer)/a
 
122
            m1 = nwpw_SpecialKummer
 
123
            nwpw_SpecialKummer = m3
 
124
            a = a + 1
 
125
         end do
 
126
      end if
 
127
 
 
128
      return
 
129
      end