← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/nwpw/pspw/kbpp/integrate_e_stress_ray.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/pspw/kbpp/integrate_e_stress_ray.F
 
1
*
 
2
* $Id: integrate_e_stress_ray.F 22503 2012-05-20 06:58:57Z d3y133 $
 
3
*
 
4
 
 
5
*     ************************************
 
6
*     *                                  *
 
7
*     *        integrate_e_stress_ray    *
 
8
*     *                                  *
 
9
*     ************************************
 
10
 
 
11
      subroutine integrate_e_stress_ray(version,rlocal,
 
12
     >                            nrho,drho,lmax,locp,nmax,
 
13
     >                            n_extra,n_expansion,zv,
 
14
     >                            vp,wp,rho,f,cs,sn,
 
15
     >                            nray,G_ray,dvl_ray,dvnl_ray,
 
16
     >                            semicore,rho_sc_r,rho_sc_k_ray,
 
17
     >                            ierr)
 
18
      implicit none
 
19
      integer          version
 
20
      double precision rlocal
 
21
      integer          nrho
 
22
      double precision drho
 
23
      integer          lmax
 
24
      integer          locp
 
25
      integer          nmax
 
26
      integer          n_extra,n_expansion(0:lmax)
 
27
      double precision zv
 
28
      double precision vp(nrho,0:lmax)
 
29
      double precision wp(nrho,0:(lmax+n_extra))
 
30
      double precision rho(nrho)
 
31
      double precision f(nrho)
 
32
      double precision cs(nrho)
 
33
      double precision sn(nrho)
 
34
 
 
35
      integer nray
 
36
      double precision G_ray(nray)
 
37
      double precision dvl_ray(nray)
 
38
      double precision dvnl_ray(nray,2,0:(lmax+n_extra))
 
39
 
 
40
      logical semicore
 
41
      double precision rho_sc_r(nrho,2)
 
42
      double precision rho_sc_k_ray(nray)
 
43
      integer ierr
 
44
 
 
45
#include "errquit.fh"
 
46
 
 
47
*     *** local variables ****
 
48
      integer np,taskid,MASTER
 
49
      parameter (MASTER=0)
 
50
 
 
51
      integer task_count
 
52
      integer k1,i,l,n,nb
 
53
      double precision pi,twopi,forpi
 
54
      double precision p0,p1,p2,p3
 
55
      double precision a,q
 
56
      integer indx(5,0:3)
 
57
 
 
58
 
 
59
*     **** external functions ****
 
60
      double precision dsum,simp,util_erf
 
61
      external         dsum,simp,util_erf
 
62
 
 
63
*     **** set up indx(n,l) --> to wp ****
 
64
      nb = lmax+1
 
65
      do l=0,lmax
 
66
         indx(1,l) = l
 
67
         do n=2,n_expansion(l)
 
68
            indx(n,l) = nb
 
69
            nb = nb+1
 
70
         end do
 
71
      end do
 
72
 
 
73
      call Parallel_np(np)
 
74
      call Parallel_taskid(taskid)
 
75
 
 
76
      if (version.ne.3) then
 
77
         call errquit('integrate_stress_ray - unit cell is aperiodic',0,
 
78
     >       INPUT_ERR)
 
79
        ierr=1
 
80
        return
 
81
      end if
 
82
      if (lmax.gt.3) THEN
 
83
         call errquit('integrate_stress_ray - lmax > f',0,
 
84
     >       INPUT_ERR)
 
85
        ierr=1
 
86
        return
 
87
      end if
 
88
      if ((nrho/2)*2.eq.nrho) then
 
89
        call errquit('integrate_stress_ray - psp grid not odd',0,
 
90
     >       INPUT_ERR)
 
91
        ierr=2
 
92
        return
 
93
      end if
 
94
 
 
95
      pi=4.0d0*datan(1.0d0)
 
96
      twopi=2.0d0*pi
 
97
      forpi=4.0d0*pi
 
98
      p0=dsqrt(forpi)
 
99
      p1=dsqrt(3.0d0*forpi)
 
100
      p2=dsqrt(15.0d0*forpi)
 
101
      p3=dsqrt(105.0d0*forpi)
 
102
 
 
103
*======================  Fourier transformation  ======================
 
104
      call dcopy(nray,0.0d0,0,dvl_ray,1)
 
105
      call dcopy(2*(lmax+1+n_extra)*nray,0.0d0,0,dvnl_ray,1)
 
106
      call dcopy(nray,0.0d0,0,rho_sc_k_ray,1)
 
107
      task_count = -1
 
108
      DO 700 k1=2,nray
 
109
        task_count = task_count + 1
 
110
        if (mod(task_count,np).ne.taskid) go to 700
 
111
 
 
112
        q=G_ray(k1)
 
113
        
 
114
        do i=1,nrho
 
115
          cs(i)=dcos(q*rho(i))
 
116
          sn(i)=dsin(q*rho(i))
 
117
        end do
 
118
 
 
119
        GO TO (500,400,300,200), lmax+1
 
120
 
 
121
*::::::::::::::::::::::::::::::  f-wave  ::::::::::::::::::::::::::::::
 
122
  200   CONTINUE
 
123
        if (locp.ne.3) then
 
124
           do n=1,n_expansion(3)
 
125
           F(1)=0.0d0
 
126
           do i=2,nrho
 
127
             A=sn(i)/(q*rho(i))
 
128
             A=15.0d0*(A-cs(i))/(q*rho(i))**2 - 6*A + cs(i)
 
129
             f(i)=A*wp(i,indx(n,3))*vp(i,3)
 
130
           end do
 
131
           dvnl_ray(k1,1,indx(n,3))=p3*SIMP(nrho,F,drho)/q
 
132
 
 
133
           F(1)=0.0d0
 
134
           do i=2,nrho
 
135
             A= -60.0d0*sn(i)/(rho(i)**3 * q**5)
 
136
     >        +  60.0d0*cs(i)/(rho(i)**2 * q**4)
 
137
     >        +  27.0d0*sn(i)/(rho(i)    * q**3)
 
138
     >        -   7.0d0*cs(i)/(q**2)
 
139
     >        -   rho(i)*sn(i)/q
 
140
             f(i)=A*wp(i,indx(n,3))*vp(i,3)
 
141
           end do
 
142
           dvnl_ray(k1,2,indx(n,3))=p3*SIMP(nrho,F,drho)
 
143
           end do
 
144
        end if
 
145
*::::::::::::::::::::::::::::::  d-wave  ::::::::::::::::::::::::::::::
 
146
  300   CONTINUE
 
147
        if (locp.ne.2) then
 
148
          do n=1,n_expansion(2)
 
149
          F(1)=0.0d0
 
150
          DO i=2,nrho
 
151
            A=3.0d0*(sn(i)/(q*rho(i))-cs(i))/(q*rho(i))-sn(i)
 
152
            f(i)=A*wp(i,indx(n,2))*vp(i,2)
 
153
          END DO
 
154
          dvnl_ray(k1,1,indx(n,2))=p2*SIMP(nrho,F,drho)/q
 
155
 
 
156
          F(1)=0.0d0
 
157
          DO i=2,nrho
 
158
            A= -9.0d0*sn(i)/(rho(i)**2 * q**4)
 
159
     >       +  9.0d0*cs(i)/(rho(i)    * q**3)
 
160
     >       +  4.0d0*sn(i)/(q**2)
 
161
     >       -  rho(i)*cs(i)/q
 
162
            f(i)=A*wp(i,indx(n,2))*vp(i,2)
 
163
          END DO
 
164
          dvnl_ray(k1,2,indx(n,2))=p2*SIMP(nrho,F,drho)
 
165
          end do
 
166
        end if
 
167
*::::::::::::::::::::::::::::::  p-wave  ::::::::::::::::::::::::::::::
 
168
  400   CONTINUE
 
169
        if (locp.ne.1) then
 
170
           do n=1,n_expansion(1)
 
171
           F(1)=0.0d0
 
172
           DO i=2,nrho
 
173
             f(i)=(sn(i)/(q*rho(i)) - cs(i)) * wp(i,indx(n,1))*vp(i,1)
 
174
           END DO
 
175
           dvnl_ray(k1,1,indx(n,1))=p1*SIMP(nrho,F,drho)/q
 
176
 
 
177
           F(1)=0.0d0
 
178
           DO i=2,nrho
 
179
             f(i)=wp(i,indx(n,1))*vp(i,1)* ( -2.0d0*sn(i)/(rho(i)* q**3)
 
180
     >                              + 2.0d0*cs(i)/(q**2)
 
181
     >                              + rho(i)*sn(i)/q)
 
182
           END DO
 
183
           dvnl_ray(k1,2,indx(n,1))=p1*SIMP(nrho,F,drho)
 
184
           end do
 
185
        end if
 
186
*::::::::::::::::::::::::::::::  s-wave  :::::::::::::::::::::::::::::::
 
187
  500   CONTINUE
 
188
        if (locp.ne.0) then
 
189
          do n=1,n_expansion(0)
 
190
          DO i=1,nrho
 
191
            f(i)=wp(i,indx(n,0))*vp(i,0) * ( -sn(i)/(q**2) 
 
192
     >                              + rho(i)*cs(i)/q)
 
193
          END DO
 
194
          dvnl_ray(k1,1,indx(n,0)) = p0*SIMP(nrho,F,drho)
 
195
          end do
 
196
        end if
 
197
*::::::::::::::::::::::::::::::  local  :::::::::::::::::::::::::::::::
 
198
  600   CONTINUE
 
199
 
 
200
        do  i=1,nrho
 
201
          f(i)=rho(i)*vp(i,locp)*(rho(i)*cs(i)-sn(i)/q)
 
202
        end do
 
203
        dvl_ray(k1)= SIMP(nrho,f,drho)*forpi/q
 
204
     >   + zv*forpi/(q*q)*(2.0d0*cs(nrho)/q + rho(nrho)*sn(nrho))
 
205
*::::::::::::::::::::: semicore density :::::::::::::::::::::::::::::::
 
206
        if (semicore) then
 
207
           do  i=1,nrho
 
208
             f(i)=rho(i)*dsqrt(rho_sc_r(i,1))*(rho(i)*cs(i)-sn(i)/q)
 
209
           end do
 
210
           rho_sc_k_ray(k1)= SIMP(nrho,f,drho)*forpi/q
 
211
        end if
 
212
    
 
213
  700 CONTINUE
 
214
 
 
215
      call Parallel_Vector_SumAll(nray,rho_sc_k_ray)
 
216
      call Parallel_Vector_SumAll(nray,dvl_ray)
 
217
      call Parallel_Vector_Sumall(2*(lmax+1+n_extra)*nray,dvnl_ray)
 
218
 
 
219
*:::::::::::::::::::::::::::::::  G=0  ::::::::::::::::::::::::::::::::      
 
220
      dvl_ray(1)      = 0.0d0
 
221
      rho_sc_k_ray(1) = 0.0d0
 
222
      do l=0,lmax
 
223
        do n=1,n_expansion(l)
 
224
           dvnl_ray(1,1,indx(n,l))=0.0d0
 
225
           dvnl_ray(1,2,indx(n,l))=0.0d0
 
226
        end do
 
227
      end do
 
228
 
 
229
      ierr=0
 
230
      return
 
231
      end
 
232
 
 
233
 
 
234