Commit a799828d authored by Gustav Bihlmayer's avatar Gustav Bihlmayer

Some modifications to make the program work with complex phases:

changed phas(n) in spgrot.f to cc. Use cc of pgfft in pwden.F90,
partially in fft(3,2)d(xc).f90, and of phas in cdnovlp.F90.
Introduce complex phase & derived variables in q_int_sl.f90, hsint.F90,
vacfun.f90, potdis.f90. Initializations in strgn.f90, real arguments
for dot_product() in pwint(_sl).f90 & phasy1.f90. Stop message in
rw_symfile.f changed to 'complex phases not fully tested'.
parent 75f45272
......@@ -381,9 +381,10 @@
sf = czero
DO j = 1,sym%nop
x = -tpi_const* ( kr(1,j) * atoms%taual(1,nat)&
& + kr(2,j) * atoms%taual(2,nat)&
& + kr(3,j) * atoms%taual(3,nat))
sf = sf + CMPLX(COS(x),SIN(x))*phas(j)
& + kr(2,j) * atoms%taual(2,nat)&
& + kr(3,j) * atoms%taual(3,nat))
!gb sf = sf + CMPLX(COS(x),SIN(x))*phas(j)
sf = sf + CMPLX(COS(x),SIN(x))*conjg(phas(j))
ENDDO
sf = sf / REAL( sym%nop )
qpw(k,jspin) = qpw(k,jspin) + sf * qf(k)
......@@ -398,8 +399,8 @@
sf = czero
DO j = 1,oneD%ods%nop
x = -tpi_const* ( kro(1,j)*atoms%taual(1,nat)&
& + kro(2,j)*atoms%taual(2,nat)&
& + kro(3,j)*atoms%taual(3,nat))
& + kro(2,j)*atoms%taual(2,nat)&
& + kro(3,j)*atoms%taual(3,nat))
sf = sf + CMPLX(COS(x),SIN(x))*phaso(j)
ENDDO
sf = sf / REAL( oneD%ods%nop )
......
......@@ -478,7 +478,7 @@ CONTAINS
CALL cfft(psi2r,psi2i,ifftq3,stars%kq3_fft,ifftq3,isn)
cwk=0.0
DO ik = 0 , stars%kmxq_fft - 1
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(psi1r(igq_fft(ik)),psi1i(igq_fft(ik)))
ENDDO
DO istr = 1,stars%ng3_fft
......@@ -491,7 +491,7 @@ CONTAINS
cwk=0.0
DO ik = 0 , stars%kmxq_fft - 1
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(psi2r(igq_fft(ik)),psi2i(igq_fft(ik)))
ENDDO
DO istr = 1,stars%ng3_fft
......@@ -582,16 +582,16 @@ CONTAINS
ecwk=0.0
IF (noco%l_noco) THEN
DO ik = 0 , stars%kmxq_fft - 1
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(rhomat(igq_fft(ik),idens),psi1r(igq_fft(ik)))
ENDDO
ELSE
DO ik = 0 , stars%kmxq_fft - 1
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(rhon(igq_fft(ik)),zero)
#else
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(rhon(igq_fft(ik)),psir(igq_fft(ik)))
#endif
ENDDO
......@@ -599,10 +599,10 @@ CONTAINS
IF (input%l_f) THEN
DO ik = 0 , stars%kmxq_fft - 1
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
ecwk(stars%igfft(ik,1))=ecwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
ecwk(stars%igfft(ik,1))=ecwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(ekin(igq_fft(ik)),zero)
#else
ecwk(stars%igfft(ik,1))=ecwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
ecwk(stars%igfft(ik,1))=ecwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(ekin(igq_fft(ik)),psii(igq_fft(ik)))
#endif
ENDDO
......
......@@ -86,11 +86,8 @@
srmt = s*atoms%rmt(n)
sfs = (0.0,0.0)
DO nn = 1,sym%nop
!arg = tpi* (kr(1,nn)*taual(1,na)+kr(2,nn)*taual(2,na)+
!+ kr(3,nn)*taual(3,na))
arg =tpi_const*dot_product(kr(:,nn),atoms%taual(:,na))
!sfs = sfs + exp(cmplx(0.0,arg))*ph(nn)
sfs=sfs+cmplx(cos(arg),sin(arg))*ph(nn)
arg = tpi_const * dot_product(real(kr(:,nn)),atoms%taual(:,na))
sfs = sfs + cmplx(cos(arg),sin(arg))*ph(nn)
ENDDO
sfs = sfs/sym%nop
! -----3*ji(gr)/gr term
......@@ -108,12 +105,10 @@
& stars%kv3,&
& kr,ph)
sfs = (0.0,0.0)
DO 11 nn = 1,sym%nop
arg = tpi_const* (kr(1,nn)*atoms%taual(1,na)+&
& kr(2,nn)*atoms%taual(2,na)+&
& kr(3,nn)*atoms%taual(3,na))
sfs = sfs + exp(cmplx(0.0,arg))*ph(nn)
11 CONTINUE
DO nn = 1,sym%nop
arg = tpi_const * dot_product(real(kr(:,nn)),atoms%taual(:,na))
sfs = sfs + cmplx(cos(arg),sin(arg))*ph(nn)
ENDDO
sfs = sfs/sym%nop
! -----3*ji(gr)/gr term
s1 = 3.* (sin(srmt)/srmt-cos(srmt))/ (srmt*srmt)
......
......@@ -66,7 +66,7 @@ CONTAINS
CALL spgrot(sym%nop,sym%symor,sym%mrot,sym%tau,sym%invtab, kv, kr,ph)
sfs = (0.0,0.0)
DO nn = 1,sym%nop
arg = tpi_const* dot_product(kr(:,nn),atoms%taual(:,nat))
arg = tpi_const* dot_product(real(kr(:,nn)),atoms%taual(:,nat))
sfs = sfs + CMPLX(COS(arg),SIN(arg))*ph(nn)
ENDDO
sfs = sfs/sym%nop
......
......@@ -36,9 +36,9 @@ CONTAINS
#endif
! ..
! .. Local Scalars ..
REAL phase,phasep,q1,zsl1,zsl2,qi,volsli,volintsli
REAL q1,zsl1,zsl2,qi,volsli,volintsli
INTEGER i ,indp,ix1,iy1,iz1,j,n,ns,ind
COMPLEX x
COMPLEX x,phase,phasep
! ..
! .. Local Arrays ..
COMPLEX, ALLOCATABLE :: stfunint(:,:),z_z(:)
......@@ -102,11 +102,11 @@ CONTAINS
phase = stars%rgphs(ix1,iy1,iz1)/ (stars%nstr(ind)*cell%omtil)
phasep = stars%rgphs(-ix1,-iy1,-iz1)/ (stars%nstr(indp)*cell%omtil)
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
z_z(ind) = z_z(ind) + z(j,n)*z(i,n)*phase
z_z(indp) = z_z(indp) + z(i,n)*z(j,n)*phasep
z_z(ind) = z_z(ind) + z(j,n)*z(i,n)*REAL(phase)
z_z(indp) = z_z(indp) + z(i,n)*z(j,n)*REAL(phasep)
#else
z_z(ind) = z_z(ind) +z(j,n)*CONJG(z(i,n))*CMPLX(phase,0.0)
z_z(indp)= z_z(indp)+z(i,n)*CONJG(z(j,n))*CMPLX(phasep,0.0)
z_z(ind) = z_z(ind) +z(j,n)*CONJG(z(i,n))*phase
z_z(indp)= z_z(indp)+z(i,n)*CONJG(z(j,n))*phasep
#endif
ENDDO
ENDDO
......
......@@ -49,12 +49,12 @@ CONTAINS
#endif
! ..
! .. Local Scalars ..
COMPLEX th
REAL phase,b1(3),b2(3),r2
COMPLEX th,ts,phase
REAL b1(3),b2(3),r2
INTEGER i,i1,i2,i3,ii,in,j,ig3,ispin,l
INTEGER istart,nc
COMPLEX ust1,vp1,ts
COMPLEX ust1,vp1
COMPLEX, ALLOCATABLE :: vpw1(:) ! for J constants
! ..
! ..
......
......@@ -44,7 +44,8 @@ CONTAINS
REAL, INTENT (OUT):: ddnv(dimension%nv2d,dimension%jspd)
! ..
! .. Local Scalars ..
REAL ev,phase,scale,xv,yv,vzero
REAL ev,scale,xv,yv,vzero
COMPLEX phase
INTEGER i,i1,i2,i3,ik,ind2,ind3,jk,np1,jspin,jsp1,jsp2
LOGICAL tail
! ..
......
......@@ -60,7 +60,7 @@
pylm(lm,n) = cmplx(0.,0.)
ENDDO
DO j = 1,sym%nop
x = tpi_const* dot_product(kr(:,j),atoms%taual(:,na))
x = tpi_const* dot_product(real(kr(:,j)),atoms%taual(:,na))
sf = cmplx(cos(x),sin(x))*phas(j)
DO l = 0,atoms%lmax(n)
ll1 = l*(l+1) + 1
......
......@@ -32,8 +32,8 @@
ELSE
DO n = 1,nop
ni = invtab(n)
phas(n) = exp(cmplx(0,1)*tpi_const*
+ dot_product(kr(:,n),tau(:,ni)))
phas(n) = exp(cmplx(0.0,-1.0)*tpi_const*
+ dot_product(real(kr(:,n)),tau(:,ni)))
! note that, in general phas(n) could be complex!
ENDDO
END IF
......
......@@ -221,7 +221,7 @@ CONTAINS
DO k2 = -stars%k2d,stars%k2d
DO k1 = -stars%k1d,stars%k1d
stars%ig(k1,k2,k3) = 0
stars%rgphs(k1,k2,k3) = 0.0
stars%rgphs(k1,k2,k3) = cmplx(0.0,0.0)
ENDDO
ENDDO
ENDDO
......@@ -347,7 +347,7 @@ CONTAINS
kidx=0
kidx2=0
!-gu
stars%rgphs(:,:,:) = 0.0
stars%rgphs(:,:,:) = cmplx(0.0,0.0)
DO k = 1,stars%ng3
CALL spgrot(&
......@@ -498,7 +498,7 @@ CONTAINS
! normalize phases:
!
IF (sym%symor) THEN
stars%rgphs(:,:,:) = 1.0
stars%rgphs(:,:,:) = cmplx(1.0,0.0)
ELSE
pon = 1.0 / sym%nop
pon2 = 1.0 / sym%nop2
......@@ -831,7 +831,7 @@ CONTAINS
!
! sum over phases
!
stars%rgphs(:,:,:) = 0.0
stars%rgphs(:,:,:) = cmplx(0.0,0.0)
starloop: DO k = 1,stars%ng3
CALL spgrot(&
......@@ -906,7 +906,7 @@ CONTAINS
! normalize phases:
!
IF (sym%symor) THEN
stars%rgphs(:,:,:) = 1.0
stars%rgphs(:,:,:) = cmplx(1.0,0.0)
ELSE
pon = 1.0 / sym%nop
DO k3 = -mxx3,mxx3
......
......@@ -103,7 +103,7 @@
ENDIF
IF (ABS(tau(i,n)) > 0.00001) THEN
IF (ABS(ABS(tau(i,n))-0.5) > 0.00001) THEN
CALL juDFT_error("complex :: phases not implemented!"
CALL juDFT_error("complex :: phases not fully tested!"
+ ,calledby ="rw_symfile")
ENDIF
ENDIF
......
......@@ -74,7 +74,7 @@ CONTAINS
ENDDO
scale=1.0/ifftd2
DO i=0,stars%kimax2
fg2(stars%igfft2(i,1))=fg2(stars%igfft2(i,1))+stars%pgfft2(i)*&
fg2(stars%igfft2(i,1))=fg2(stars%igfft2(i,1))+ CONJG( stars%pgfft2(i) ) * &
& CMPLX(afft2(stars%igfft2(i,2)),bfft2(stars%igfft2(i,2)))
ENDDO
fg=scale*REAL(fg2(1))/stars%nstr2(1)
......
......@@ -29,6 +29,7 @@
INTEGER i,ifftd
REAL scale
COMPLEX ctmp
ifftd=27*stars%k1d*stars%k2d*stars%k3d
......@@ -39,10 +40,9 @@
afft=0.0
bfft=0.0
DO i=0,stars%kimax
afft(stars%igfft(i,2))=real(fg3(stars%igfft(i,1))*&
& stars%pgfft(i))
bfft(stars%igfft(i,2))=aimag(fg3(stars%igfft(i,1))*&
& stars%pgfft(i))
ctmp = fg3(stars%igfft(i,1))*stars%pgfft(i)
afft(stars%igfft(i,2))=real(ctmp)
bfft(stars%igfft(i,2))=aimag(ctmp)
ENDDO
ENDIF
......@@ -60,8 +60,8 @@
fg3(i) = cmplx(0.0,0.0)
ENDDO
DO i=0,stars%kimax
fg3(stars%igfft(i,1))=fg3(stars%igfft(i,1))+ stars%pgfft(i)*&
& cmplx(afft(stars%igfft(i,2)),bfft(stars%igfft(i,2)))
fg3(stars%igfft(i,1)) = fg3(stars%igfft(i,1)) + CONJG( stars%pgfft(i) ) * &
& CMPLX(afft(stars%igfft(i,2)),bfft(stars%igfft(i,2)))
ENDDO
scale=1.0/ifftd
IF (PRESENT(scaled)) THEN
......
......@@ -22,7 +22,8 @@ CONTAINS
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
! .. Local Scalars ..
REAL fact,facv,phase,rhs,sumis,sumz
REAL fact,facv,rhs,sumis,sumz
COMPLEX phase
INTEGER i,i1,i2,i3,id2,id3,io,ip,iter,ivac,j,k1,k2,k3,lh,n,&
nk12,npz,nt,num,na
LOGICAL tail
......@@ -111,8 +112,10 @@ CONTAINS
af3(i,1) = 0.
bf3(i,1) = 0.
ELSE
af3(i,1) = REAL(rhpw(id3,num,1))*phase
bf3(i,1) = AIMAG(rhpw(id3,num,1))*phase
af3(i,1) = REAL(rhpw(id3,num,1))*REAL(phase) &
- AIMAG(rhpw(id3,num,1))*AIMAG(phase)
bf3(i,1) = AIMAG(rhpw(id3,num,1))*REAL(phase) &
+ REAL(rhpw(id3,num,1))*AIMAG(phase)
END IF
ENDDO
ENDDO
......
......@@ -30,6 +30,7 @@
INTEGER i,ifftd
REAL scale,zero
COMPLEX ctmp
ifftd=k1d*k2d*k3d
zero=0.0
......@@ -41,8 +42,9 @@ c
afft=0.0
bfft=0.0
DO i=0,kimax-1
afft(igfft2(i))=real(fg3(igfft1(i)) * pgfft(i))
bfft(igfft2(i))=aimag(fg3(igfft1(i)) * pgfft(i))
ctmp = fg3(igfft1(i)) * pgfft(i)
afft(igfft2(i))=real(ctmp)
bfft(igfft2(i))=aimag(ctmp)
ENDDO
ENDIF
......@@ -61,7 +63,7 @@ c
ENDDO
scale=1.0/ifftd
DO i=0,kimax-1
fg3(igfft1(i))=fg3(igfft1(i))+pgfft(i)*
fg3(igfft1(i))=fg3(igfft1(i))+CONJG(pgfft(i))*
+ cmplx(afft(igfft2(i)),bfft(igfft2(i)))
ENDDO
DO i=1,ng3
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment