Some cleaning in cg_sub,

now pc2 in cglib and gram in cplib
correctly return the updated bec's

P.U.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2964 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
umari 2006-03-27 10:57:25 +00:00
parent 26987d2472
commit 8bda0be46e
3 changed files with 24 additions and 42 deletions

View File

@ -146,7 +146,7 @@
call gram(betae,bec,nhsa,c0,ngw,n)
call calbec(1,nsp,eigr,c0,bec)
!call calbec(1,nsp,eigr,c0,bec)
!calculates phi for pcdaga
@ -244,20 +244,13 @@
!
!---ensemble-DFT
call vofrho(nfi,rhor,rhog,rhos,rhoc,tfirst,tlast, &
& ei1,ei2,ei3,irb,eigrb,sfac,tau0,fion)
if (.not.tens) then
call vofrho(nfi,rhor,rhog,rhos,rhoc,tfirst,tlast, &
& ei1,ei2,ei3,irb,eigrb,sfac,tau0,fion)
etotnew=etot
else
call compute_entropy2( entropy, f, n, nspin )
call vofrho(nfi,rhor,rhog,rhos,rhoc,tfirst,tlast, &
& ei1,ei2,ei3,irb,eigrb,sfac,tau0,fion)
etotnew=etot+entropy
end if
if(tefield ) then!just in this case calculates elfield stuff at zeo field-->to be bettered
@ -360,7 +353,6 @@
if(tens) call calcmt(f,z0,fmat0)
call calbec(1,nsp,eigr,gi,becm)
call calbec(1,nsp,eigr,hpsi,bec0)
! calculates gamma
@ -469,7 +461,6 @@
call calbec(1,nsp,eigr,hi,bec0)
call pc2(c0,bec,hi,bec0)
call calbec(1,nsp,eigr,hi,bec0)
!do quadratic minimization
!
@ -525,7 +516,7 @@
call calbec(1,nsp,eigr,cm,becm)
call gram(betae,becm,nhsa,cm,ngw,n)
call calbec(1,nsp,eigr,cm,becm)
!call calbec(1,nsp,eigr,cm,becm)
!calculate energy
if(.not.tens) then
@ -546,13 +537,8 @@
!
if (nlcc_any) call set_cc(irb,eigrb,rhoc)
!
if (.not.tens) then
call vofrho(nfi,rhor,rhog,rhos,rhoc,tfirst,tlast, &
call vofrho(nfi,rhor,rhog,rhos,rhoc,tfirst,tlast, &
& ei1,ei2,ei3,irb,eigrb,sfac,tau0,fion)
else
call vofrho(nfi,rhor,rhog,rhos,rhoc,tfirst,tlast, &
& ei1,ei2,ei3,irb,eigrb,sfac,tau0,fion)
end if
if( tefield ) then!to be bettered
call berry_energy( enb, enbi, becm, cm(:,:,1,1), fion )
@ -593,7 +579,7 @@
!test on energy: check the energy has really diminished
call calbec(1,nsp,eigr,cm,becm)
!call calbec(1,nsp,eigr,cm,becm)
if(.not.tens) then
call rhoofr(nfi,cm(:,:,1,1),irb,eigrb,becm,rhovan,rhor,rhog,rhos,enl,ekin)
else
@ -611,13 +597,9 @@
!
if (nlcc_any) call set_cc(irb,eigrb,rhoc)
!
if (.not.tens) then
call vofrho(nfi,rhor,rhog,rhos,rhoc,tfirst,tlast, &
call vofrho(nfi,rhor,rhog,rhos,rhoc,tfirst,tlast, &
& ei1,ei2,ei3,irb,eigrb,sfac,tau0,fion)
else
call vofrho(nfi,rhor,rhog,rhos,rhoc,tfirst,tlast, &
& ei1,ei2,ei3,irb,eigrb,sfac,tau0,fion)
end if
if( tefield ) then!to be bettered
call berry_energy( enb, enbi, becm, cm(:,:,1,1), fion )
etot=etot+enb+enbi
@ -705,14 +687,9 @@
!
if (nlcc_any) call set_cc(irb,eigrb,rhoc)
!
if (.not.tens) then
call vofrho(nfi,rhor,rhog,rhos,rhoc,tfirst,tlast, &
call vofrho(nfi,rhor,rhog,rhos,rhoc,tfirst,tlast, &
& ei1,ei2,ei3,irb,eigrb,sfac,tau0,fion)
else
call vofrho(nfi,rhor,rhog,rhos,rhoc,tfirst,tlast, &
& ei1,ei2,ei3,irb,eigrb,sfac,tau0,fion)
end if
if( tefield) then !to be bettered
call berry_energy( enb, enbi, becm, cm(:,:,1,1), fion )
etot=etot+enb+enbi
@ -737,9 +714,9 @@
if(tens.and.newscheme) enever=enever-entropy
call calbec (1,nsp,eigr,c0,bec)
if(.not. ene_ok) call calbec (1,nsp,eigr,c0,bec)
!calculates phi for pc_daga
!call calphiid(c0,bec,betae,phi)
CALL calphi( c0, SIZE(c0,1), bec, nhsa, betae, phi, n )
!=======================================================================

View File

@ -181,7 +181,8 @@ subroutine pc2(a,beca,b,becb)
! a input :unperturbed wavefunctions
! b input :first order wavefunctions
! b output:b_i =b_i-a_j><a_j|S|b_i>
use kinds, only: dp
use ions_base, only: na, nsp
use io_global, only: stdout
use mp_global, only: intra_image_comm
@ -198,13 +199,15 @@ subroutine pc2(a,beca,b,becb)
implicit none
complex(8) a(ngw,n), b(ngw,n)
complex(kind=DP) a(ngw,n), b(ngw,n)
real(8) beca(nhsa,n),becb(nhsa,n)
real(kind=DP) beca(nhsa,n),becb(nhsa,n)
! local variables
integer is, iv, jv, ia, inl, jnl, i, j,ig
real(8) sca
real(kind=DP) sca
real(kind=DP) becp(nhsa)
do i=1,n
becp(:)=0.d0
do j=1,n
sca=0.
if (ng0.eq.2) then
@ -238,13 +241,15 @@ subroutine pc2(a,beca,b,becb)
do ig=1,ngw
b(ig,i)=b(ig,i)-sca*a(ig,j)
enddo
!it also update becb
becp(:)=becp(:)-beca(:,j)*sca
! this to prevent numerical errors
if (ng0.eq.2) then
b(1,i)=0.5d0*(b(1,i)+CONJG(b(1,i)))
endif
endif
enddo
becb(:,i)=becb(:,i)-becp(:)
enddo
return
end subroutine pc2

View File

@ -1297,7 +1297,7 @@
! corresponing bec: bec(i)=<cp(i)|beta>-csc(k)<cp(k)|beta>
!
DO k=1,kmax
DO inl=1,nhsavb
DO inl=1,nkbx
bec(inl,i)=bec(inl,i)-csc(k)*bec(inl,k)
END DO
END DO
@ -1345,7 +1345,7 @@
!
! these are the final bec's
!
CALL DSCAL( nhsavb, 1.0/anorm, bec(1,i), 1 )
CALL DSCAL( nkbx, 1.0/anorm, bec(1,i), 1 )
END DO
!
DEALLOCATE( csc )