Fixed a bug in the j-average of KB pseudopotentials. Added some consistency

checks.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@1598 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
dalcorso 2005-01-31 15:04:50 +00:00
parent 4510639b1c
commit dff57459f8
1 changed files with 39 additions and 11 deletions

View File

@ -97,7 +97,8 @@ SUBROUTINE setup()
tipo, &! tipo, &!
is, &! is, &!
nb, &! nb, &!
nbe, & nbe, &!
ind, ind1, &!
l, &! l, &!
ibnd ! ibnd !
LOGICAL :: & LOGICAL :: &
@ -431,15 +432,26 @@ SUBROUTINE setup()
! !
IF ( l /= 0 ) THEN IF ( l /= 0 ) THEN
! !
vionl = ( ( l + 1.D0 ) * dion(nbe+1,nbe+1,nt) + & IF (ABS(jjj(nbe,nt)-lll(nbe,nt)+0.5d0).LT.1.d-7) THEN
l * dion(nbe,nbe,nt) ) / ( 2.D0 * l + 1.D0 ) IF (ABS(jjj(nbe+1,nt)-lll(nbe+1,nt)-0.5d0).GT.1.d-7) &
call errore('setup','wrong beta functions',1)
ind=nbe+1
ind1=nbe
ELSE
IF (ABS(jjj(nbe+1,nt)-lll(nbe+1,nt)+0.5d0).GT.1.d-7) &
call errore('setup','wrong beta functions',1)
ind=nbe
ind1=nbe+1
ENDIF
!
vionl = ( ( l + 1.D0 ) * dion(ind,ind,nt) + &
l * dion(ind1,ind1,nt) ) / ( 2.D0 * l + 1.D0 )
! !
betar(1:mesh(nt),nb,nt) = 1.D0 / ( 2.D0 * l + 1.D0 ) * & betar(1:mesh(nt),nb,nt) = 1.D0 / ( 2.D0 * l + 1.D0 ) * &
( ( l + 1.D0 ) * SQRT( dion(nbe+1,nbe+1,nt) / vionl ) * & ( ( l + 1.D0 ) * SQRT( dion(ind,ind,nt) / vionl ) * &
betar(1:mesh(nt),nbe+1,nt) + & betar(1:mesh(nt),ind,nt) + &
l * SQRT( dion(nbe,nbe,nt) / vionl ) * & l * SQRT( dion(ind1,ind1,nt) / vionl ) * &
betar(1:mesh(nt),nbe,nt) ) betar(1:mesh(nt),ind1,nt) )
! !
dion(nb,nb,nt) = vionl dion(nb,nb,nt) = vionl
! !
@ -453,6 +465,8 @@ SUBROUTINE setup()
! !
END IF END IF
! !
lll(nb,nt)=lll(nbe,nt)
!
END DO END DO
! !
nbe = 0 nbe = 0
@ -462,7 +476,7 @@ SUBROUTINE setup()
nbe = nbe + 1 nbe = nbe + 1
! !
IF ( lchi(nb,nt) /= 0 .AND. & IF ( lchi(nb,nt) /= 0 .AND. &
ABS( jchi(nb,nt) - lchi(nb,nt) - 0.5D0 ) < 1.D-7 ) nbe = nbe - 1 ABS(jchi(nb,nt)-lchi(nb,nt)-0.5D0 ) < 1.D-7 ) nbe = nbe - 1
! !
END DO END DO
! !
@ -478,8 +492,20 @@ SUBROUTINE setup()
! !
IF ( l /= 0 ) THEN IF ( l /= 0 ) THEN
! !
chi(1:mesh(nt),nb,nt)=( ( l + 1.D0 ) * chi(1:mesh(nt),nbe+1,nt)+ & IF (ABS(jchi(nbe,nt)-lchi(nbe,nt)+0.5d0).LT.1.d-7) THEN
l * chi(1:mesh(nt),nbe,nt)) / ( 2.D0 * l + 1.D0 ) IF (ABS(jchi(nbe+1,nt)-lchi(nbe+1,nt)-0.5d0).GT.1.d-7) &
call errore('setup','wrong chi functions',1)
ind=nbe+1
ind1=nbe
ELSE
IF (ABS(jchi(nbe+1,nt)-lchi(nbe+1,nt)+0.5d0).GT.1.d-7) &
call errore('setup','wrong chi functions',1)
ind=nbe
ind1=nbe+1
END IF
!
chi(1:mesh(nt),nb,nt)=((l+1.D0) * chi(1:mesh(nt),ind,nt)+ &
l * chi(1:mesh(nt),ind1,nt)) / ( 2.D0 * l + 1.D0 )
nbe = nbe + 1 nbe = nbe + 1
! !
@ -489,6 +515,8 @@ SUBROUTINE setup()
! !
END IF END IF
! !
lchi(nb,nt)= lchi(nbe,nt)
!
END DO END DO
! !
END IF END IF