Commit bf4bfe22 authored by giannozz's avatar giannozz

General cleanup of intrinsic functions:

conversion to real    => DBLE
(including real part of a complex number)
conversion to complex => CMPLX
complex conjugate     => CONJG
imaginary part        => AIMAG

All functions are uppercase.
CMPLX is preprocessed by f_defs.h and performs an explicit cast:
#define CMPLX(a,b)  cmplx(a,b,kind=DP)
This implies that 1) f_defs.h must be included whenever a CMPLX is present,
2) CMPLX should stay in a single line, 3) DP must be defined.

All occurrences of real, float, dreal, dfloat, dconjg, dimag, dcmplx
removed - please do not reintroduce any of them.
Tested only with ifc7 and g95 - beware unintended side effects

Maybe not the best solution (explicit casts everywhere would be better)
but it can be easily changed with a script if the need arises.
The following code might be used to test for possible trouble:

program test_intrinsic

  implicit none
  integer, parameter :: dp = selected_real_kind(14,200)
  real (kind=dp) :: a = 0.123456789012345_dp
  real (kind=dp) :: b = 0.987654321098765_dp
  complex (kind=dp) :: c = ( 0.123456789012345_dp, 0.987654321098765_dp)

  print *, '      A = ', a
  print *, ' DBLE(A)= ', DBLE(a)
  print *, '      C = ', c
  print *, 'CONJG(C)= ', CONJG(c)
  print *, 'DBLE(c),AIMAG(C)  = ', DBLE(c), AIMAG(c)
  print *, 'CMPLX(A,B,kind=dp)= ', CMPLX( a, b, kind=dp)

end program test_intrinsic

Note that CMPLX and REAL without a cast yield single precision numbers on
ifc7 and g95 !!!


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2133 c92efa57-630b-4861-b058-cf58834340f0
parent 8bad2898
......@@ -58,7 +58,7 @@
! end of declarations
! ----------------------------------------------
! qtot=dfloat(nel)
! qtot=DBLE(nel)
sumq=0.d0
sume=0.d0
emin=e(1,1,1)
......@@ -174,7 +174,7 @@
integer iter,ie
real(dbl) t,emin,emax,stepf
real(dbl) sumq,fac,qtot,drange
QTOT=DFLOAT(NEL)
QTOT=DBLE(NEL)
SUMQ=0.D0
SUME=0.D0
EMIN=E(1)
......
......@@ -70,7 +70,7 @@ subroutine berryion( tau0,fion, tfor,ipol,evalue,enbi)
enddo
enddo
enbi=aimag(log(exp(temp)))/gmes!this sounds stupid it's just a Riemann plane
enbi=AIMAG(log(exp(temp)))/gmes!this sounds stupid it's just a Riemann plane
! write(6,*) 'Pola :', pola!ATTENZIONE
return
end subroutine berryion
......
......@@ -99,10 +99,10 @@ subroutine bforceion(fion,tfor,ipol,qmatinv,bec0,becdr,gqq,evalue)
enddo
isa = isa + 1
fion(ipol,isa) = fion(ipol,isa) - 2.*evalue*aimag(temp)/gmes
fion(1,isa) = fion(1,isa) - 2.*evalue*aimag(temp1)/gmes
fion(2,isa) = fion(2,isa) - 2.*evalue*aimag(temp2)/gmes
fion(3,isa) = fion(3,isa) - 2.*evalue*aimag(temp3)/gmes
fion(ipol,isa) = fion(ipol,isa) - 2.*evalue*AIMAG(temp)/gmes
fion(1,isa) = fion(1,isa) - 2.*evalue*AIMAG(temp1)/gmes
fion(2,isa) = fion(2,isa) - 2.*evalue*AIMAG(temp2)/gmes
fion(3,isa) = fion(3,isa) - 2.*evalue*AIMAG(temp3)/gmes
end do
end do
end do
......
......@@ -5,7 +5,7 @@
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
#include "f_defs.h"
!
!=======================================================================
!
......@@ -13,7 +13,7 @@
rhor, rhog, rhos, rhoc, ei1, ei2, ei3, sfac, fion, ema0bg, becdr, &
lambdap, lambda )
use kinds, only: dp
use control_flags, only: iprint, thdyn, tpre, tbuff, iprsta, trhor, &
tfor, tvlocw, trhow, taurdr, tprnfor
use control_flags, only: ndr, ndw, nbeg, nomore, tsde, tortho, tnosee, &
......@@ -279,8 +279,8 @@
hpsi(1:ngw, i)=c2(1:ngw)
hpsi(1:ngw,i+1)=c3(1:ngw)
if (ng0.eq.2) then
hpsi(1, i)=cmplx(real(hpsi(1, i)))
hpsi(1,i+1)=cmplx(real(hpsi(1,i+1)))
hpsi(1, i)=CMPLX(DBLE(hpsi(1, i)), 0.d0)
hpsi(1,i+1)=CMPLX(DBLE(hpsi(1,i+1)), 0.d0)
end if
enddo
......@@ -303,10 +303,10 @@
! do j=i,n
! lambda(i,j)=0.d0
! do ig=1,ngw
! lambda(i,j)=lambda(i,j)-2.d0*real(conjg(c0(ig,i,1,1))*hpsi(ig,j))
! lambda(i,j)=lambda(i,j)-2.d0*DBLE(CONJG(c0(ig,i,1,1))*hpsi(ig,j))
! enddo
! if(ng0.eq.2) then
! lambda(i,j)=lambda(i,j)+real(conjg(c0(1,i,1,1))*hpsi(1,j))
! lambda(i,j)=lambda(i,j)+DBLE(CONJG(c0(1,i,1,1))*hpsi(1,j))
! endif
! lambda(j,i)=lambda(i,j)
! enddo
......@@ -336,10 +336,10 @@
do j=1,n
lambda(i,j)=0.d0
do ig=1,ngw
lambda(i,j)=lambda(i,j)-2.d0*real(conjg(c0(ig,i,1,1))*gi(ig,j))
lambda(i,j)=lambda(i,j)-2.d0*DBLE(CONJG(c0(ig,i,1,1))*gi(ig,j))
enddo
if(ng0.eq.2) then
lambda(i,j)=lambda(i,j)+real(conjg(c0(1,i,1,1))*gi(1,j))
lambda(i,j)=lambda(i,j)+DBLE(CONJG(c0(1,i,1,1))*gi(1,j))
endif
enddo
enddo
......@@ -397,10 +397,10 @@
call calbec(1,nsp,eigr,gi,becm)
do i=1,n
do ig=1,ngw
gamma=gamma+2*real(conjg(gi(ig,i))*gi(ig,i))
gamma=gamma+2*DBLE(CONJG(gi(ig,i))*gi(ig,i))
enddo
if (ng0.eq.2) then
gamma=gamma-real(conjg(gi(1,i))*gi(1,i))
gamma=gamma-DBLE(CONJG(gi(1,i))*gi(1,i))
endif
enddo
call mp_sum(gamma)
......@@ -424,10 +424,10 @@
do i=1,n
do j=1,n
do ig=1,ngw
gamma=gamma+2*real(conjg(gi(ig,i))*gi(ig,j))*fmat0(j,i,1)
gamma=gamma+2*DBLE(CONJG(gi(ig,i))*gi(ig,j))*fmat0(j,i,1)
enddo
if (ng0.eq.2) then
gamma=gamma-real(conjg(gi(1,i))*gi(1,j))*fmat0(j,i,1)
gamma=gamma-DBLE(CONJG(gi(1,i))*gi(1,j))*fmat0(j,i,1)
endif
enddo
enddo
......@@ -450,10 +450,10 @@
call calbec(1,nsp,eigr,gi,becm)
do i=1,n
do ig=1,ngw
gamma=gamma+2*real(conjg(gi(ig,i))*gi(ig,i))
gamma=gamma+2*DBLE(CONJG(gi(ig,i))*gi(ig,i))
enddo
if (ng0.eq.2) then
gamma=gamma-real(conjg(gi(1,i))*gi(1,i))
gamma=gamma-DBLE(CONJG(gi(1,i))*gi(1,i))
endif
enddo
......@@ -478,10 +478,10 @@
do i=1,n
do j=1,n
do ig=1,ngw
gamma=gamma+2*real(conjg(gi(ig,i))*gi(ig,j))*fmat0(j,i,1)
gamma=gamma+2*DBLE(CONJG(gi(ig,i))*gi(ig,j))*fmat0(j,i,1)
enddo
if (ng0.eq.2) then
gamma=gamma-real(conjg(gi(1,i))*gi(1,j))*fmat0(j,i,1)
gamma=gamma-DBLE(CONJG(gi(1,i))*gi(1,j))*fmat0(j,i,1)
endif
enddo
enddo
......@@ -514,10 +514,10 @@
if(.not.tens) then
do i=1,n
do ig=1,ngw
dene0=dene0-4.d0*real(conjg(hi(ig,i))*hpsi(ig,i))!ATTENZION iera gi
dene0=dene0-4.d0*DBLE(CONJG(hi(ig,i))*hpsi(ig,i))!ATTENZION iera gi
enddo
if (ng0.eq.2) then
dene0=dene0+2.d0*real(conjg(hi(1,i))*hpsi(1,i))!ATTENZION iera gi
dene0=dene0+2.d0*DBLE(CONJG(hi(1,i))*hpsi(1,i))!ATTENZION iera gi
endif
end do
else
......@@ -527,13 +527,13 @@
do i=1,n
do j=1,n
do ig=1,ngw
dene0=dene0-2.d0*real(conjg(hi(ig,i))*hpsi(ig,j))*fmat0(j,i,1)
dene0=dene0-2.d0*DBLE(CONJG(hi(ig,i))*hpsi(ig,j))*fmat0(j,i,1)
!ATTENZIONE solo caso nspin=1!!!!!
dene0=dene0-2.d0*real(conjg(hpsi(ig,i))*hi(ig,j))*fmat0(j,i,1)
dene0=dene0-2.d0*DBLE(CONJG(hpsi(ig,i))*hi(ig,j))*fmat0(j,i,1)
enddo
if (ng0.eq.2) then
dene0=dene0+real(conjg(hi(1,i))*hpsi(1,j))*fmat0(j,i,1)
dene0=dene0+real(conjg(hpsi(1,i))*hi(1,j))*fmat0(j,i,1)
dene0=dene0+DBLE(CONJG(hi(1,i))*hpsi(1,j))*fmat0(j,i,1)
dene0=dene0+DBLE(CONJG(hpsi(1,i))*hi(1,j))*fmat0(j,i,1)
end if
enddo
enddo
......@@ -614,7 +614,7 @@
cm(1:ngw,1:n,1,1)=c0(1:ngw,1:n,1,1)+spasso*passo*hi(1:ngw,1:n)
if(ng0.eq.2) then
cm(1,:,1,1)=0.5d0*(cm(1,:,1,1)+conjg(cm(1,:,1,1)))
cm(1,:,1,1)=0.5d0*(cm(1,:,1,1)+CONJG(cm(1,:,1,1)))
endif
! call ordina(cm,e0)
......@@ -811,11 +811,11 @@
c0hc0(k,i,is)=0.d0
do ig=1,ngw
c0hc0(k,i,is)=c0hc0(k,i,is)- &
& 2.0*real(conjg(c0(ig,k+istart-1,1,1))*h0c0(ig,i+istart-1))
& 2.0*DBLE(CONJG(c0(ig,k+istart-1,1,1))*h0c0(ig,i+istart-1))
enddo
if (ng0.eq.2) then
c0hc0(k,i,is)=c0hc0(k,i,is)+&
& real(conjg(c0(1,k+istart-1,1,1))*h0c0(1,i+istart-1))
& DBLE(CONJG(c0(1,k+istart-1,1,1))*h0c0(1,i+istart-1))
endif
end do
end do
......@@ -897,8 +897,8 @@
! initialization when xmin is determined by sampling
do il=1,1
! this loop is useful to check that the sampling is correct
!x=0.1*real(il)
x=1.*real(il)
!x=0.1*DBLE(il)
x=1.*DBLE(il)
do is=1,nspin
nss=nupdwn(is)
fmatx(1:nss,1:nss,is)=fmat0(1:nss,1:nss,is)+x*dfmat(1:nss,1:nss,is)
......@@ -989,11 +989,11 @@
c0hc0(k,i,is)=0.d0
do ig=1,ngw
c0hc0(k,i,is)=c0hc0(k,i,is)-&
2.0*real(conjg(c0(ig,k+istart-1,1,1))*h0c0(ig,i+istart-1))
2.0*DBLE(CONJG(c0(ig,k+istart-1,1,1))*h0c0(ig,i+istart-1))
enddo
if (ng0.eq.2) then
c0hc0(k,i,is)=c0hc0(k,i,is)+&
real(conjg(c0(1,k+istart-1,1,1))*h0c0(1,i+istart-1))
DBLE(CONJG(c0(1,k+istart-1,1,1))*h0c0(1,i+istart-1))
endif
end do
end do
......@@ -1063,7 +1063,7 @@
do il=0,2000
x=0.0005*real(il)
x=0.0005*DBLE(il)
entropy2=0.0
do is=1,nspin
......@@ -1164,9 +1164,9 @@
! do j=1,n
! add=0.d0
! do ig=1,ngw
! add = add + 2*real(conjg(c0diag(ig,i))*c0diag(ig,j))
! add = add + 2*DBLE(CONJG(c0diag(ig,i))*c0diag(ig,j))
! enddo
! add = add - real(conjg(c0diag(1,i))*c0diag(1,j))
! add = add - DBLE(CONJG(c0diag(1,i))*c0diag(1,j))
! write(*,*) 'Conrollo c0diag', i,j, add
! enddo
! enddo
......@@ -1247,18 +1247,18 @@
gi(ig,i+1)=c3(ig)
end do
if (ng0.eq.2) then
gi(1, i)=cmplx(real(gi(1, i)))
gi(1,i+1)=cmplx(real(gi(1,i+1)))
gi(1, i)=CMPLX(DBLE(gi(1, i)),0.d0)
gi(1,i+1)=CMPLX(DBLE(gi(1,i+1)),0.d0)
end if
enddo
do i=1,n
do j=i,n
lambda(i,j)=0.d0
do ig=1,ngw
lambda(i,j)=lambda(i,j)-2.d0*real(conjg(c0(ig,i,1,1))*gi(ig,j))
lambda(i,j)=lambda(i,j)-2.d0*DBLE(CONJG(c0(ig,i,1,1))*gi(ig,j))
enddo
if(ng0.eq.2) then
lambda(i,j)=lambda(i,j)+real(conjg(c0(1,i,1,1))*gi(1,j))
lambda(i,j)=lambda(i,j)+DBLE(CONJG(c0(1,i,1,1))*gi(1,j))
endif
lambda(j,i)=lambda(i,j)
enddo
......
......@@ -5,7 +5,7 @@
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
#include "f_defs.h"
!-------------------------------------------------------------------------
subroutine calphiid(c0,bec,betae,phi)
!-----------------------------------------------------------------------
......@@ -15,7 +15,6 @@
! where s'=s(r(t))
!
!ATTENZION no usa el preconditioning
use ions_base, only: na, nsp
use io_global, only: stdout
use cvan
......@@ -69,7 +68,7 @@
do j=1,n
do i=1,ngw
emtot=emtot &
& +2.*real(phi(i,j)*conjg(c0(i,j)))
& +2.*DBLE(phi(i,j)*CONJG(c0(i,j)))
end do
end do
emtot=emtot/n
......@@ -135,7 +134,7 @@
!-----------------------------------------------------------------------
subroutine rotate(z0,c0,bec,c0diag,becdiag)
!-----------------------------------------------------------------------
use kinds, only: dp
use cvan
use electrons_base, only: nudx, nspin, nupdwn, iupdwn, nx => nbspx, n => nbsp
use uspp_param, only: nh
......@@ -158,7 +157,7 @@
! do nj=1,nss
! do j=1,ngw
! c0diag(j,ni+istart-1)=c0diag(j,ni+istart-1)+ &
! & cmplx(z0(ni,nj,iss),0.0)*c0(j,nj+istart-1)
! & CMPLX(z0(ni,nj,iss),0.0)*c0(j,nj+istart-1)
! end do
! end do
! end do
......@@ -176,7 +175,7 @@
becdiag(jnl,ni+istart-1)=0.0
do nj=1,nss
becdiag(jnl,ni+istart-1)=becdiag(jnl,ni+istart-1)+ &
& cmplx(z0(ni,nj,iss),0.0)*bec(jnl,nj+istart-1)
& CMPLX(z0(ni,nj,iss),0.d0)*bec(jnl,nj+istart-1)
end do
end do
end do
......@@ -327,13 +326,13 @@ subroutine pc2(a,beca,b,becb)
do j=1,n
sca=0.
if (ng0.eq.2) then
b(1,i)=0.5d0*(b(1,i)+conjg(b(1,i)))
b(1,i)=0.5d0*(b(1,i)+CONJG(b(1,i)))
endif
do ig=1,ngw !loop on g vectors
sca=sca+2.d0*real(conjg(a(ig,j))*b(ig,i)) !2. for real weavefunctions
sca=sca+2.d0*DBLE(CONJG(a(ig,j))*b(ig,i)) !2. for real wavefunctions
enddo
if (ng0.eq.2) then
sca=sca-real(conjg(a(1,j))*b(1,i))
sca=sca-DBLE(CONJG(a(1,j))*b(1,i))
endif
call mp_sum( sca )
......@@ -358,7 +357,7 @@ subroutine pc2(a,beca,b,becb)
enddo
! this to prevent numerical errors
if (ng0.eq.2) then
b(1,i)=0.5d0*(b(1,i)+conjg(b(1,i)))
b(1,i)=0.5d0*(b(1,i)+CONJG(b(1,i)))
endif
enddo
......@@ -400,13 +399,13 @@ subroutine pcdaga2(a,as ,b )
do j=1,n
sca=0.
if (ng0.eq.2) then
b(1,i)=0.5d0*(b(1,i)+conjg(b(1,i)))
b(1,i)=0.5d0*(b(1,i)+CONJG(b(1,i)))
endif
do ig=1,ngw !loop on g vectors
sca=sca+2.*real(conjg(a(ig,j))*b(ig,i)) !2. for real weavefunctions
sca=sca+2.*DBLE(CONJG(a(ig,j))*b(ig,i)) !2. for real weavefunctions
enddo
if (ng0.eq.2) then
sca=sca-real(conjg(a(1,j))*b(1,i))
sca=sca-DBLE(CONJG(a(1,j))*b(1,i))
endif
call mp_sum(sca)
do ig=1,ngw
......@@ -414,7 +413,7 @@ subroutine pcdaga2(a,as ,b )
enddo
! this to prevent numerical errors
if (ng0.eq.2) then
b(1,i)=0.5d0*(b(1,i)+conjg(b(1,i)))
b(1,i)=0.5d0*(b(1,i)+CONJG(b(1,i)))
endif
enddo
enddo
......
......@@ -110,7 +110,7 @@
ALLOCATE( comp( nz ) )
fact = omega / REAL( nx * ny * nz )
fact = omega / DBLE( nx * ny * nz )
DO ispin = 1, nspin
......@@ -269,7 +269,7 @@
DO ispin = 1, nspin
rsum1 = SUM( rhoe( 1:nxl, 1:nyl, 1:nzl, ispin ) )
rsum1 = rsum1 * omega / REAL( nr1 * nr2 * nr3 )
rsum1 = rsum1 * omega / DBLE( nr1 * nr2 * nr3 )
! ... sum over all processors
......@@ -331,15 +331,15 @@
DO ib = 1, cdesc%nbl( ispin )
wdot = ZDOTC( ( cdesc%ngwl - 1 ), c(2,ib), 1, c(2,ib), 1 )
wdot = wdot + REAL( c(1,ib), dbl )**2 / 2.0d0
rsum = rsum + fi(ib) * REAL( wdot )
wdot = wdot + DBLE( c(1,ib) )**2 / 2.0d0
rsum = rsum + fi(ib) * DBLE( wdot )
END DO
ELSE
DO ib = 1, cdesc%nbl( ispin )
wdot = ZDOTC( cdesc%ngwl, c(1,ib), 1, c(1,ib), 1 )
rsum = rsum + fi(ib) * REAL( wdot )
rsum = rsum + fi(ib) * DBLE( wdot )
END DO
END IF
......@@ -507,7 +507,7 @@
! ... extract wave functions from psi2
r1 = DREAL( psi2(i,j,k) )
r1 = DBLE( psi2(i,j,k) )
r2 = AIMAG( psi2(i,j,k) )
! ... add squared moduli to charge density
......@@ -540,7 +540,7 @@
! ... extract wave functions from psi2
r1 = REAL( psi2(i,j,k) )
r1 = DBLE( psi2(i,j,k) )
! ... add squared moduli to charge density
......@@ -579,7 +579,7 @@
! ... add squared modulus to charge density
rho(i,j,k) = rho(i,j,k) + coef3 * REAL( psi2(i,j,k) * CONJG(psi2(i,j,k)) )
rho(i,j,k) = rho(i,j,k) + coef3 * DBLE( psi2(i,j,k) * CONJG(psi2(i,j,k)) )
END DO
END DO
......@@ -670,7 +670,7 @@
DO ipol = 1, 3
DO ig = 1, SIZE( rhoeg )
rg = rhoeg(ig) * gx( ipol, ig )
tgrho(ig) = tpiba * CMPLX( - AIMAG(rg), REAL(rg) )
tgrho(ig) = tpiba * CMPLX( - AIMAG(rg), DBLE(rg) )
END DO
CALL pinvfft( grho(:,:,:,ipol), tgrho )
END DO
......@@ -725,11 +725,11 @@
end do
do ig=1,ng
v(np(ig))= ci*tpiba*gx(1,ig)*rhog(ig,iss)
v(nm(ig))=conjg(ci*tpiba*gx(1,ig)*rhog(ig,iss))
v(nm(ig))=CONJG(ci*tpiba*gx(1,ig)*rhog(ig,iss))
end do
call invfft(v,nr1,nr2,nr3,nr1x,nr2x,nr3x)
do ir=1,nnr
gradr(ir,1,iss)=real(v(ir))
gradr(ir,1,iss)=DBLE(v(ir))
end do
do ig=1,nnr
v(ig)=(0.0,0.0)
......@@ -737,13 +737,13 @@
do ig=1,ng
v(np(ig))= tpiba*( ci*gx(2,ig)*rhog(ig,iss)- &
& gx(3,ig)*rhog(ig,iss) )
v(nm(ig))= tpiba*(conjg(ci*gx(2,ig)*rhog(ig,iss)+ &
v(nm(ig))= tpiba*(CONJG(ci*gx(2,ig)*rhog(ig,iss)+ &
& gx(3,ig)*rhog(ig,iss)))
end do
call invfft(v,nr1,nr2,nr3,nr1x,nr2x,nr3x)
do ir=1,nnr
gradr(ir,2,iss)= real(v(ir))
gradr(ir,3,iss)=aimag(v(ir))
gradr(ir,2,iss)= DBLE(v(ir))
gradr(ir,3,iss)=AIMAG(v(ir))
end do
end do
!
......
......@@ -5,7 +5,7 @@
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
#include "f_defs.h"
module chi2
USE kinds
......
......@@ -1332,7 +1332,7 @@ END SUBROUTINE gshcount
CASE (3)
exgc_info = 'PERDEW BURKE ERNZERHOF'
CASE (7)
exgc_info = 'META-TPSS'
exgc_info = 'META-TPSS'
CASE DEFAULT
exgc_info = 'UNKNOWN'
END SELECT
......@@ -1348,7 +1348,7 @@ END SUBROUTINE gshcount
CASE (4)
cogc_info = 'PERDEW BURKE ERNZERHOF'
CASE (6)
cogc_info = 'META-TPSS'
cogc_info = 'META-TPSS'
CASE DEFAULT
cogc_info = 'UNKNOWN'
END SELECT
......
......@@ -404,7 +404,7 @@ MODULE cp_restart
call iotk_write_attr (attr,"dw",nupdwn(2))
CALL iotk_write_dat( iunpun, "NUMBER_OF_BANDS", nbnd, ATTR = attr )
ELSE
CALL iotk_write_dat( iunpun, "NUMBER_OF_BANDS", nbnd )
CALL iotk_write_dat( iunpun, "NUMBER_OF_BANDS", nbnd )
END IF
!
CALL iotk_write_begin( iunpun, "EIGENVALUES_AND_EIGENVECTORS" )
......
This diff is collapsed.
......@@ -7,11 +7,13 @@
!
subroutine dforce_meta (c,ca,df,da, psi,iss1,iss2,fi,fip)
!-----------------------------------------------------------------------
!computes: the generalized force df=cmplx(dfr,dfi) acting on the i-th
!computes: the generalized force df=CMPLX(dfr,dfi) acting on the i-th
! electron state at the gamma point of the brillouin zone
! represented by the vector c=cmplx(cr,ci)
! represented by the vector c=CMPLX(cr,ci)
!
! contribution from metaGGA
! contribution from metaGGA
#include "f_defs.h"
use kinds, only: dp
use reciprocal_vectors
use gvecs
use gvecw, only : ngw
......@@ -33,23 +35,23 @@
ci=(0.0,1.0)
!
do ipol = 1, 3
psi(:)=(0.d0,0.d0)
psi(:)=(0.d0,0.d0)
do ig=1,ngw
psi(nps(ig))=gx(ipol,ig)* (ci*c(ig) - ca(ig))
psi(nms(ig))=gx(ipol,ig)* (conjg(ci*c(ig) + ca(ig)))
psi(nms(ig))=gx(ipol,ig)* (CONJG(ci*c(ig) + ca(ig)))
end do
call ivfftw(psi,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx)
! on smooth grids--> grids for charge density
do ir=1, nnrs
psi(ir) = cmplx(kedtaus(ir,iss1)*real(psi(ir)), &
kedtaus(ir,iss2)*aimag(psi(ir)))
psi(ir) = &
CMPLX(kedtaus(ir,iss1)*DBLE(psi(ir)), kedtaus(ir,iss2)*AIMAG(psi(ir)))
end do
call fwfftw(psi,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx)
do ig=1,ngw
fp= (psi(nps(ig)) + psi(nms(ig)))
fm= (psi(nps(ig)) - psi(nms(ig)))
df(ig)= df(ig) - ci*fi*tpiba2*gx(ipol,ig)*cmplx(real(fp), aimag(fm))
da(ig)= da(ig) - ci*fip*tpiba2*gx(ipol,ig)*cmplx(aimag(fp),-real(fm))
df(ig)= df(ig) - ci*fi*tpiba2*gx(ipol,ig)*CMPLX(DBLE(fp), AIMAG(fm))
da(ig)= da(ig) - ci*fip*tpiba2*gx(ipol,ig)*CMPLX(AIMAG(fp),-DBLE(fm))
end do
end do
......@@ -62,6 +64,7 @@
subroutine kedtauofr_meta (c, psi, psis)
!-----------------------------------------------------------------------
!
use kinds, only: dp
use control_flags, only: tpre
use gvecs
use gvecw, only: ngw
......@@ -124,14 +127,14 @@
psis(:)=(0.d0,0.d0)
do ig=1,ngw
psis(nps(ig))=tpiba*gx(ipol,ig)* (ci*c(ig,i) - c(ig,i+1))
psis(nms(ig))=tpiba*gx(ipol,ig)*conjg(ci*c(ig,i)+c(ig,i+1))
psis(nms(ig))=tpiba*gx(ipol,ig)*CONJG(ci*c(ig,i)+c(ig,i+1))
end do
! gradient of wfc in real space