← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/nwpw/band/kbpp/integrate_kbpp_e_band_nonlocal_new.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/band/kbpp/integrate_kbpp_e_band_nonlocal_new.F
 
1
*
 
2
* $Id: integrate_kbpp_e_band_nonlocal_new.F 22503 2012-05-20 06:58:57Z d3y133 $
 
3
*
 
4
      subroutine integrate_kbpp_e_band_nonlocal_new(version,kvec,
 
5
     >                            nrho,drho,lmax,locp,nmax,
 
6
     >                            n_extra,n_expansion,zv,
 
7
     >                            vp,wp,rho,f,cs,sn,
 
8
     >                            nfft1,nfft2,nfft3,nprj,
 
9
     >                            G,vnl,
 
10
     >                            nray,G_ray,vnl_ray,
 
11
     >                            ierr)
 
12
      implicit none
 
13
      integer          version
 
14
      double precision kvec(3)
 
15
      integer          nrho
 
16
      double precision drho
 
17
      integer          lmax
 
18
      integer          locp
 
19
      integer          nmax
 
20
      integer          n_extra,n_expansion(0:lmax)
 
21
      double precision zv
 
22
      double precision vp(nrho,0:lmax)
 
23
      double precision wp(nrho,0:(lmax+n_extra))
 
24
      double precision rho(nrho)
 
25
      double precision f(nrho)
 
26
      double precision cs(nrho)
 
27
      double precision sn(nrho)
 
28
 
 
29
      integer nfft1,nfft2,nfft3,nprj
 
30
      double precision G(nfft1,nfft2,nfft3,3)
 
31
      double precision vnl(nfft1,nfft2,nfft3,nprj)
 
32
 
 
33
      integer nray
 
34
      double precision G_ray(nray)
 
35
      double precision vnl_ray(nray,0:(lmax+n_extra),2)
 
36
 
 
37
      integer ierr
 
38
 
 
39
*     *** local variables ****
 
40
      integer np,taskid,MASTER
 
41
      parameter (MASTER=0)
 
42
 
 
43
      integer lcount,task_count,nfft3d
 
44
      integer k1,k2,k3,i,l,nx,n,nb
 
45
      double precision p
 
46
      double precision gx,gy,gz,q,d,dG
 
47
      integer indx(5,0:3)
 
48
 
 
49
*     **** external functions ****
 
50
      double precision dsum,simp,nwpw_splint
 
51
      external         dsum,simp,nwpw_splint
 
52
 
 
53
*     **** set up indx(n,l) --> to wp ****
 
54
      nb = lmax+1
 
55
      do l=0,lmax
 
56
         indx(1,l) = l
 
57
         do n=2,n_expansion(l)
 
58
            indx(n,l) = nb
 
59
            nb = nb+1
 
60
         end do
 
61
      end do
 
62
 
 
63
      call Parallel_np(np)
 
64
      call Parallel_taskid(taskid)
 
65
 
 
66
      nfft3d = (nfft1)*nfft2*nfft3
 
67
 
 
68
      if (lmax.GT.3) then
 
69
        write(*,*)"non-local psp not generated: lmax exceeds 3"
 
70
        ierr=1
 
71
        return
 
72
      end if
 
73
      if ((nrho/2)*2.EQ.nrho) then
 
74
        write(*,*)"non-local psp not generated: nrho is not odd"
 
75
        ierr=2
 
76
        return
 
77
      end if
 
78
 
 
79
*======================  Fourier transformation  ======================
 
80
      dG = G_ray(3)-G_ray(2)
 
81
      call dcopy(nprj*nfft3d,0.0d0,0,vnl,1)
 
82
      task_count = -1
 
83
      DO 700 k3=1,nfft3
 
84
      DO 700 k2=1,nfft2
 
85
      DO 700 k1=1,nfft1
 
86
        task_count = task_count + 1
 
87
        if (mod(task_count,np).ne.taskid) go to 700
 
88
        gx=G(k1,k2,k3,1)+kvec(1)
 
89
        gy=G(k1,k2,k3,2)+kvec(2)
 
90
        gz=G(k1,k2,k3,3)+kvec(3)
 
91
 
 
92
        Q  =DSQRT(gx**2 + gy**2 + gz**2)
 
93
        nx = (Q/dG) + 1.0d0
 
94
 
 
95
        if (dabs(Q).gt.1.0d-9) then
 
96
 
 
97
           gx=gx/Q
 
98
           gy=gy/Q
 
99
           gz=gz/Q
 
100
           do i=1,nrho
 
101
             cs(i)=DCOS(Q*rho(i))
 
102
             sn(i)=DSIN(Q*rho(i))
 
103
           end do
 
104
 
 
105
           lcount = nprj+1
 
106
           GO TO (500,400,300,200), lmax+1
 
107
 
 
108
*::::::::::::::::::::::::::::::  f-wave  ::::::::::::::::::::::::::::::
 
109
  200      CONTINUE
 
110
           if (locp.ne.3) then
 
111
              do n=1,n_expansion(3)
 
112
                 D = nwpw_splint(G_ray,vnl_ray(1,indx(n,3),1),
 
113
     >                           vnl_ray(1,indx(n,3),2),nray,nx,Q)
 
114
                 lcount = lcount-1
 
115
                 vnl(k1,k2,k3,lcount)=D*GX*(4.0d0*GX*GX
 
116
     >                                     -3.0d0*(1.0d0-GZ*GZ))
 
117
     >                             /dsqrt(24.0d0)
 
118
                 lcount = lcount-1
 
119
                 vnl(k1,k2,k3,lcount)=D*GY*(3.0d0*(1.0d0-GZ*GZ)
 
120
     >                                     -4.0d0*GY*GY)
 
121
     >                             /dsqrt(24.0d0)
 
122
                 lcount = lcount-1
 
123
                 vnl(k1,k2,k3,lcount)=D*GZ*(GX*GX - GY*GY)
 
124
     >                             /2.0d0
 
125
                 lcount = lcount-1
 
126
                 vnl(k1,k2,k3,lcount)=D*GX*GY*GZ
 
127
                 lcount = lcount-1
 
128
                 vnl(k1,k2,k3,lcount)=D*GX*(5.0d0*GZ*GZ-1.0d0)
 
129
     >                             /dsqrt(40.0d0)
 
130
                 lcount = lcount-1
 
131
                 vnl(k1,k2,k3,lcount)=D*GY*(5.0d0*GZ*GZ-1.0d0)
 
132
     >                             /dsqrt(40.0d0)
 
133
                 lcount = lcount-1
 
134
                 vnl(k1,k2,k3,lcount)=D*GZ*(5.0d0*GZ*GZ-3.0d0)
 
135
     >                             /dsqrt(60.0d0)
 
136
              end do
 
137
           end if
 
138
*::::::::::::::::::::::::::::::  d-wave  ::::::::::::::::::::::::::::::
 
139
  300      CONTINUE
 
140
           if (locp.ne.2) then
 
141
              do n=1,n_expansion(2)
 
142
                 D = nwpw_splint(G_ray,vnl_ray(1,indx(n,2),1),
 
143
     >                           vnl_ray(1,indx(n,2),2),nray,nx,Q)
 
144
                 lcount = lcount-1
 
145
                 vnl(k1,k2,k3,lcount)=D*(2.0d0*GZ*GZ-GX*GX-GY*GY)
 
146
     >                          /(2.0d0*dsqrt(3.0d0))
 
147
                 lcount = lcount-1
 
148
                 vnl(k1,k2,k3,lcount)=D*GX*GY
 
149
                 lcount = lcount-1
 
150
                 vnl(k1,k2,k3,lcount)=D*GY*GZ
 
151
                 lcount = lcount-1
 
152
                 vnl(k1,k2,k3,lcount)=D*GZ*GX
 
153
                 lcount = lcount-1
 
154
                 vnl(k1,k2,k3,lcount)=D*(GX*GX-GY*GY)/(2.0d0)
 
155
              end do
 
156
           end if
 
157
*::::::::::::::::::::::::::::::  p-wave  ::::::::::::::::::::::::::::::
 
158
  400      CONTINUE
 
159
           if (locp.ne.1) then
 
160
             do n=1,n_expansion(1)
 
161
                P = nwpw_splint(G_ray,vnl_ray(1,indx(n,1),1),
 
162
     >                                vnl_ray(1,indx(n,1),2),nray,nx,Q)
 
163
                lcount = lcount-1
 
164
                vnl(k1,k2,k3,lcount)=P*GX
 
165
                lcount = lcount-1
 
166
                vnl(k1,k2,k3,lcount)=P*GY
 
167
                lcount = lcount-1
 
168
                vnl(k1,k2,k3,lcount)=P*GZ
 
169
             end do
 
170
           end if
 
171
*::::::::::::::::::::::::::::::  s-wave  :::::::::::::::::::::::::::::::
 
172
  500      CONTINUE
 
173
           if (locp.ne.0) then
 
174
             do n=1,n_expansion(0)
 
175
                lcount = lcount-1
 
176
                vnl(k1,k2,k3,lcount)= nwpw_splint(G_ray,
 
177
     >                                       vnl_ray(1,indx(n,0),1),
 
178
     >                                       vnl_ray(1,indx(n,0),2),
 
179
     >                                       nray,nx,Q)
 
180
             end do
 
181
           end if
 
182
 
 
183
  600      CONTINUE
 
184
 
 
185
*:::::::::::::::::::::::::::::::  G+k=0  ::::::::::::::::::::::::::::::::      
 
186
      else
 
187
 
 
188
         do l=1,nprj
 
189
           vnl(k1,k2,k3,l)=0.0d0
 
190
         end do
 
191
*        *** only j0 is non-zero at zero ****
 
192
         if (locp.ne.0) then
 
193
            do n=1,n_expansion(0)
 
194
               vnl(k1,k2,k3,n_expansion(0)-n+1)=vnl_ray(1,indx(n,0),1)
 
195
            end do
 
196
         end if
 
197
 
 
198
      end if
 
199
 
 
200
    
 
201
  700 CONTINUE
 
202
 
 
203
      call Parallel_Vector_SumAll(nprj*nfft3d,vnl)
 
204
 
 
205
 
 
206
      ierr=0
 
207
      return
 
208
      end
 
209
 
 
210
 
 
211