scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

More cleanup (?) in <beta|psi> calculation 

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@4489 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2007-12-03 15:52:40 +00:00
parent faf814c72b
commit 25a3f97092
5 changed files with 49 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
PW/force_us.f90
View File

@ -30,6 +30,8 @@ SUBROUTINE force_us( forcenl )
USE spin_orb, ONLY : lspinorb
USE io_files, ONLY : iunwfc, nwordwfc, iunigk
USE buffers, ONLY : get_buffer
USE becmod, ONLY : allocate_bec, deallocate_bec, &
rbecp, becp, becp_nc
!
IMPLICIT NONE
!
@ -38,6 +40,7 @@ SUBROUTINE force_us( forcenl )
REAL(DP) :: forcenl(3,nat)
! output: the nonlocal contribution
!
CALL allocate_bec ( nkb, nbnd )
!
IF ( gamma_only ) THEN
!
@ -49,6 +52,8 @@ SUBROUTINE force_us( forcenl )
!
END IF
!
CALL deallocate_bec ( )
!
RETURN
!
CONTAINS
@ -61,8 +66,8 @@ SUBROUTINE force_us( forcenl )
!
IMPLICIT NONE
!
REAL(DP), ALLOCATABLE :: becp(:,:), dbecp (:,:,:)
! auxiliary variables contain <beta|psi> and <dbeta|psi>
REAL(DP), ALLOCATABLE :: rdbecp (:,:,:)
! auxiliary variable, contains <dbeta|psi>
COMPLEX(DP), ALLOCATABLE :: vkb1(:,:)
! auxiliary variable contains g*|beta>
REAL(DP) :: ps
@ -72,7 +77,7 @@ SUBROUTINE force_us( forcenl )
!
forcenl(:,:) = 0.D0
!
ALLOCATE( becp( nkb, nbnd ), dbecp( nkb, nbnd, 3 ) )
ALLOCATE( rdbecp( nkb, nbnd, 3 ) )
ALLOCATE( vkb1( npwx, nkb ) )
!
IF ( nks > 1 ) REWIND iunigk
@ -102,7 +107,7 @@ SUBROUTINE force_us( forcenl )
!
IF ( nkb > 0 ) &
CALL pw_gemm( 'Y', nkb, nbnd, npw, vkb1, npwx, evc, npwx, &
dbecp(1,1,ipol), nkb )
rdbecp(1,1,ipol), nkb )
!
END DO
!
@ -118,7 +123,7 @@ SUBROUTINE force_us( forcenl )
DO ipol = 1, 3
forcenl(ipol,na) = forcenl(ipol,na) - &
ps * wg(ibnd,ik) * 2.D0 * tpiba * &
dbecp(ikb,ibnd,ipol) * becp(ikb,ibnd)
rdbecp(ikb,ibnd,ipol) * becp(ikb,ibnd)
END DO
END DO
!
@ -136,8 +141,8 @@ SUBROUTINE force_us( forcenl )
DO ipol = 1, 3
forcenl(ipol,na) = forcenl(ipol,na) - &
ps * wg(ibnd,ik) * 2.d0 * tpiba * &
( dbecp(ikb,ibnd,ipol) * becp(jkb,ibnd) + &
dbecp(jkb,ibnd,ipol) * becp(ikb,ibnd) )
(rdbecp(ikb,ibnd,ipol) * becp(jkb,ibnd) + &
rdbecp(jkb,ibnd,ipol) * becp(ikb,ibnd) )
END DO
END DO
END DO
@ -182,7 +187,7 @@ SUBROUTINE force_us( forcenl )
END DO
!
DEALLOCATE( vkb1 )
DEALLOCATE( becp, dbecp )
DEALLOCATE(rdbecp )
!
RETURN
!
@ -194,8 +199,7 @@ SUBROUTINE force_us( forcenl )
!
IMPLICIT NONE
!
COMPLEX(DP), ALLOCATABLE :: becp(:,:), dbecp(:,:,:)
COMPLEX(DP), ALLOCATABLE :: becp_nc(:,:,:), dbecp_nc(:,:,:,:)
COMPLEX(DP), ALLOCATABLE :: dbecp(:,:,:), dbecp_nc(:,:,:,:)
! auxiliary variable contains <beta|psi> and <dbeta|psi>
COMPLEX(DP), ALLOCATABLE :: vkb1(:,:)
! auxiliary variable contains g*|beta>
@ -209,9 +213,9 @@ SUBROUTINE force_us( forcenl )
forcenl(:,:) = 0.D0
!
IF (noncolin) then
ALLOCATE( becp_nc(nkb,npol,nbnd), dbecp_nc(nkb,npol,nbnd,3) )
ALLOCATE( dbecp_nc(nkb,npol,nbnd,3) )
ELSE
ALLOCATE( becp( nkb, nbnd ), dbecp( nkb, nbnd, 3 ) )
ALLOCATE( dbecp( nkb, nbnd, 3 ) )
ENDIF
ALLOCATE( vkb1( npwx, nkb ) )
!
@ -379,9 +383,9 @@ SUBROUTINE force_us( forcenl )
!
DEALLOCATE( vkb1 )
IF (noncolin) THEN
DEALLOCATE( becp_nc, dbecp_nc )
DEALLOCATE( dbecp_nc )
ELSE
DEALLOCATE( becp, dbecp )
DEALLOCATE( dbecp )
ENDIF
!
! ... The total D matrix depends on the ionic position via the

3
PW/make.depend
View File

@ -450,6 +450,7 @@ force_us.o : ../Modules/ions_base.o
force_us.o : ../Modules/kind.o
force_us.o : ../Modules/uspp.o
force_us.o : ../Modules/wavefunctions.o
force_us.o : becmod.o
force_us.o : buffers.o
force_us.o : noncol.o
force_us.o : pwcom.o
@ -1176,6 +1177,7 @@ stres_us.o : ../Modules/kind.o
stres_us.o : ../Modules/mp_global.o
stres_us.o : ../Modules/uspp.o
stres_us.o : ../Modules/wavefunctions.o
stres_us.o : becmod.o
stres_us.o : noncol.o
stres_us.o : pwcom.o
stress.o : ../Modules/cell_base.o
@ -1201,6 +1203,7 @@ sum_band.o : ../Modules/mp_global.o
sum_band.o : ../Modules/paw_variables.o
sum_band.o : ../Modules/uspp.o
sum_band.o : ../Modules/wavefunctions.o
sum_band.o : becmod.o
sum_band.o : buffers.o
sum_band.o : noncol.o
sum_band.o : paw_onecenter.o

22
PW/orthoatwfc.f90
View File

@ -24,7 +24,7 @@ SUBROUTINE orthoatwfc
USE ldaU, ONLY : swfcatom, U_projection
USE wvfct, ONLY : npwx, npw, igk
USE uspp, ONLY : nkb, vkb
USE becmod, ONLY : becp, rbecp, becp_nc
USE becmod, ONLY : allocate_bec, deallocate_bec, becp, rbecp, becp_nc
USE control_flags, ONLY : gamma_only
USE noncollin_module, ONLY : noncolin, npol
!
@ -82,15 +82,7 @@ SUBROUTINE orthoatwfc
END IF
! Allocate the array becp = <beta|wfcatom>
IF ( gamma_only ) THEN
ALLOCATE (rbecp (nkb,natomwfc))
ELSE
IF (noncolin) THEN
ALLOCATE ( becp_nc (nkb, npol, natomwfc))
ELSE
ALLOCATE ( becp (nkb,natomwfc))
END IF
END IF
CALL allocate_bec (nkb,natomwfc)
IF (nks > 1) REWIND (iunigk)
@ -198,15 +190,7 @@ SUBROUTINE orthoatwfc
DEALLOCATE (work)
DEALLOCATE (e)
DEALLOCATE (wfcatom)
IF ( gamma_only ) THEN
DEALLOCATE (rbecp)
ELSE
IF (noncolin) THEN
DEALLOCATE (becp_nc)
ELSE
DEALLOCATE (becp)
END IF
END IF
CALL deallocate_bec ( )
!
RETURN

30
PW/stres_us.f90
View File

@ -26,6 +26,8 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
USE spin_orb, ONLY : lspinorb
USE noncollin_module, ONLY : noncolin, npol
USE mp_global, ONLY : me_pool, root_pool
USE becmod, ONLY : allocate_bec, deallocate_bec, &
rbecp, becp, becp_nc
!
IMPLICIT NONE
!
@ -34,6 +36,7 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
INTEGER :: ik
REAL(DP) :: sigmanlc(3,3), gk(3,npw)
!
CALL allocate_bec ( nkb, nbnd )
!
IF ( gamma_only ) THEN
!
@ -43,7 +46,9 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
!
CALL stres_us_k()
!
END IF
END IF
!
CALL deallocate_bec ( )
!
RETURN
!
@ -63,7 +68,6 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
ikb, jkb, ih, jh, ijkb0
REAL(DP) :: fac, xyz(3,3), q, evps, DDOT
REAL(DP), ALLOCATABLE :: qm1(:)
REAL(DP), ALLOCATABLE :: becp(:,:)
COMPLEX(DP), ALLOCATABLE :: work1(:), work2(:), dvkb(:,:)
! dvkb contains the derivatives of the kb potential
COMPLEX(DP) :: ps
@ -76,9 +80,7 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
IF ( lsda ) current_spin = isk(ik)
IF ( nks > 1 ) CALL init_us_2( npw, igk, xk(1,ik), vkb )
!
ALLOCATE( becp( nkb, nbnd ) )
!
CALL pw_gemm( 'Y', nkb, nbnd, npw, vkb, npwx, evc, npwx, becp, nkb )
CALL pw_gemm( 'Y', nkb, nbnd, npw, vkb, npwx, evc, npwx, rbecp, nkb )
!
ALLOCATE( work1( npwx ), work2( npwx ), qm1( npwx ) )
!
@ -110,7 +112,7 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
ikb = ijkb0 + ih
ps = deeq(ih,ih,na,current_spin) - &
et(ibnd,ik) * qq(ih,ih,np)
evps = evps + fac * ps * ABS( becp(ikb,ibnd) )**2
evps = evps + fac * ps * ABS( rbecp(ikb,ibnd) )**2
!
IF ( upf(np)%tvanp .OR. newpseudo(np) ) THEN
!
@ -124,7 +126,7 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
ps = deeq(ih,jh,na,current_spin) - &
et(ibnd,ik) * qq(ih,jh,np)
evps = evps + ps * fac * 2.D0 * &
becp(ikb,ibnd) * becp(jkb,ibnd)
rbecp(ikb,ibnd) * rbecp(jkb,ibnd)
END DO
END IF
END DO
@ -151,7 +153,7 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
DO ih = 1, nh(np)
ikb = ijkb0 + ih
IF ( .NOT. ( upf(np)%tvanp .OR. newpseudo(np) ) ) THEN
ps = becp(ikb,ibnd) * &
ps = rbecp(ikb,ibnd) * &
( deeq(ih,ih,na,current_spin) - &
et(ibnd,ik) * qq(ih,ih,np) )
ELSE
@ -162,7 +164,7 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
ps = (0.D0,0.D0)
DO jh = 1, nh(np)
jkb = ijkb0 + jh
ps = ps + becp(jkb,ibnd) * &
ps = ps + rbecp(jkb,ibnd) * &
( deeq(ih,jh,na,current_spin) - &
et(ibnd,ik) * qq(ih,jh,np) )
END DO
@ -204,7 +206,7 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
DO ih = 1, nh(np)
ikb = ijkb0 + ih
IF ( .NOT. ( upf(np)%tvanp .OR. newpseudo(np) ) ) THEN
ps = becp(ikb,ibnd) * &
ps = rbecp(ikb,ibnd) * &
( deeq(ih,ih,na,current_spin) - &
et(ibnd,ik) * qq(ih,ih,np ) )
ELSE
@ -215,7 +217,7 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
ps = (0.D0,0.D0)
DO jh = 1, nh(np)
jkb = ijkb0 + jh
ps = ps + becp(jkb,ibnd) * &
ps = ps + rbecp(jkb,ibnd) * &
( deeq(ih,jh,na,current_spin) - &
et(ibnd,ik) * qq(ih,jh,np) )
END DO
@ -246,7 +248,6 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
sigmanlc(l,l) = sigmanlc(l,l) - evps
END DO
!
DEALLOCATE( becp )
DEALLOCATE( dvkb )
DEALLOCATE( qm1, work2, work1 )
!
@ -269,7 +270,6 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
ikb, jkb, ih, jh, ijkb0, is, js, ijs
REAL(DP) :: fac, xyz (3, 3), q, evps, DDOT
REAL(DP), ALLOCATABLE :: qm1(:)
COMPLEX(DP), ALLOCATABLE :: becp(:,:), becp_nc(:,:,:)
COMPLEX(DP), ALLOCATABLE :: work1(:), work2(:), dvkb(:,:)
COMPLEX(DP), ALLOCATABLE :: work2_nc(:,:)
! dvkb contains the derivatives of the kb potential
@ -284,11 +284,9 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
IF ( nks > 1 ) CALL init_us_2( npw, igk, xk(1,ik), vkb )
!
if (noncolin) then
ALLOCATE( becp_nc( nkb, npol, nbnd ) )
CALL ccalbec_nc( nkb, npwx, npw, npol, nbnd, becp_nc, vkb, evc )
ALLOCATE( work2_nc(npwx,npol) )
else
ALLOCATE( becp( nkb, nbnd ) )
CALL ccalbec( nkb, npwx, npw, nbnd, becp, vkb, evc )
endif
!
@ -609,10 +607,8 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
10 CONTINUE
!
IF (noncolin) THEN
DEALLOCATE( becp_nc )
DEALLOCATE( work2_nc )
ELSE
DEALLOCATE( becp )
DEALLOCATE( work2 )
ENDIF
DEALLOCATE( dvkb )

40
PW/sum_band.f90
View File

@ -44,6 +44,8 @@ SUBROUTINE sum_band()
USE funct, ONLY : dft_is_meta
USE paw_onecenter, ONLY : PAW_symmetrize
USE paw_variables, ONLY : okpaw
USE becmod, ONLY : allocate_bec, deallocate_bec, &
becp, rbecp, becp_nc
!
IMPLICIT NONE
!
@ -101,6 +103,8 @@ SUBROUTINE sum_band()
! ... Needed for LDA+U
!
IF ( lda_plus_u ) CALL new_ns(rho%ns)
!
IF ( okvan ) CALL allocate_bec (nkb,nbnd)
!
! ... specific routines are called to sum for each k point the contribution
! ... of the wavefunctions to the charge
@ -115,6 +119,7 @@ SUBROUTINE sum_band()
!
END IF
!
IF ( okvan ) CALL deallocate_bec ( )
!
! ... If a double grid is used, interpolate onto the fine grid
!
@ -269,12 +274,8 @@ SUBROUTINE sum_band()
!
REAL(DP) :: w1, w2
! weights
REAL(DP), ALLOCATABLE :: becp(:,:)
! contains <beta|psi>
!
!
ALLOCATE( becp( nkb, nbnd ) )
!
! ... here we sum for each k point the contribution
! ... of the wavefunctions to the charge
!
@ -396,7 +397,7 @@ SUBROUTINE sum_band()
IF ( .NOT. okvan ) CYCLE k_loop
!
IF ( nkb > 0 ) &
CALL ccalbec( nkb, npwx, npw, nbnd, becp, vkb, evc )
CALL ccalbec( nkb, npwx, npw, nbnd, rbecp, vkb, evc )
!
CALL start_clock( 'sum_band:becsum' )
!
@ -421,7 +422,7 @@ SUBROUTINE sum_band()
!
becsum(ijh,na,current_spin) = &
becsum(ijh,na,current_spin) + &
w1 * becp(ikb,ibnd) * becp(ikb,ibnd)
w1 *rbecp(ikb,ibnd) *rbecp(ikb,ibnd)
!
ijh = ijh + 1
!
@ -431,7 +432,7 @@ SUBROUTINE sum_band()
!
becsum(ijh,na,current_spin) = &
becsum(ijh,na,current_spin) + &
w1 * 2.D0 * becp(ikb,ibnd) * becp(jkb,ibnd)
w1 * 2.D0 *rbecp(ikb,ibnd) *rbecp(jkb,ibnd)
!
ijh = ijh + 1
!
@ -463,8 +464,6 @@ SUBROUTINE sum_band()
!
END DO k_loop
!
DEALLOCATE( becp )
!
RETURN
!
END SUBROUTINE sum_band_gamma
@ -482,22 +481,14 @@ SUBROUTINE sum_band()
!
REAL(DP) :: w1
! weights
COMPLEX(DP), ALLOCATABLE :: becp(:,:), becp_nc(:,:,:)
! contains <beta|psi>
!
COMPLEX(DP), ALLOCATABLE :: becsum_nc(:,:,:,:)
!
INTEGER :: ipol, kh, kkb, is1, is2, js
!
IF (okvan) THEN
IF (noncolin) THEN
ALLOCATE(becsum_nc(nhm*(nhm+1)/2,nat,npol,npol))
becsum_nc=(0.d0, 0.d0)
ALLOCATE( becp_nc( nkb, npol, nbnd ) )
ELSE
ALLOCATE( becp( nkb, nbnd ) )
END IF
IF (okvan .AND. noncolin) THEN
ALLOCATE(becsum_nc(nhm*(nhm+1)/2,nat,npol,npol))
becsum_nc=(0.d0, 0.d0)
ENDIF
!
! ... here we sum for each k point the contribution
@ -744,14 +735,7 @@ SUBROUTINE sum_band()
END DO
END IF
!
IF (okvan) THEN
IF (noncolin) THEN
DEALLOCATE( becsum_nc )
DEALLOCATE( becp_nc )
ELSE
DEALLOCATE( becp )
ENDIF
END IF
IF ( ALLOCATED (becsum_nc) ) DEALLOCATE( becsum_nc )
!
RETURN
!