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