1
2! Copyright (C) 2009 J. K. Dewhurst, S. Sharma and E. K. U. Gross.
3! This file is distributed under the terms of the GNU General Public License.
4! See the file COPYING for license details.
5
6!BOP
7! !ROUTINE: ggair_1
8! !INTERFACE:
9subroutine ggair_1(rho,grho,g2rho,g3rho)
10! !USES:
11use modmain
12! !DESCRIPTION:
13!   Spin-unpolarised version of {\tt ggair\_sp\_1}.
14!
15! !REVISION HISTORY:
16!   Created November 2009 (JKD)
17!EOP
18!BOC
19implicit none
20! arguments
21real(8), intent(in) :: rho(ngtot)
22real(8), intent(out) :: grho(ngtot),g2rho(ngtot),g3rho(ngtot)
23! local variables
24integer i,ig,ifg
25! allocatable arrays
26real(8), allocatable :: gvrho(:,:)
27complex(8), allocatable :: zfft1(:),zfft2(:)
28allocate(gvrho(ngtot,3))
29allocate(zfft1(ngtot),zfft2(ngtot))
30zfft1(:)=rho(:)
31call zfftifc(3,ngridg,-1,zfft1)
32! |grad rho|
33do i=1,3
34  zfft2(:)=0.d0
35  do ig=1,ngvec
36    ifg=igfft(ig)
37    zfft2(ifg)=vgc(i,ig)*cmplx(-aimag(zfft1(ifg)),dble(zfft1(ifg)),8)
38  end do
39  call zfftifc(3,ngridg,1,zfft2)
40  gvrho(:,i)=dble(zfft2(:))
41end do
42grho(:)=sqrt(gvrho(:,1)**2+gvrho(:,2)**2+gvrho(:,3)**2)
43! grad^2 rho
44zfft2(:)=0.d0
45do ig=1,ngvec
46  ifg=igfft(ig)
47  zfft2(ifg)=-(gc(ig)**2)*zfft1(ifg)
48end do
49call zfftifc(3,ngridg,1,zfft2)
50g2rho(:)=dble(zfft2(:))
51! (grad rho).(grad |grad rho|)
52zfft1(:)=grho(:)
53call zfftifc(3,ngridg,-1,zfft1)
54g3rho(:)=0.d0
55do i=1,3
56  zfft2(:)=0.d0
57  do ig=1,ngvec
58    ifg=igfft(ig)
59    zfft2(ifg)=vgc(i,ig)*cmplx(-aimag(zfft1(ifg)),dble(zfft1(ifg)),8)
60  end do
61  call zfftifc(3,ngridg,1,zfft2)
62  g3rho(:)=g3rho(:)+gvrho(:,i)*dble(zfft2(:))
63end do
64deallocate(gvrho,zfft1,zfft2)
65end subroutine
66!EOC
67
68