← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/nwpw/nwpwlib/utilities/nwpw_gaunt.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
http://bugs.debian.org/632611
https://launchpad.net/bugs/791308
* 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:
src/nwpw/nwpwlib/utilities/nwpw_gaunt.F
1
 
*     ***************************
2
 
*     *                         *
3
 
*     *   nwpw_factorial_init   *
4
 
*     *                         *
5
 
*     ***************************
6
 
 
7
 
      subroutine nwpw_factorial_init()
8
 
      implicit none
9
 
 
10
 
 
11
 
*     **** Factorial common block ****
12
 
      integer FMAX
13
 
      parameter (FMAX=30)
14
 
      real*8 factorial(0:FMAX)
15
 
      common / FACTORIAL_Block / factorial
16
 
 
17
 
*     **** local variables ****
18
 
      integer n
19
 
      real*8  x
20
 
 
21
 
 
22
 
      factorial(0) = 1.0d0
23
 
      do n=1,FMAX
24
 
         x = dble(n)
25
 
         factorial(n) = x*factorial(n-1)
26
 
      end do
27
 
 
28
 
      return
29
 
      end
30
 
 
31
 
*     ***************************
32
 
*     *                         *
33
 
*     *      nwpw_clebsch       *
34
 
*     *                         *
35
 
*     ***************************
36
 
*
37
 
* Computes the Clebsch-Gordon coefficients using Racah's formula.
38
 
*
39
 
 
40
 
      real*8 function nwpw_clebsch(l1,l2,l,m1,m2,m)
41
 
      implicit none
42
 
      integer l1,l2,l
43
 
      integer m1,m2,m
44
 
 
45
 
 
46
 
*     **** Factorial common block ****
47
 
      integer FMAX
48
 
      parameter (FMAX=30)
49
 
      real*8 factorial(0:FMAX)
50
 
      common / FACTORIAL_Block / factorial
51
 
 
52
 
*     **** local variables ****
53
 
      integer z,zmin,zmax
54
 
      real*8 tmp1,tmp2,sign
55
 
 
56
 
*     **************************************
57
 
*     **** check the triangle condition ****
58
 
*     **************************************
59
 
 
60
 
*     *** a zero Clebsch-Gordon coefficient ***
61
 
      if ( ((m1+m2).ne.m)      .OR.
62
 
     >     (abs(m1).gt.abs(l1)).OR.
63
 
     >     (abs(m2).gt.abs(l2)).OR.
64
 
     >     (abs(m) .gt.abs(l) ).OR.
65
 
     >     (l.gt.(l1+l2))      .OR.
66
 
     >     (l.lt.abs(l1-l2))   .OR.
67
 
     >     (mod((l1+l2+l),2).ne. 0) ) then
68
 
         tmp2 = 0.0d0
69
 
 
70
 
*     *** a non-zero Clebsch-Gordon coeffient ****
71
 
      else
72
 
         zmin = 0
73
 
         if ((l-l2+m1)     .lt.0) zmin = -l + l2 - m1
74
 
         if ((l-l1-m2+zmin).lt.0) zmin = -l + l1 + m2
75
 
         zmax = l1+l2-l
76
 
         if ((l2+m2-zmax).lt.0) zmax = l2 + m2
77
 
         if ((l1-m1-zmax).lt.0) zmax = l1 - m1
78
 
 
79
 
         tmp1 = 0.0d0
80
 
         do z=zmin,zmax
81
 
            sign = 1.0d0
82
 
            if (mod(z,2).ne.0) sign = -1.0d0
83
 
            tmp1 = tmp1 
84
 
     >           + sign
85
 
     >             / ( factorial(  (z)        )
86
 
     >               * factorial( (l1+l2-l-z) )
87
 
     >               * factorial( (l1-m1-z)   )
88
 
     >               * factorial( (l2+m2-z)   )
89
 
     >               * factorial( (l-l2+m1+z) )
90
 
     >               * factorial( (l-l1-m2+z) ))
91
 
         end do
92
 
         tmp2 = dsqrt( dble(2*l+1) * factorial( (l1+l2-l)   )
93
 
     >                           * factorial( (l1-l2+l)   )
94
 
     >                           * factorial( (-l1+l2+l)  )
95
 
     >                           * factorial( (l1+m1)     )
96
 
     >                           * factorial( (l1-m1)     )
97
 
     >                           * factorial( (l2+m2)     )
98
 
     >                           * factorial( (l2-m2)     )
99
 
     >                           * factorial( (l+m)       )
100
 
     >                           * factorial( (l-m)       )
101
 
     >                           / factorial( (l1+l2+l+1) )
102
 
     >               )*tmp1
103
 
      end if
104
 
 
105
 
      nwpw_clebsch = tmp2
106
 
      return
107
 
      end
108
 
 
109
 
 
110
 
 
111
 
*     ***************************
112
 
*     *                         *
113
 
*     *      nwpw_Gaunt         *
114
 
*     *                         *
115
 
*     ***************************
116
 
*
117
 
* Computes the Gaunt coefficient
118
 
*
119
 
*  Gaunt(l,m,l1,m1,l2,m2) =
120
 
 
121
 
*      /2pi  / pi
122
 
*     |     |
123
 
*   = |     | dconjg(Y_lm(theta,phi)) * Y_l1m1(theta,phi) * dconjg(Y_l2m2(theta,phi))  sin(theta) dtheta dphi
124
 
*     |     |
125
 
*    /0    / 0
126
 
*
127
 
*      /2pi  / pi
128
 
*     |     |
129
 
*   = |     | Y_lm(theta,phi) * dconjg(Y_l1m1(theta,phi)) * Y_l2m2(theta,phi)  sin(theta) dtheta dphi
130
 
*     |     |
131
 
*    /0    / 0
132
 
*
133
 
*
134
 
*   = sqrt( (2*l+1)*(2*l2+1)/(4*pi*(2*l1+1)) ) * Clebsch(l l2 l1; m m2 m1) * Clebsch(l l2 l1; 0 0 0)
135
 
*
136
 
*
137
 
 
138
 
      real*8 function nwpw_Gaunt(l,m,l1,m1,l2,m2)
139
 
      implicit none
140
 
      integer l,m
141
 
      integer l1,m1
142
 
      integer l2,m2
143
 
 
144
 
*     **** local variables ****
145
 
      real*8 coeff,fourpi
146
 
      real*8 tmp
147
 
   
148
 
*     **** external functions ***
149
 
      real*8   Clebsch
150
 
      external Clebsch
151
 
 
152
 
 
153
 
*     *** a zero Gaunt coefficient ***
154
 
      if ( ((m+m2).ne.m1)      .OR.
155
 
     >     (abs(m1).gt.abs(l1)).OR.
156
 
     >     (abs(m2).gt.abs(l2)).OR.
157
 
     >     (abs(m) .gt.abs(l) ).OR.
158
 
     >     (l1.gt.(l+l2))      .OR.
159
 
     >     (l1.lt.abs(l-l2))   .OR.
160
 
     >     (mod((l1+l2+l),2).ne. 0 )) then
161
 
         tmp = 0.0d0
162
 
 
163
 
*     *** a non-zero Gaunt Coefficient ***
164
 
      else
165
 
 
166
 
         fourpi = 16.0d0*datan(1.0d0)
167
 
         coeff  = dsqrt( dble((2*l+1)*(2*l2+1))/(fourpi*dble(2*l1+1)))
168
 
         tmp    = coeff*Clebsch(l,l2,l1, m,m2,m1)
169
 
     >                 *Clebsch(l,l2,l1, 0,0, 0)
170
 
      end if
171
 
 
172
 
      nwpw_Gaunt = tmp
173
 
      return
174
 
      end
175
 
 
176
 
 
177
 
*     ***************************
178
 
*     *                         *
179
 
*     *      nwpw_Taunt         *
180
 
*     *                         *
181
 
*     ***************************
182
 
*
183
 
* Computes the Taunt coefficient
184
 
*
185
 
*  Taunt(l,m,l1,m1,l2,m2) =
186
 
 
187
 
*      /2pi  / pi
188
 
*     |     |
189
 
*   = |     | T_lm(theta,phi)) * T_l1m1(theta,phi) * T_l2m2(theta,phi))  sin(theta) dtheta dphi
190
 
*     |     |
191
 
*    /0    / 0
192
 
*
193
 
*
194
 
*   = sqrt( (2*l+1)*(2*l2+1)/(2*pi*(2*l1+1)) ) * Clebsch(l l2 l1; m m2 m1) * Clebsch(l l2 l1; 0 0 0)
195
 
*
196
 
*
197
 
 
198
 
      real*8 function nwpw_Taunt(l,m,l1,m1,l2,m2)
199
 
      implicit none
200
 
      integer l,m
201
 
      integer l1,m1
202
 
      integer l2,m2
203
 
 
204
 
*     **** local variables ****
205
 
      real*8 coeff,twopi
206
 
      real*8 tmp
207
 
   
208
 
*     **** external functions ***
209
 
      real*8   Clebsch
210
 
      external Clebsch
211
 
 
212
 
 
213
 
*     *** a zero Taunt coefficient ***
214
 
      if ( ((m+m2).ne.m1)      .OR.
215
 
     >     (abs(m1).gt.abs(l1)).OR.
216
 
     >     (abs(m2).gt.abs(l2)).OR.
217
 
     >     (abs(m) .gt.abs(l) ).OR.
218
 
     >     (l1.gt.(l+l2))      .OR.
219
 
     >     (l1.lt.abs(l-l2))   .OR.
220
 
     >     (mod((l1+l2+l),2).ne. 0 )) then
221
 
         tmp = 0.0d0
222
 
 
223
 
*     *** a non-zero Taunt Coefficient ***
224
 
      else
225
 
 
226
 
         twopi  = 8.0d0*datan(1.0d0)
227
 
         coeff  = dsqrt( dble((2*l+1)*(2*l2+1))/(twopi*dble(2*l1+1)))
228
 
         tmp    = coeff*Clebsch(l,l2,l1, m,m2,m1)
229
 
     >                 *Clebsch(l,l2,l1, 0,0, 0)
230
 
      end if
231
 
 
232
 
      nwpw_Taunt = tmp
233
 
      return
234
 
      end
235