Some FFT helper routines generalized to both gamma-only and no-gamma cases

This commit is contained in:
Paolo Giannozzi 2018-08-20 15:14:20 +02:00
parent f4325e22ec
commit ae1cf88d54
2 changed files with 47 additions and 26 deletions

View File

@ -350,21 +350,26 @@ CONTAINS
! c array: stores the Fourier expansion coefficients
! Loop for all local g-vectors (ngw)
IF( PRESENT(ca) ) THEN
do ig = 1, desc%ngm
psi( desc%nlm( ig ) ) = CONJG( c( ig ) ) + ci * conjg( ca( ig ))
psi( desc%nl( ig ) ) = c( ig ) + ci * ca( ig )
end do
ELSE
IF( desc%ngm == desc%ngl( desc%mype + 1 ) ) THEN
DO ig = 1, desc%ngm
psi( desc%nl( ig ) ) = c( ig )
END DO
IF( desc%lgamma ) THEN
do ig = 1, desc%ngm
psi( desc%nlm( ig ) ) = CONJG( c( ig ) ) + ci * conjg( ca( ig ))
psi( desc%nl( ig ) ) = c( ig ) + ci * ca( ig )
end do
ELSE
! Gamma symmetry
do ig = 1, desc%ngm
psi( desc%nl( ig ) ) = c( ig ) + ci * ca( ig )
end do
END IF
ELSE
IF( desc%lgamma ) THEN
do ig = 1, desc%ngm
psi( desc%nlm( ig ) ) = CONJG( c( ig ) )
psi( desc%nl( ig ) ) = c( ig )
end do
ELSE
DO ig = 1, desc%ngm
psi( desc%nl( ig ) ) = c( ig )
END DO
END IF
END IF
END SUBROUTINE

View File

@ -56,22 +56,38 @@ CONTAINS
CALL fwfft('Rho', psi, desc )
CALL fftx_threed2oned( desc, psi, rhog(:,iss) )
ELSE
! nspin/2 = 1 for LSDA, = 2 for noncolinear
DO iss=1,nspin/2
isup=1+(iss-1)*nspin/2 ! 1 for LSDA, 1 and 3 for noncolinear
isdw=2+(iss-1)*nspin/2 ! 2 for LSDA, 2 and 4 for noncolinear
IF( PRESENT( v ) ) THEN
DO ir=1,desc%nnr
psi(ir)=CMPLX(rhor(ir,isup)+v(ir),rhor(ir,isdw)+v(ir),kind=dp)
END DO
ELSE
DO ir=1,desc%nnr
psi(ir)=CMPLX(rhor(ir,isup),rhor(ir,isdw),kind=dp)
END DO
END IF
CALL fwfft('Rho', psi, desc )
CALL fftx_threed2oned( desc, psi, rhog(:,isup), rhog(:,isdw) )
END DO
IF ( gamma_only ) THEN
! nspin/2 = 1 for LSDA, = 2 for noncolinear
DO iss=1,nspin/2
isup=1+(iss-1)*nspin/2 ! 1 for LSDA, 1 and 3 for noncolinear
isdw=2+(iss-1)*nspin/2 ! 2 for LSDA, 2 and 4 for noncolinear
IF( PRESENT( v ) ) THEN
DO ir=1,desc%nnr
psi(ir)=CMPLX(rhor(ir,isup)+v(ir),rhor(ir,isdw)+v(ir),kind=dp)
END DO
ELSE
DO ir=1,desc%nnr
psi(ir)=CMPLX(rhor(ir,isup),rhor(ir,isdw),kind=dp)
END DO
END IF
CALL fwfft('Rho', psi, desc )
CALL fftx_threed2oned( desc, psi, rhog(:,isup), rhog(:,isdw) )
END DO
ELSE
DO iss=1,nspin
IF( PRESENT( v ) ) THEN
DO ir=1,desc%nnr
psi(ir)=CMPLX(rhor(ir,iss)+v(ir),0.0_dp,kind=dp)
END DO
ELSE
DO ir=1,desc%nnr
psi(ir)=CMPLX(rhor(ir,iss),0.0_dp,kind=dp)
END DO
END IF
CALL fwfft('Rho', psi, desc )
CALL fftx_threed2oned( desc, psi, rhog(:,iss) )
END DO
END IF
ENDIF
DEALLOCATE( psi )