Merge branch 'fix_noncolin' into 'develop'

Fix noncolin

See merge request QEF/q-e!639
This commit is contained in:
giannozz 2019-11-02 13:33:27 +00:00
commit 037af750a3
2 changed files with 19 additions and 42 deletions

View File

@ -26,19 +26,24 @@
! output: the orientation when needed
REAL(DP) :: amag
INTEGER :: ir ! counter on mesh points
segni=1.0_DP
IF (lsign) THEN
DO ir=1,nrxx
IF (lsign) THEN
!$omp parallel do default(shared) private(ir, amag)
DO ir = 1, nrxx
segni(ir)=SIGN(1.0_DP,rho(ir,2)*ux(1)+rho(ir,3)*ux(2)+rho(ir,4)*ux(3))
amag=SQRT(rho(ir,2)**2+rho(ir,3)**2+rho(ir,4)**2)
rhoout(ir,1)=0.5d0*(rho(ir,1)+segni(ir)*amag)
rhoout(ir,2)=0.5d0*(rho(ir,1)-segni(ir)*amag)
ENDDO
ENDIF
DO ir=1,nrxx
amag=SQRT(rho(ir,2)**2+rho(ir,3)**2+rho(ir,4)**2)
rhoout(ir,1)=0.5d0*(rho(ir,1)+segni(ir)*amag)
rhoout(ir,2)=0.5d0*(rho(ir,1)-segni(ir)*amag)
ENDDO
!$omp end parallel do
ELSE
!$omp parallel do default(shared) private(ir, amag)
DO ir =1, nrxx
segni(ir) = 1.0_DP
amag=SQRT(rho(ir,2)**2+rho(ir,3)**2+rho(ir,4)**2)
rhoout(ir,1)=0.5d0*(rho(ir,1) + amag)
rhoout(ir,2)=0.5d0*(rho(ir,1) - amag)
END DO
!$omp end parallel do
END IF
RETURN
END SUBROUTINE compute_rho

View File

@ -148,37 +148,9 @@ SUBROUTINE gradcorr( rho, rhog, rho_core, rhog_core, etxc, vtxc, v )
! ... spin-polarised case
!
ALLOCATE( v2c_ud(dfftp%nnr) )
!
!
IF ( .NOT. igcc_is_lyp() .AND. (nspin==4 .AND. domag) ) THEN
!
ALLOCATE( rh(dfftp%nnr), zeta(dfftp%nnr) )
!
rh = rhoaux(:,1) + rhoaux(:,2)
!
DO is = 1, 2
grho2(:,is) = grho(1,:,is)**2 + grho(2,:,is)**2 + grho(3,:,is)**2
ENDDO
!
CALL gcx_spin( dfftp%nnr, rhoaux, grho2, sx, v1x, v2x )
!
zeta = ABS(zeta) * segni(:)
!
grho2(:,1) = ( grho(1,:,1) + grho(1,:,2) )**2 + &
( grho(2,:,1) + grho(2,:,2) )**2 + &
( grho(3,:,1) + grho(3,:,2) )**2
!
CALL gcc_spin( dfftp%nnr, rh, zeta, grho2(:,1), sc, v1c, v2c(:,1) )
!
v2c(:,2) = v2c(:,1)
v2c_ud(:) = v2c(:,1)
!
DEALLOCATE( rh, zeta )
!
ELSE
!
CALL xc_gcx( dfftp%nnr, nspin0, rhoaux, grho, sx, sc, v1x, v2x, v1c, v2c, v2c_ud )
!
ENDIF
CALL xc_gcx( dfftp%nnr, nspin0, rhoaux, grho, sx, sc, v1x, v2x, v1c, v2c, v2c_ud )
!
v = v + e2*( v1x + v1c )
!