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

- Bug fix, computation of empty states with FPMD 

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@3108 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
cavazzon 2006-05-09 11:28:40 +00:00
parent 9bf6f54875
commit 7f179aeefb
7 changed files with 132 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
CPV/emptystates.f90
View File

@ -23,15 +23,15 @@
PRIVATE PRIVATE
INTEGER :: max_emp = 0 ! maximum number of iterations INTEGER :: max_emp = 0 ! maximum number of iterations
REAL(DP) :: ethr_emp ! threshold for convergence REAL(DP) :: ethr_emp ! threshold for convergence
REAL(DP) :: delt_emp ! delt for the empty states updating REAL(DP) :: delt_emp ! delt for the empty states updating
REAL(DP) :: emass_emp ! fictitious mass for the empty states REAL(DP) :: emass_emp ! fictitious mass for the empty states
LOGICAL :: prn_emp = .FALSE. LOGICAL :: prn_emp = .FALSE.
CHARACTER(LEN=256) :: fileempty CHARACTER(LEN=256) :: fileempty
LOGICAL :: first = .TRUE. LOGICAL :: first = .TRUE.
INTERFACE EMPTY INTERFACE EMPTY
MODULE PROCEDURE EMPTY_SD MODULE PROCEDURE EMPTY_SD
@ -76,14 +76,14 @@
LOGICAL FUNCTION readempty( c_emp, wempt ) LOGICAL FUNCTION readempty( c_emp, wempt )
! ... This subroutine reads empty states from unit emptyunit ! ... This subroutine reads empty states from unit emptyunit
USE wave_types, ONLY: wave_descriptor USE wave_types, ONLY: wave_descriptor
USE mp_global, ONLY: me_image, nproc_image, intra_image_comm USE mp_global, ONLY: me_image, nproc_image, intra_image_comm
USE io_global, ONLY: stdout, ionode, ionode_id USE io_global, ONLY: stdout, ionode, ionode_id
USE mp, ONLY: mp_bcast USE mp, ONLY: mp_bcast
USE mp_wave, ONLY: splitwf USE mp_wave, ONLY: splitwf
USE io_files, ONLY: scradir USE io_files, ONLY: scradir
USE reciprocal_vectors, ONLY: ig_l2g USE reciprocal_vectors, ONLY: ig_l2g
IMPLICIT none IMPLICIT none
@ -97,9 +97,10 @@
INTEGER :: nk, ne(2), ngwm_g, nspin INTEGER :: nk, ne(2), ngwm_g, nspin
COMPLEX(DP), ALLOCATABLE :: ctmp(:) COMPLEX(DP), ALLOCATABLE :: ctmp(:)
!
! ... Subroutine Body !
! ! ... Subroutine Body
!
IF( wempt%nspin < 1 .OR. wempt%nspin > 2 ) & IF( wempt%nspin < 1 .OR. wempt%nspin > 2 ) &
CALL errore( ' readempty ', ' nspin out of range ', 1 ) CALL errore( ' readempty ', ' nspin out of range ', 1 )
@ -176,7 +177,7 @@
SUBROUTINE writeempty( c_emp, wempt ) SUBROUTINE writeempty( c_emp, wempt )
! ... This subroutine writes empty states to unit emptyunit ! ... This subroutine writes empty states to unit emptyunit
USE wave_types, ONLY: wave_descriptor USE wave_types, ONLY: wave_descriptor
USE mp_global, ONLY: me_image, nproc_image, intra_image_comm USE mp_global, ONLY: me_image, nproc_image, intra_image_comm
@ -191,9 +192,9 @@
INTEGER :: ig, i, ik, nl, ne(2), ngwm_g, nk, ispin, nspin, ngw INTEGER :: ig, i, ik, nl, ne(2), ngwm_g, nk, ispin, nspin, ngw
LOGICAL :: exst LOGICAL :: exst
COMPLEX(DP), ALLOCATABLE :: ctmp(:) COMPLEX(DP), ALLOCATABLE :: ctmp(:)
! !
! ... Subroutine Body ! ... Subroutine Body
! !
IF( wempt%nspin < 1 .OR. wempt%nspin > 2 ) & IF( wempt%nspin < 1 .OR. wempt%nspin > 2 ) &
CALL errore( ' writeempty ', ' nspin out of range ', 1 ) CALL errore( ' writeempty ', ' nspin out of range ', 1 )
@ -246,33 +247,34 @@
SUBROUTINE gram_empty( ispin, tortho, cf, wfill, ce, wempt ) SUBROUTINE gram_empty( ispin, tortho, cf, wfill, ce, wempt )
! This subroutine orthogonalize the empty states CE to the ! This subroutine orthogonalize the empty states CE to the
! filled states CF using gram-shmitd . ! filled states CF using gram-shmitd .
! If TORTHO is FALSE the subroutine orthonormalizes the ! If TORTHO is FALSE the subroutine orthonormalizes the
! empty states CE and orthogonalize them to the CF states. ! empty states CE and orthogonalize them to the CF states.
USE wave_types, ONLY: wave_descriptor USE wave_types, ONLY: wave_descriptor
USE mp, ONLY: mp_sum USE mp, ONLY: mp_sum
USE mp_global, ONLY: nproc_image, intra_image_comm USE mp_global, ONLY: nproc_image, intra_image_comm
REAL(DP) SQRT, DNRM2 REAL(DP) SQRT, DNRM2
! ... ARGUMENTS ! ... ARGUMENTS
LOGICAL, INTENT(IN) :: TORTHO LOGICAL, INTENT(IN) :: TORTHO
COMPLEX(DP), INTENT(INOUT) :: CF(:,:), CE(:,:) COMPLEX(DP), INTENT(INOUT) :: CF(:,:), CE(:,:)
type (wave_descriptor), INTENT(IN) :: wfill, wempt type (wave_descriptor), INTENT(IN) :: wfill, wempt
INTEGER, INTENT(IN) :: ispin INTEGER, INTENT(IN) :: ispin
! ... LOCALS ! ... LOCALS
INTEGER :: i, j, ig, NF, NE, NGW, ldw INTEGER :: i, j, ig, NF, NE, NGW, ldw
REAL(DP) :: ANORM REAL(DP) :: ANORM
REAL(DP) , ALLOCATABLE :: SF(:), SE(:), TEMP(:) REAL(DP) , ALLOCATABLE :: SF(:), SE(:), TEMP(:)
COMPLEX(DP), ALLOCATABLE :: CSF(:), CSE(:), CTEMP(:) COMPLEX(DP), ALLOCATABLE :: CSF(:), CSE(:), CTEMP(:)
COMPLEX(DP) :: czero, cone, cmone COMPLEX(DP) :: czero, cone, cmone
! !
! ... SUBROUTINE BODY ! ... SUBROUTINE BODY
! !
NF = wfill%nbl( ispin ) NF = wfill%nbl( ispin )
NE = wempt%nbl( ispin ) NE = wempt%nbl( ispin )
NGW = wfill%ngwl NGW = wfill%ngwl
@ -370,22 +372,24 @@
USE control_flags, ONLY: force_pairing, gamma_only USE control_flags, ONLY: force_pairing, gamma_only
USE wave_functions, ONLY: wave_rand_init USE wave_functions, ONLY: wave_rand_init
! ... Arguments ! ... Arguments
COMPLEX(DP), INTENT(INOUT) :: c_occ(:,:,:,:), c_emp(:,:,:,:) COMPLEX(DP), INTENT(INOUT) :: c_occ(:,:,:,:), c_emp(:,:,:,:)
TYPE (wave_descriptor), INTENT(IN) :: wfill, wempt TYPE (wave_descriptor), INTENT(IN) :: wfill, wempt
REAL(DP) :: ampre REAL(DP) :: ampre
! ... Locals ! ... Locals
INTEGER :: ig_local INTEGER :: ig_local
INTEGER :: ngw, ngwt INTEGER :: ngw, ngwt
INTEGER :: ib, ik, ispin, ispin_wfc INTEGER :: ib, ik, ispin, ispin_wfc
LOGICAL :: tortho = .FALSE. LOGICAL :: tortho = .FALSE.
COMPLEX(DP), ALLOCATABLE :: pwt( : ) COMPLEX(DP), ALLOCATABLE :: pwt( : )
! !
! ... Subroutine body ! ... Subroutine body
! ... initialize the wave functions in such a way that the values ! ... initialize the wave functions in such a way that the values
! ... of the components are independent on the number of processors ! ... of the components are independent on the number of processors
ngwt = wfill%ngwt ngwt = wfill%ngwt
ngw = wfill%ngwl ngw = wfill%ngwl
@ -458,6 +462,8 @@
INTEGER :: i, k, j, iter, ik, nk INTEGER :: i, k, j, iter, ik, nk
INTEGER :: nspin, ispin, ispin_wfc INTEGER :: nspin, ispin, ispin_wfc
INTEGER :: n_occ( wfill%nspin ) INTEGER :: n_occ( wfill%nspin )
INTEGER :: nupdwn_emp( wfill%nspin )
INTEGER :: iupdwn_emp( wfill%nspin )
INTEGER :: ig, iprinte, iks, nrl, jl, ngw INTEGER :: ig, iprinte, iks, nrl, jl, ngw
REAL(DP) :: dek, ekinc, ekinc_old REAL(DP) :: dek, ekinc, ekinc_old
REAL(DP) :: ampre REAL(DP) :: ampre
@ -479,6 +485,10 @@
gamma = wfill%gamma gamma = wfill%gamma
ampre = 0.001d0 ampre = 0.001d0
nupdwn_emp = n_emp
iupdwn_emp(1) = 1
IF( nspin == 2 ) iupdwn_emp(2) = 1+n_emp
ekinc_old = 1.d+10 ekinc_old = 1.d+10
ekinc = 0.0d0 ekinc = 0.0d0
@ -517,10 +527,11 @@
CALL nlsm1 ( n_emp, 1, nspnl, eigr, c_emp( 1, 1, ik, ispin ), bece( 1, (ispin-1)*n_emp + 1 ) ) CALL nlsm1 ( n_emp, 1, nspnl, eigr, c_emp( 1, 1, ik, ispin ), bece( 1, (ispin-1)*n_emp + 1 ) )
CALL dforce_all( ispin, c_emp(:,:,1,ispin), wempt, fi(:,1,ispin), eforce(:,:,1,ispin), & CALL dforce_all( ispin, c_emp(:,:,1,ispin), fi(:,1,ispin), eforce(:,:,1,ispin), &
vpot(:,ispin), eigr, bece ) vpot(:,ispin), eigr, bece, nupdwn_emp, iupdwn_emp )
! ... Steepest descent ! ... Steepest descent
DO i = 1, n_emp DO i = 1, n_emp
cp_emp(:,i,ik,ispin) = c_emp(:,i,ik,ispin) + dt2bye(:) * eforce(:, i, ik, ispin) cp_emp(:,i,ik,ispin) = c_emp(:,i,ik,ispin) + dt2bye(:) * eforce(:, i, ik, ispin)
END DO END DO
@ -566,7 +577,7 @@
END DO ITERATIONS END DO ITERATIONS
CALL empty_eigs( tortho, c_emp, wempt, fi, vpot, eforce, eigr, bece ) CALL empty_eigs( tortho, c_emp, wempt, fi, vpot, eforce, eigr, bece, nupdwn_emp, iupdwn_emp )
CALL writeempty( c_emp, wempt ) CALL writeempty( c_emp, wempt )
@ -591,7 +602,7 @@
! !
!=----------------------------------------------------------------------------=! !=----------------------------------------------------------------------------=!
SUBROUTINE empty_eigs( tortho, c_emp, wempt, fi, vpot, eforce, eigr, bece) SUBROUTINE empty_eigs( tortho, c_emp, wempt, fi, vpot, eforce, eigr, bece, nupdwn_emp, iupdwn_emp)
USE wave_types, ONLY : wave_descriptor USE wave_types, ONLY : wave_descriptor
USE wave_constrains, ONLY : update_lambda USE wave_constrains, ONLY : update_lambda
@ -611,6 +622,7 @@
LOGICAL, INTENT(IN) :: TORTHO LOGICAL, INTENT(IN) :: TORTHO
COMPLEX(DP) :: eigr(:,:) COMPLEX(DP) :: eigr(:,:)
REAL (DP) :: bece(:,:) REAL (DP) :: bece(:,:)
INTEGER :: nupdwn_emp(:), iupdwn_emp(:)
! !
! ... LOCALS ! ... LOCALS
! !
@ -641,8 +653,8 @@
! ... Calculate | dH / dpsi(j) > ! ... Calculate | dH / dpsi(j) >
! !
CALL dforce_all( ispin, c_emp(:,:,1,ispin), wempt, fi(:,1,ispin), eforce(:,:,1,ispin), & CALL dforce_all( ispin, c_emp(:,:,1,ispin), fi(:,1,ispin), eforce(:,:,1,ispin), &
vpot(:,ispin), eigr, bece ) vpot(:,ispin), eigr, bece, nupdwn_emp, iupdwn_emp )
! ... Calculate Eij = < psi(i) | H | psi(j) > = < psi(i) | dH / dpsi(j) > ! ... Calculate Eij = < psi(i) | H | psi(j) > = < psi(i) | dH / dpsi(j) >
DO i = 1, n_emp DO i = 1, n_emp

51
CPV/forces.f90
View File

@ -35,8 +35,8 @@
SUBROUTINE dforce1( co, ce, dco, dce, fio, fie, hg, v, psi_stored ) SUBROUTINE dforce1( co, ce, dco, dce, fio, fie, hg, v, psi_stored )
USE fft_base, ONLY: dffts USE fft_base, ONLY: dffts
USE gvecw, ONLY: ngw USE gvecw, ONLY: ngw
USE fft_module, ONLY: fwfft, invfft USE fft_module, ONLY: fwfft, invfft
IMPLICIT NONE IMPLICIT NONE
@ -187,7 +187,6 @@
USE ions_base, ONLY: na USE ions_base, ONLY: na
USE pseudopotential, ONLY: nspnl USE pseudopotential, ONLY: nspnl
USE electrons_base, ONLY: iupdwn
USE uspp_param, only: nh USE uspp_param, only: nh
USE uspp, only: nhtol, nhtolm, indv, beta, dvan USE uspp, only: nhtol, nhtolm, indv, beta, dvan
use cvan, only: ish use cvan, only: ish
@ -262,24 +261,20 @@
SUBROUTINE dforce( ib, iss, c, cdesc, f, df, da, v, eigr, bec ) SUBROUTINE dforce( ib, iss, c, f, df, da, v, eigr, bec, nupdwn, iupdwn )
! !
USE wave_types, ONLY: wave_descriptor
USE turbo, ONLY: tturbo, nturbo, turbo_states
USE reciprocal_vectors, ONLY: ggp, g, gx USE reciprocal_vectors, ONLY: ggp, g, gx
USE electrons_base, ONLY: nupdwn, iupdwn
! !
IMPLICIT NONE IMPLICIT NONE
! !
INTEGER, INTENT(IN) :: ib, iss ! band and spin index INTEGER, INTENT(IN) :: ib, iss ! band and spin index
COMPLEX(DP), INTENT(IN) :: c(:,:) COMPLEX(DP), INTENT(IN) :: c(:,:)
COMPLEX(DP), INTENT(OUT) :: df(:), da(:) COMPLEX(DP), INTENT(OUT) :: df(:), da(:)
REAL (DP), INTENT(IN) :: v(:), bec(:,:), f(:) REAL (DP), INTENT(IN) :: v(:), bec(:,:), f(:)
COMPLEX(DP), INTENT(IN) :: eigr(:,:) COMPLEX(DP), INTENT(IN) :: eigr(:,:)
type (wave_descriptor), INTENT(IN) :: cdesc INTEGER, INTENT(IN) :: nupdwn(:), iupdwn(:)
! !
COMPLEX(DP), ALLOCATABLE :: dum( : ) COMPLEX(DP), ALLOCATABLE :: dum( : )
! COMPLEX(DP) :: df_( SIZE( df ) ) , da_( SIZE( da ) ) ! DEBUG
! !
INTEGER :: ig, in INTEGER :: ig, in
! !
@ -295,9 +290,6 @@
! !
CALL dforce2_bec( f(ib), f(ib), df , dum , eigr, bec( :, in ), bec( :, in ) ) CALL dforce2_bec( f(ib), f(ib), df , dum , eigr, bec( :, in ), bec( :, in ) )
! !
! CALL dforce2( f(ib), f(ib), df, dum, fnl(:,:,ib), &
! fnl(:,:,ib), g(:), gx(:,:), eigr, wsg, wnl )
!
DEALLOCATE( dum ) DEALLOCATE( dum )
! !
ELSE ELSE
@ -306,14 +298,6 @@
! !
CALL dforce2_bec( f(ib), f(ib+1), df, da, eigr, bec( :, in ), bec( :, in+1 ) ) CALL dforce2_bec( f(ib), f(ib+1), df, da, eigr, bec( :, in ), bec( :, in+1 ) )
! !
! CALL dforce2( f(ib), f(ib+1), df, da, fnl(:,:,ib), &
! fnl(:,:,ib+1), g(:), gx(:,:), eigr, wsg, wnl )
!
! DO ig = 1, SIZE( df ), 50
! WRITE(6,*) ig, df(ig), df_(ig)
! WRITE(6,*) ig, da(ig), da_(ig)
! END DO
!
END IF END IF
! !
return return
@ -321,34 +305,37 @@
! ---------------------------------------------- ! ----------------------------------------------
SUBROUTINE dforce_all( iss, c, f, cgrad, vpot, eigr, bec, nupdwn, iupdwn )
SUBROUTINE dforce_all( ispin, c, cdesc, f, cgrad, vpot, eigr, bec )
!
USE wave_types, ONLY: wave_descriptor
USE electrons_base, ONLY: nupdwn
! !
IMPLICIT NONE IMPLICIT NONE
INTEGER, INTENT(IN) :: ispin INTEGER, INTENT(IN) :: iss
COMPLEX(DP), INTENT(INOUT) :: c(:,:) COMPLEX(DP), INTENT(INOUT) :: c(:,:)
type (wave_descriptor), INTENT(IN) :: cdesc
REAL(DP), INTENT(IN) :: vpot(:), f(:) REAL(DP), INTENT(IN) :: vpot(:), f(:)
COMPLEX(DP), INTENT(OUT) :: cgrad(:,:) COMPLEX(DP), INTENT(OUT) :: cgrad(:,:)
COMPLEX(DP), INTENT(IN) :: eigr(:,:) COMPLEX(DP), INTENT(IN) :: eigr(:,:)
REAL(DP), INTENT(IN) :: bec(:,:) REAL(DP), INTENT(IN) :: bec(:,:)
INTEGER, INTENT(IN) :: nupdwn(:), iupdwn(:)
INTEGER :: ib INTEGER :: ib
! !
IF( nupdwn( ispin ) > 0 ) THEN IF( nupdwn( iss ) > 0 ) THEN
! !
! Process two states at the same time ! Process two states at the same time
! !
DO ib = 1, nupdwn( ispin ), 2 DO ib = 1, nupdwn( iss )-1, 2
CALL dforce( ib, ispin, c, cdesc, f, cgrad(:,ib), cgrad(:,ib+1), & CALL dforce( ib, iss, c, f, cgrad(:,ib), cgrad(:,ib+1), &
vpot, eigr, bec ) vpot, eigr, bec, nupdwn, iupdwn )
END DO END DO
! !
IF( MOD( nupdwn( iss ), 2 ) /= 0 ) THEN
ib = nupdwn( iss )
CALL dforce( ib, iss, c, f, cgrad(:,ib), cgrad(:,ib), &
vpot, eigr, bec, nupdwn, iupdwn )
END IF
!
END IF END IF
! !
RETURN RETURN

35
CPV/ksstates.f90
View File

@ -163,6 +163,7 @@ CONTAINS
USE brillouin, ONLY: kpoints, kp USE brillouin, ONLY: kpoints, kp
USE pseudo_projector, ONLY: projector USE pseudo_projector, ONLY: projector
USE control_flags, ONLY: timing, force_pairing USE control_flags, ONLY: timing, force_pairing
USE electrons_base, ONLY: nupdwn, iupdwn
IMPLICIT NONE IMPLICIT NONE
@ -176,6 +177,8 @@ CONTAINS
! ... declare other variables ! ... declare other variables
INTEGER :: i, ik, ib, nk, ig, ngw, nb_g, nb_l, ispin, nspin, iks INTEGER :: i, ik, ib, nk, ig, ngw, nb_g, nb_l, ispin, nspin, iks
INTEGER :: ispin_wfc INTEGER :: ispin_wfc
INTEGER :: nupdwn_emp( wfill%nspin )
INTEGER :: iupdwn_emp( wfill%nspin )
LOGICAL :: tortho = .TRUE. LOGICAL :: tortho = .TRUE.
CHARACTER(LEN=4) :: nom CHARACTER(LEN=4) :: nom
CHARACTER(LEN=256) :: file_name CHARACTER(LEN=256) :: file_name
@ -211,8 +214,8 @@ CONTAINS
ALLOCATE( eforce( ngw, nb_l ) ) ALLOCATE( eforce( ngw, nb_l ) )
CALL dforce_all( ispin, cf(:,:,1,ispin_wfc), wfill, occ(:,1,ispin), eforce, & CALL dforce_all( ispin, cf(:,:,1,ispin_wfc), occ(:,1,ispin), eforce, &
vpot(:,ispin), eigr, bec ) vpot(:,ispin), eigr, bec, nupdwn, iupdwn )
CALL kohn_sham( ispin, cf(:,:,1,ispin_wfc), wfill, eforce ) CALL kohn_sham( ispin, cf(:,:,1,ispin_wfc), wfill, eforce )
@ -225,6 +228,10 @@ CONTAINS
ngw = wempt%ngwl ngw = wempt%ngwl
nb_l = wempt%nbl( ispin ) nb_l = wempt%nbl( ispin )
nupdwn_emp = nb_l
iupdwn_emp(1) = 1
IF( nspin == 2 ) iupdwn_emp(2) = 1+nb_l
IF( nb_l > 0 ) THEN IF( nb_l > 0 ) THEN
ALLOCATE( fi( nb_l, nk ) ) ALLOCATE( fi( nb_l, nk ) )
@ -234,8 +241,8 @@ CONTAINS
ALLOCATE( eforce( ngw, nb_l ) ) ALLOCATE( eforce( ngw, nb_l ) )
CALL dforce_all( ispin, ce(:,:,1,ispin), wempt, fi(:,1), eforce, & CALL dforce_all( ispin, ce(:,:,1,ispin), fi(:,1), eforce, &
vpot(:,ispin), eigr, bec ) vpot(:,ispin), eigr, bec, nupdwn_emp, iupdwn_emp )
CALL kohn_sham( ispin, ce(:,:,1,ispin), wempt, eforce ) CALL kohn_sham( ispin, ce(:,:,1,ispin), wempt, eforce )
@ -357,7 +364,7 @@ CONTAINS
USE brillouin, ONLY: kpoints, kp USE brillouin, ONLY: kpoints, kp
USE pseudo_projector, ONLY: projector USE pseudo_projector, ONLY: projector
USE control_flags, ONLY: timing USE control_flags, ONLY: timing
USE electrons_module, ONLY: nupdwn, nspin USE electrons_base, ONLY: iupdwn, nupdwn, nspin
IMPLICIT NONE IMPLICIT NONE
@ -378,6 +385,8 @@ CONTAINS
COMPLEX(DP), ALLOCATABLE :: eforce(:,:,:) COMPLEX(DP), ALLOCATABLE :: eforce(:,:,:)
REAL(DP), ALLOCATABLE :: fi(:,:) REAL(DP), ALLOCATABLE :: fi(:,:)
INTEGER :: nupdwn_emp( wfill%nspin )
INTEGER :: iupdwn_emp( wfill%nspin )
CHARACTER (LEN=6), EXTERNAL :: int_to_char CHARACTER (LEN=6), EXTERNAL :: int_to_char
REAL(DP), EXTERNAL :: cclock REAL(DP), EXTERNAL :: cclock
@ -406,10 +415,8 @@ CONTAINS
ALLOCATE( eforce( ngw, nb, 2 ) ) ALLOCATE( eforce( ngw, nb, 2 ) )
CALL dforce_all( 1, cf(:,:,1,1), wfill, occ(:,1,1), eforce(:,:,1), & CALL dforce_all( 1, cf(:,:,1,1), occ(:,1,1), eforce(:,:,1), vpot(:,1), eigr, bec, nupdwn, iupdwn )
vpot(:,1), eigr, bec ) CALL dforce_all( 2, cf(:,:,1,1), occ(:,1,2), eforce(:,:,2), vpot(:,2), eigr, bec, nupdwn, iupdwn )
CALL dforce_all( 2, cf(:,:,1,1), wfill, occ(:,1,2), eforce(:,:,2), &
vpot(:,2), eigr, bec )
DO i = 1, nupdwn(2) DO i = 1, nupdwn(2)
eforce(:,i,1) = occ(i,1,1) * eforce(:,i,1) + occ(i,1,2) * eforce(:,i,2) eforce(:,i,1) = occ(i,1,1) * eforce(:,i,1) + occ(i,1,2) * eforce(:,i,2)
@ -429,6 +436,10 @@ CONTAINS
ngw = wempt%ngwl ngw = wempt%ngwl
nb_l = wempt%nbl( 1 ) nb_l = wempt%nbl( 1 )
nupdwn_emp = nb_l
iupdwn_emp(1) = 1
IF( nspin == 2 ) iupdwn_emp(2) = 1+nb_l
IF( nb_l > 0 ) THEN IF( nb_l > 0 ) THEN
ALLOCATE( fi( nb_l, nk ) ) ALLOCATE( fi( nb_l, nk ) )
@ -438,13 +449,11 @@ CONTAINS
ALLOCATE( eforce( ngw, nb_l, 1 )) ALLOCATE( eforce( ngw, nb_l, 1 ))
CALL dforce_all( 1, ce(:,:,1,1), wempt, fi(:,1), eforce(:,:,1), vpot(:,1), & CALL dforce_all( 1, ce(:,:,1,1), fi(:,1), eforce(:,:,1), vpot(:,1), eigr, bec, nupdwn_emp, iupdwn_emp )
eigr, bec )
CALL kohn_sham( 1, ce(:,:,1,1), wempt, eforce(:,:,1) ) CALL kohn_sham( 1, ce(:,:,1,1), wempt, eforce(:,:,1) )
CALL dforce_all( 2, ce(:,:,1,2), wempt, fi(:,1), eforce(:,:,1), vpot(:,2), & CALL dforce_all( 2, ce(:,:,1,2), fi(:,1), eforce(:,:,1), vpot(:,2), eigr, bec, nupdwn_emp, iupdwn_emp )
eigr, bec )
CALL kohn_sham( 2, ce(:,:,1,2), wempt, eforce(:,:,1) ) CALL kohn_sham( 2, ce(:,:,1,2), wempt, eforce(:,:,1) )

17
CPV/optical.f90
View File

@ -68,6 +68,7 @@
USE forces, ONLY: dforce_all USE forces, ONLY: dforce_all
USE brillouin, ONLY: kpoints, kp USE brillouin, ONLY: kpoints, kp
USE electrons_module, ONLY: ei, ei_emp USE electrons_module, ONLY: ei, ei_emp
USE electrons_base, ONLY: nupdwn, iupdwn
USE kohn_sham_states, ONLY: kohn_sham USE kohn_sham_states, ONLY: kohn_sham
USE constants, ONLY: au, pi, k_boltzman_au, au_to_ohmcmm1 USE constants, ONLY: au, pi, k_boltzman_au, au_to_ohmcmm1
USE cell_base, ONLY: tpiba2 USE cell_base, ONLY: tpiba2
@ -107,6 +108,10 @@
REAL(DP) :: FACT, ef, beta REAL(DP) :: FACT, ef, beta
LOGICAL :: gamma_symmetry, gzero LOGICAL :: gamma_symmetry, gzero
INTEGER :: nupdwn_emp( wfill%nspin )
INTEGER :: iupdwn_emp( wfill%nspin )
! ... SUBROUTINE BODY ! ... SUBROUTINE BODY
CALL errore( ' opticalp ', ' not working ', 1 ) CALL errore( ' opticalp ', ' not working ', 1 )
@ -138,13 +143,17 @@
! !
CALL nlsm1 ( nb_l, 1, nspnl, eigr, cf(1,1,1,ispin), bec ) CALL nlsm1 ( nb_l, 1, nspnl, eigr, cf(1,1,1,ispin), bec )
CALL dforce_all( ispin, cf(:,:,1,ispin), wfill, occ(:,1,ispin), eforce(:,:,1), & CALL dforce_all( ispin, cf(:,:,1,ispin), occ(:,1,ispin), eforce(:,:,1), &
vpot(:,ispin), eigr, bec ) vpot(:,ispin), eigr, bec, nupdwn, iupdwn )
CALL kohn_sham( ispin, cf(:,:,1,ispin), wfill, eforce(:,:,1) ) CALL kohn_sham( ispin, cf(:,:,1,ispin), wfill, eforce(:,:,1) )
ngw = wempt%ngwl ngw = wempt%ngwl
nb_l = wempt%nbl( ispin ) nb_l = wempt%nbl( ispin )
nupdwn_emp = nb_l
iupdwn_emp(1) = 1
IF( nspin == 2 ) iupdwn_emp(2) = 1+nb_l
ALLOCATE( ff( nb_l, nk ) ) ALLOCATE( ff( nb_l, nk ) )
DO ik = 1, nk DO ik = 1, nk
@ -155,8 +164,8 @@
! !
CALL nlsm1 ( nb_l, 1, nspnl, eigr, ce(1,1,1,ispin), bece ) CALL nlsm1 ( nb_l, 1, nspnl, eigr, ce(1,1,1,ispin), bece )
! !
CALL dforce_all( ispin, ce(:,:,1,ispin), wempt, ff( :, 1), eforce(:,:,1), & CALL dforce_all( ispin, ce(:,:,1,ispin), ff( :, 1), eforce(:,:,1), &
vpot(:,ispin), eigr, bece ) vpot(:,ispin), eigr, bece, nupdwn_emp, iupdwn_emp )
! !
CALL kohn_sham( ispin, ce(:,:,1,ispin), wempt, eforce(:,:,1) ) CALL kohn_sham( ispin, ce(:,:,1,ispin), wempt, eforce(:,:,1) )

9
CPV/runcg.f90
View File

@ -63,6 +63,7 @@
! ... declare modules ! ... declare modules
USE energies, ONLY: dft_energy_type, print_energies USE energies, ONLY: dft_energy_type, print_energies
USE electrons_module, ONLY: pmss, eigs, nb_l USE electrons_module, ONLY: pmss, eigs, nb_l
USE electrons_base, ONLY: nupdwn, iupdwn
USE cp_electronic_mass, ONLY: emass USE cp_electronic_mass, ONLY: emass
USE wave_functions, ONLY: cp_kinetic_energy, proj, fixwave USE wave_functions, ONLY: cp_kinetic_energy, proj, fixwave
USE wave_base, ONLY: dotp, hpsi USE wave_base, ONLY: dotp, hpsi
@ -183,8 +184,8 @@
! ... Calculate wave functions gradient (temporarely stored in cp) ! ... Calculate wave functions gradient (temporarely stored in cp)
! ... |d H / dPsi_j > = H |Psi_j> - Sum{i} <Psi_i|H|Psi_j> |Psi_i> ! ... |d H / dPsi_j > = H |Psi_j> - Sum{i} <Psi_i|H|Psi_j> |Psi_i>
CALL dforce_all( ispin, c0(:,:,1,ispin), cdesc, occ(:,1,ispin), cp(:,:,1,ispin), & CALL dforce_all( ispin, c0(:,:,1,ispin), occ(:,1,ispin), cp(:,:,1,ispin), &
vpot(:,ispin), eigr, bec ) vpot(:,ispin), eigr, bec, nupdwn, iupdwn )
! ... Project the gradient ! ... Project the gradient
IF( gamma_symmetry ) THEN IF( gamma_symmetry ) THEN
@ -317,8 +318,8 @@
IF( tprint ) THEN IF( tprint ) THEN
DO ispin = 1, nspin DO ispin = 1, nspin
CALL dforce_all( ispin, c0(:,:,1,ispin), cdesc, occ(:,1,ispin), hacca(:,:,1,ispin), & CALL dforce_all( ispin, c0(:,:,1,ispin), occ(:,1,ispin), hacca(:,:,1,ispin), &
vpot(:,ispin), eigr, bec ) vpot(:,ispin), eigr, bec, nupdwn, iupdwn )
nb_g( ispin ) = cdesc%nbt( ispin ) nb_g( ispin ) = cdesc%nbt( ispin )

19
CPV/runcp.f90
View File

@ -47,7 +47,6 @@
USE wave_base, ONLY: hpsi USE wave_base, ONLY: hpsi
USE cell_module, ONLY: boxdimensions USE cell_module, ONLY: boxdimensions
USE time_step, ONLY: delt USE time_step, ONLY: delt
USE forces, ONLY: dforce
USE orthogonalize, ONLY: ortho USE orthogonalize, ONLY: ortho
USE wave_types, ONLY: wave_descriptor USE wave_types, ONLY: wave_descriptor
USE pseudo_projector, ONLY: projector USE pseudo_projector, ONLY: projector
@ -167,6 +166,7 @@
! ... declare modules ! ... declare modules
USE kinds USE kinds
USE electrons_module, ONLY: pmss USE electrons_module, ONLY: pmss
USE electrons_base, ONLY: nupdwn, iupdwn
USE cp_electronic_mass, ONLY: emass USE cp_electronic_mass, ONLY: emass
USE wave_base, ONLY: wave_steepest, wave_verlet USE wave_base, ONLY: wave_steepest, wave_verlet
USE time_step, ONLY: delt USE time_step, ONLY: delt
@ -252,7 +252,7 @@
DO i = 1, nb, 2 DO i = 1, nb, 2
!WRITE( 6, * ) 'DEBUG = ', fi(i,1,is), fi(i+1,1,is) !WRITE( 6, * ) 'DEBUG = ', fi(i,1,is), fi(i+1,1,is)
CALL dforce( i, is, c0(:,:,1,is), cdesc, fi(:,1,is), c2, c3, vpot(:,is), eigr, bec ) CALL dforce( i, is, c0(:,:,1,is), fi(:,1,is), c2, c3, vpot(:,is), eigr, bec, nupdwn, iupdwn )
IF( tlam ) THEN IF( tlam ) THEN
CALL update_lambda( i, gam( :, :,is), c0(:,:,1,is), cdesc, c2 ) CALL update_lambda( i, gam( :, :,is), c0(:,:,1,is), cdesc, c2 )
@ -283,7 +283,7 @@
nb = nx nb = nx
CALL dforce( nx, is, c0(:,:,1,is), cdesc, fi(:,1,is), c2, c3, vpot(:,is), eigr, bec ) CALL dforce( nx, is, c0(:,:,1,is), fi(:,1,is), c2, c3, vpot(:,is), eigr, bec, nupdwn, iupdwn )
IF( tlam ) THEN IF( tlam ) THEN
CALL update_lambda( nb, gam( :, :,is), c0(:,:,1,is), cdesc, c2 ) CALL update_lambda( nb, gam( :, :,is), c0(:,:,1,is), cdesc, c2 )
@ -332,7 +332,8 @@
USE kinds USE kinds
USE mp_global, ONLY: intra_image_comm USE mp_global, ONLY: intra_image_comm
USE mp, ONLY: mp_sum USE mp, ONLY: mp_sum
USE electrons_module, ONLY: pmss, eigs, nb_l, nupdwn, nspin USE electrons_module, ONLY: pmss, eigs, nb_l
USE electrons_base, ONLY: iupdwn, nupdwn, nspin
USE cp_electronic_mass, ONLY: emass USE cp_electronic_mass, ONLY: emass
USE wave_functions, ONLY : cp_kinetic_energy USE wave_functions, ONLY : cp_kinetic_energy
USE wave_base, ONLY: wave_steepest, wave_verlet USE wave_base, ONLY: wave_steepest, wave_verlet
@ -454,8 +455,8 @@
DO i = 1, nb, 2 DO i = 1, nb, 2
! !
CALL dforce( i, 2, c0(:,:,1,1), cdesc, fi(:,1,1), c2, c3, vpot(:,1), eigr, bec ) CALL dforce( i, 2, c0(:,:,1,1), fi(:,1,1), c2, c3, vpot(:,1), eigr, bec, nupdwn, iupdwn )
CALL dforce( i, 2, c0(:,:,1,1), cdesc, fi(:,1,1), c4, c5, vpot(:,2), eigr, bec ) CALL dforce( i, 2, c0(:,:,1,1), fi(:,1,1), c4, c5, vpot(:,2), eigr, bec, nupdwn, iupdwn )
! !
c2 = occup(i , ik)* (c2 + c4) c2 = occup(i , ik)* (c2 + c4)
c3 = occup(i+1, ik)* (c3 + c5) c3 = occup(i+1, ik)* (c3 + c5)
@ -487,8 +488,8 @@
! !
nb = n_unp - 1 nb = n_unp - 1
! !
CALL dforce( nb, 2, c0(:,:,1,1), cdesc, fi(:,1,1), c2, c3, vpot(:,1), eigr, bec ) CALL dforce( nb, 2, c0(:,:,1,1), fi(:,1,1), c2, c3, vpot(:,1), eigr, bec, nupdwn, iupdwn )
CALL dforce( nb, 2, c0(:,:,1,1), cdesc, fi(:,1,2), c4, c5, vpot(:,2), eigr, bec ) CALL dforce( nb, 2, c0(:,:,1,1), fi(:,1,2), c4, c5, vpot(:,2), eigr, bec, nupdwn, iupdwn )
c2 = occup(nb , ik)* (c2 + c4) c2 = occup(nb , ik)* (c2 + c4)
@ -506,7 +507,7 @@
END IF END IF
! !
CALL dforce( n_unp, 1, c0(:,:,1,1), cdesc, fi(:,1,1), c2, c3, vpot(:,1), eigr, bec ) CALL dforce( n_unp, 1, c0(:,:,1,1), fi(:,1,1), c2, c3, vpot(:,1), eigr, bec, nupdwn, iupdwn )
intermed = -2.d0 * sum( c2 * conjg( c0(:, n_unp, ik, 1 ) ) ) intermed = -2.d0 * sum( c2 * conjg( c0(:, n_unp, ik, 1 ) ) )
IF ( gstart == 2 ) THEN IF ( gstart == 2 ) THEN

17
CPV/rundiis.f90
View File

@ -79,6 +79,7 @@ CONTAINS
USE io_global, ONLY: stdout USE io_global, ONLY: stdout
USE energies, ONLY: dft_energy_type USE energies, ONLY: dft_energy_type
USE electrons_module, ONLY: pmss USE electrons_module, ONLY: pmss
USE electrons_base, ONLY: nupdwn, iupdwn
USE time_step, ONLY: delt USE time_step, ONLY: delt
USE wave_functions, ONLY: proj, crot USE wave_functions, ONLY: proj, crot
USE phase_factors_module, ONLY: strucf, phfacs USE phase_factors_module, ONLY: strucf, phfacs
@ -263,7 +264,7 @@ CONTAINS
edft%enl = nlrh_m(c0, cdesc, tforce, atoms, fs, bec, becdr, eigr) edft%enl = nlrh_m(c0, cdesc, tforce, atoms, fs, bec, becdr, eigr)
CALL dforce_all( 1, c0(:,:,1,1), cdesc, fi(:,1,1), cgrad(:,:,1,1), vpot(:,1), eigr, bec ) CALL dforce_all( 1, c0(:,:,1,1), fi(:,1,1), cgrad(:,:,1,1), vpot(:,1), eigr, bec, nupdwn, iupdwn )
CALL proj( 1, cgrad(:,:,1,1), cdesc, c0(:,:,1,1), cdesc, lambda ) CALL proj( 1, cgrad(:,:,1,1), cdesc, c0(:,:,1,1), cdesc, lambda )
CALL crot( 1, c0(:,:,1,1), cdesc, lambda, eig(:,1,1) ) CALL crot( 1, c0(:,:,1,1), cdesc, lambda, eig(:,1,1) )
@ -272,7 +273,7 @@ CONTAINS
call entropy_s(fi(1,1,1),temp_elec,cdesc%nbl(1),edft%ent) call entropy_s(fi(1,1,1),temp_elec,cdesc%nbl(1),edft%ent)
edft%enl = nlrh_m(c0, cdesc, tforce, atoms, fs, bec, becdr, eigr) edft%enl = nlrh_m(c0, cdesc, tforce, atoms, fs, bec, becdr, eigr)
CALL dforce_all( 1, c0(:,:,1,1), cdesc, fi(:,1,1), cgrad(:,:,1,1), vpot(:,1), eigr, bec ) CALL dforce_all( 1, c0(:,:,1,1), fi(:,1,1), cgrad(:,:,1,1), vpot(:,1), eigr, bec, nupdwn, iupdwn )
DO ib = 1, cdesc%nbl( 1 ) DO ib = 1, cdesc%nbl( 1 )
cgrad(:,ib,1,1) = cgrad(:,ib,1,1) + eig(ib,1,1)*c0(:,ib,1,1) cgrad(:,ib,1,1) = cgrad(:,ib,1,1) + eig(ib,1,1)*c0(:,ib,1,1)
@ -283,7 +284,7 @@ CONTAINS
! ... DIIS on c0 at FIXED potential ! ... DIIS on c0 at FIXED potential
edft%enl = nlrh_m(c0, cdesc, tforce, atoms, fs, bec, becdr, eigr) edft%enl = nlrh_m(c0, cdesc, tforce, atoms, fs, bec, becdr, eigr)
CALL dforce_all( 1, c0(:,:,1,1), cdesc, fi(:,1,1), cgrad(:,:,1,1), vpot(:,1), eigr, bec ) CALL dforce_all( 1, c0(:,:,1,1), fi(:,1,1), cgrad(:,:,1,1), vpot(:,1), eigr, bec, nupdwn, iupdwn )
CALL proj( 1, cgrad(:,:,1,1), cdesc, c0(:,:,1,1), cdesc, lambda) CALL proj( 1, cgrad(:,:,1,1), cdesc, c0(:,:,1,1), cdesc, lambda)
@ -393,6 +394,7 @@ CONTAINS
USE runcp_module, ONLY: runcp USE runcp_module, ONLY: runcp
USE energies, ONLY: dft_energy_type USE energies, ONLY: dft_energy_type
USE electrons_module, ONLY: ei, pmss USE electrons_module, ONLY: ei, pmss
USE electrons_base, ONLY: nupdwn, iupdwn
USE time_step, ONLY: delt USE time_step, ONLY: delt
USE wave_functions, ONLY: proj, update_wave_functions USE wave_functions, ONLY: proj, update_wave_functions
USE diis USE diis
@ -528,8 +530,8 @@ CONTAINS
! ... of 1, ( row 1 to PE 1, row 2 to PE 2, .. row nproc_image+1 to PE 1 and ! ... of 1, ( row 1 to PE 1, row 2 to PE 2, .. row nproc_image+1 to PE 1 and
! ... so on). ! ... so on).
CALL dforce_all( ispin, c0(:,:,1,ispin), cdesc, fi(:,1,ispin), cgrad(:,:,1,ispin), & CALL dforce_all( ispin, c0(:,:,1,ispin), fi(:,1,ispin), cgrad(:,:,1,ispin), &
vpot(:,ispin), eigr, bec ) vpot(:,ispin), eigr, bec, nupdwn, iupdwn )
CALL proj( ispin, cgrad(:,:,1,ispin), cdesc, c0(:,:,1,ispin), cdesc, lambda) CALL proj( ispin, cgrad(:,:,1,ispin), cdesc, c0(:,:,1,ispin), cdesc, lambda)
@ -604,6 +606,7 @@ CONTAINS
USE constants, ONLY: au USE constants, ONLY: au
USE cell_base, ONLY: tpiba2 USE cell_base, ONLY: tpiba2
USE electrons_module, ONLY: eigs, ei, pmss, emass, nb_l, ib_owner, ib_local USE electrons_module, ONLY: eigs, ei, pmss, emass, nb_l, ib_owner, ib_local
USE electrons_base, ONLY: iupdwn, nupdwn
USE forces, ONLY: dforce_all USE forces, ONLY: dforce_all
USE orthogonalize USE orthogonalize
USE pseudopotential, ONLY: nspnl USE pseudopotential, ONLY: nspnl
@ -653,8 +656,8 @@ CONTAINS
CALL nlsm1( n, 1, nspnl, eigr, c(1,1,1,ispin), bec ) CALL nlsm1( n, 1, nspnl, eigr, c(1,1,1,ispin), bec )
! ... Calculate | dH / dpsi(j) > ! ... Calculate | dH / dpsi(j) >
CALL dforce_all( ispin, c(:,:,1,ispin), cdesc, fi(:,1,ispin), eforce(:,:,1,ispin), & CALL dforce_all( ispin, c(:,:,1,ispin), fi(:,1,ispin), eforce(:,:,1,ispin), &
vpot(:,ispin), eigr, bec ) vpot(:,ispin), eigr, bec, nupdwn, iupdwn )
! ... Calculate Eij = < psi(i) | H | psi(j) > = < psi(i) | dH / dpsi(j) > ! ... Calculate Eij = < psi(i) | H | psi(j) > = < psi(i) | dH / dpsi(j) >
DO i = 1, n DO i = 1, n