2003-07-07 05:47:17 +08:00
|
|
|
!
|
2005-07-13 04:08:01 +08:00
|
|
|
! Copyright (C) 2002-2005 Quantum-ESPRESSO group
|
2003-07-07 05:47:17 +08:00
|
|
|
! This file is distributed under the terms of the
|
|
|
|
! GNU General Public License. See the file `License'
|
|
|
|
! in the root directory of the present distribution,
|
|
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
|
|
!
|
|
|
|
!------------------------------------------------------------------------------!
|
|
|
|
MODULE electrons_base
|
|
|
|
!------------------------------------------------------------------------------!
|
|
|
|
|
|
|
|
USE kinds, ONLY: dbl
|
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
SAVE
|
|
|
|
|
2005-03-02 18:03:55 +08:00
|
|
|
INTEGER :: nbnd = 0 ! number electronic bands, each band contains
|
|
|
|
! two spin states
|
2003-07-07 05:47:17 +08:00
|
|
|
INTEGER :: nbndx = 0 ! array dimension nbndx >= nbnd
|
2005-03-02 18:03:55 +08:00
|
|
|
INTEGER :: nspin = 0 ! nspin = number of spins (1=no spin, 2=LSDA)
|
2003-07-07 05:47:17 +08:00
|
|
|
INTEGER :: nel(2) = 0 ! number of electrons (up, down)
|
|
|
|
INTEGER :: nelt = 0 ! total number of electrons ( up + down )
|
|
|
|
INTEGER :: nupdwn(2) = 0 ! number of states with spin up (1) and down (2)
|
|
|
|
INTEGER :: iupdwn(2) = 0 ! first state with spin (1) and down (2)
|
2004-12-21 23:48:19 +08:00
|
|
|
INTEGER :: nudx = 0 ! max (nupdw(1),nupdw(2))
|
2005-03-02 18:03:55 +08:00
|
|
|
INTEGER :: nbsp = 0 ! total number of electronic states
|
|
|
|
! (nbnd * nspin)
|
|
|
|
INTEGER :: nbspx = 0 ! array dimension nbspx >= nbsp
|
|
|
|
|
|
|
|
LOGICAL :: telectrons_base_initval = .FALSE.
|
2004-11-02 00:43:29 +08:00
|
|
|
|
|
|
|
REAL(dbl), ALLOCATABLE :: f(:) ! occupation numbers ( at gamma )
|
|
|
|
REAL(dbl) :: qbac = 0.0d0 ! background neutralizing charge
|
|
|
|
INTEGER, ALLOCATABLE :: fspin(:) ! spin of each state
|
2003-07-07 05:47:17 +08:00
|
|
|
!
|
2004-11-02 00:43:29 +08:00
|
|
|
!------------------------------------------------------------------------------!
|
|
|
|
CONTAINS
|
|
|
|
!------------------------------------------------------------------------------!
|
|
|
|
|
2005-03-02 18:03:55 +08:00
|
|
|
|
2005-07-28 00:09:03 +08:00
|
|
|
SUBROUTINE electrons_base_initval( zv_ , na_ , nsp_ , nelec_ , nelup_ , neldw_ , nbnd_ , &
|
2005-03-02 18:03:55 +08:00
|
|
|
nspin_ , occupations_ , f_inp )
|
|
|
|
|
|
|
|
USE constants, ONLY: eps8
|
|
|
|
USE io_global, ONLY: stdout
|
|
|
|
|
2005-07-28 00:09:03 +08:00
|
|
|
REAL(dbl), INTENT(IN) :: zv_ (:)
|
|
|
|
INTEGER, INTENT(IN) :: na_ (:) , nsp_
|
2005-03-02 18:03:55 +08:00
|
|
|
REAL(dbl), INTENT(IN) :: nelec_ , nelup_ , neldw_
|
|
|
|
INTEGER, INTENT(IN) :: nbnd_ , nspin_
|
|
|
|
CHARACTER(LEN=*), INTENT(IN) :: occupations_
|
|
|
|
REAL(dbl), INTENT(IN) :: f_inp(:,:)
|
|
|
|
REAL(dbl) :: nelec, nelup, neldw, ocp, fsum
|
|
|
|
INTEGER :: iss, i, in
|
|
|
|
|
2005-07-28 00:09:03 +08:00
|
|
|
IF( nelec_ /= 0 ) THEN
|
|
|
|
nelec = nelec_
|
|
|
|
ELSE
|
|
|
|
nelec = 0.0d0
|
|
|
|
DO i = 1, nsp_
|
|
|
|
nelec = nelec + na_ ( i ) * zv_ ( i )
|
|
|
|
END DO
|
|
|
|
END IF
|
|
|
|
|
|
|
|
IF( nbnd_ /= 0 ) THEN
|
|
|
|
nbnd = nbnd_
|
|
|
|
ELSE
|
|
|
|
nbnd = INT( nelec + 1 ) / 2
|
|
|
|
END IF
|
|
|
|
|
|
|
|
nbsp = nbnd * nspin_
|
2005-03-02 18:03:55 +08:00
|
|
|
nspin = nspin_
|
2005-07-28 00:09:03 +08:00
|
|
|
|
|
|
|
IF( nelup_ > 0.0d0 .AND. neldw_ > 0.0d0 ) THEN
|
|
|
|
nelup = nelup_
|
|
|
|
neldw = neldw_
|
|
|
|
ELSE IF( nelup_ > 0.0d0 .AND. neldw_ == 0.0d0 ) THEN
|
|
|
|
nelup = nelup_
|
|
|
|
neldw = nelec - nelup_
|
|
|
|
ELSE IF( nelup_ == 0.0d0 .AND. neldw_ > 0.0d0 ) THEN
|
|
|
|
neldw = neldw_
|
|
|
|
nelup = nelec - neldw_
|
|
|
|
ELSE
|
|
|
|
nelup = INT( nelec + 1 ) / 2
|
|
|
|
neldw = nelec - nelup
|
|
|
|
END IF
|
2005-03-02 18:03:55 +08:00
|
|
|
|
|
|
|
IF( nelec < 1 ) THEN
|
|
|
|
CALL errore(' electrons_base_initval ',' nelec less than 1 ', 1 )
|
|
|
|
END IF
|
|
|
|
IF( nint( nelec ) - nelec > eps8 ) THEN
|
|
|
|
CALL errore(' electrons_base_initval ',' nelec must be integer', 2 )
|
|
|
|
END IF
|
|
|
|
IF( nbnd < 1 ) &
|
|
|
|
CALL errore(' electrons_base_initval ',' nbnd out of range ', 1 )
|
|
|
|
|
|
|
|
|
|
|
|
IF ( nspin /= 1 .AND. nspin /= 2 ) THEN
|
|
|
|
WRITE( stdout, * ) 'nspin = ', nspin
|
|
|
|
CALL errore( ' electrons_base_initval ', ' nspin out of range ', 1 )
|
|
|
|
END IF
|
|
|
|
|
|
|
|
|
|
|
|
if( mod( nbsp , 2 ) .ne. 0 ) then
|
|
|
|
nbspx = nbsp + 1
|
|
|
|
else
|
|
|
|
nbspx = nbsp
|
|
|
|
end if
|
|
|
|
|
|
|
|
ALLOCATE( f ( nbspx ) )
|
|
|
|
ALLOCATE( fspin ( nbspx ) )
|
|
|
|
f = 0.0d0
|
|
|
|
fspin = 0
|
|
|
|
|
|
|
|
iupdwn ( 1 ) = 1
|
|
|
|
nel = 0
|
|
|
|
|
|
|
|
SELECT CASE ( TRIM(occupations_) )
|
|
|
|
CASE ('bogus')
|
|
|
|
!
|
|
|
|
! empty-states calculation: occupancies have a (bogus) finite value
|
|
|
|
!
|
|
|
|
! bogus to ensure \sum_i f_i = Nelec (nelec is integer)
|
|
|
|
!
|
|
|
|
f ( : ) = nelec / nbsp
|
|
|
|
nel (1) = nint( nelec )
|
|
|
|
nupdwn (1) = nbsp
|
|
|
|
if ( nspin == 2 ) then
|
|
|
|
!
|
|
|
|
! bogus to ensure Nelec = Nup + Ndw
|
|
|
|
!
|
|
|
|
nel (1) = ( nint(nelec) + 1 ) / 2
|
|
|
|
nel (2) = nint(nelec) / 2
|
|
|
|
nupdwn (1)=nbnd
|
|
|
|
nupdwn (2)=nbnd
|
|
|
|
iupdwn (2)=nbnd+1
|
|
|
|
end if
|
|
|
|
!
|
|
|
|
CASE ('from_input')
|
|
|
|
!
|
|
|
|
! occupancies have been read from input
|
|
|
|
!
|
|
|
|
f ( 1:nbnd ) = f_inp( 1:nbnd, 1 )
|
|
|
|
if( nspin == 2 ) f ( nbnd+1 : 2*nbnd ) = f_inp( 1:nbnd, 2 )
|
|
|
|
if( nelec == 0.d0 ) nelec = SUM ( f ( 1:nbsp ) )
|
|
|
|
if( nspin == 2 .and. nelup == 0) nelup = SUM ( f ( 1:nbnd ) )
|
|
|
|
if( nspin == 2 .and. neldw == 0) neldw = SUM ( f ( nbnd+1 : 2*nbnd ) )
|
|
|
|
|
|
|
|
if( nspin == 1 ) then
|
|
|
|
nel (1) = nint(nelec)
|
|
|
|
nupdwn (1) = nbsp
|
|
|
|
else
|
|
|
|
IF ( ABS (nelup + neldw - nelec) > eps8 ) THEN
|
|
|
|
CALL errore(' electrons_base_initval ',' wrong # of up and down spin', 1 )
|
|
|
|
END IF
|
|
|
|
nel (1) = nint(nelup)
|
|
|
|
nel (2) = nint(neldw)
|
|
|
|
nupdwn (1)=nbnd
|
|
|
|
nupdwn (2)=nbnd
|
|
|
|
iupdwn (2)=nbnd+1
|
|
|
|
end if
|
|
|
|
!
|
|
|
|
CASE ('fixed')
|
|
|
|
|
|
|
|
if( nspin == 1 ) then
|
|
|
|
nel (1) = nint(nelec)
|
|
|
|
nupdwn (1) = nbsp
|
|
|
|
else
|
|
|
|
IF ( nelup + neldw /= nelec ) THEN
|
|
|
|
CALL errore(' electrons_base_initval ',' wrong # of up and down spin', 1 )
|
|
|
|
END IF
|
|
|
|
nel (1) = nint(nelup)
|
|
|
|
nel (2) = nint(neldw)
|
|
|
|
nupdwn (1)=nbnd
|
|
|
|
nupdwn (2)=nbnd
|
|
|
|
iupdwn (2)=nbnd+1
|
|
|
|
end if
|
|
|
|
|
|
|
|
! ocp = 2 for spinless systems, ocp = 1 for spin-polarized systems
|
|
|
|
ocp = 2.d0 / nspin
|
|
|
|
! default filling: attribute ocp electrons to each states
|
|
|
|
! until the good number of electrons is reached
|
|
|
|
do iss = 1, nspin
|
|
|
|
fsum = 0.0d0
|
|
|
|
do in = iupdwn ( iss ), iupdwn ( iss ) - 1 + nupdwn ( iss )
|
|
|
|
if ( fsum + ocp < nel ( iss ) + 0.0001 ) then
|
|
|
|
f (in) = ocp
|
|
|
|
else
|
|
|
|
f (in) = max( nel ( iss ) - fsum, 0.d0 )
|
|
|
|
end if
|
|
|
|
fsum=fsum + f(in)
|
|
|
|
end do
|
|
|
|
end do
|
|
|
|
CASE ('ensemble','ensemble-dft','edft')
|
|
|
|
|
|
|
|
if ( nspin == 1 ) then
|
|
|
|
nbsp = nbnd
|
|
|
|
f ( : ) = nelec / nbsp
|
|
|
|
nel (1) = nint(nelec)
|
|
|
|
nupdwn (1) = nbsp
|
|
|
|
else
|
|
|
|
nbsp = 2*nbnd
|
|
|
|
if (nelup.ne.0) then
|
|
|
|
if ((nelup+neldw).ne.nelec) then
|
|
|
|
CALL errore(' electrons_base_initval ',' nelup+neldw .ne. nelec', 1 )
|
|
|
|
end if
|
|
|
|
nel (1) = nelup
|
|
|
|
nel (2) = neldw
|
|
|
|
else
|
|
|
|
nel (1) = ( nint(nelec) + 1 ) / 2
|
|
|
|
nel (2) = nint(nelec) / 2
|
|
|
|
end if
|
|
|
|
nupdwn (1) = nbnd
|
|
|
|
nupdwn (2) = nbnd
|
|
|
|
iupdwn (2) = nbnd+1
|
|
|
|
do iss = 1, nspin
|
|
|
|
do i = iupdwn ( iss ), iupdwn ( iss ) - 1 + nupdwn ( iss )
|
|
|
|
f (i) = nel (iss) / real (nupdwn (iss))
|
|
|
|
end do
|
|
|
|
end do
|
|
|
|
end if
|
|
|
|
|
|
|
|
CASE DEFAULT
|
|
|
|
CALL errore(' electrons_base_initval ',' occupation method not implemented', 1 )
|
|
|
|
END SELECT
|
|
|
|
|
|
|
|
|
|
|
|
do iss = 1, nspin
|
|
|
|
do in = iupdwn(iss), iupdwn(iss) - 1 + nupdwn(iss)
|
|
|
|
fspin(in) = iss
|
|
|
|
end do
|
|
|
|
end do
|
|
|
|
|
|
|
|
nbndx = MAXVAL( nupdwn )
|
|
|
|
|
|
|
|
IF ( nspin == 1 ) THEN
|
|
|
|
nelt = nel(1)
|
|
|
|
nudx = nupdwn(1)
|
2004-12-21 23:48:19 +08:00
|
|
|
ELSE
|
2005-03-02 18:03:55 +08:00
|
|
|
nelt = nel(1) + nel(2)
|
|
|
|
nudx = MAX( nupdwn(1), nupdwn(2) )
|
2004-12-21 23:48:19 +08:00
|
|
|
END IF
|
2005-03-02 18:03:55 +08:00
|
|
|
|
|
|
|
IF( nbnd < nupdwn(1) .OR. nbnd < nupdwn(2) ) &
|
|
|
|
CALL errore(' electrons_base_initval ',' inconsistent nbnd and nupdwn(1) or nupdwn(2) ', 1 )
|
|
|
|
|
|
|
|
IF( ( 2 * nbnd ) < nelt ) &
|
|
|
|
CALL errore(' electrons_base_initval ',' too few states ', 1 )
|
|
|
|
|
|
|
|
|
|
|
|
telectrons_base_initval = .TRUE.
|
|
|
|
|
2004-12-21 23:48:19 +08:00
|
|
|
RETURN
|
2005-03-02 18:03:55 +08:00
|
|
|
|
2005-05-18 17:38:45 +08:00
|
|
|
END SUBROUTINE electrons_base_initval
|
2004-12-21 23:48:19 +08:00
|
|
|
|
2005-03-02 18:03:55 +08:00
|
|
|
|
|
|
|
|
2004-11-02 00:43:29 +08:00
|
|
|
SUBROUTINE deallocate_elct()
|
|
|
|
IF( ALLOCATED( f ) ) DEALLOCATE( f )
|
|
|
|
IF( ALLOCATED( fspin ) ) DEALLOCATE( fspin )
|
2005-03-02 18:03:55 +08:00
|
|
|
telectrons_base_initval = .FALSE.
|
2004-11-02 00:43:29 +08:00
|
|
|
RETURN
|
2005-05-18 17:38:45 +08:00
|
|
|
END SUBROUTINE deallocate_elct
|
2004-11-02 00:43:29 +08:00
|
|
|
|
2003-07-07 05:47:17 +08:00
|
|
|
|
|
|
|
!------------------------------------------------------------------------------!
|
|
|
|
END MODULE electrons_base
|
|
|
|
!------------------------------------------------------------------------------!
|
2004-11-02 00:43:29 +08:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
!------------------------------------------------------------------------------!
|
|
|
|
MODULE electrons_nose
|
|
|
|
!------------------------------------------------------------------------------!
|
|
|
|
|
|
|
|
USE kinds, ONLY: dbl
|
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
SAVE
|
|
|
|
|
|
|
|
REAL(dbl) :: fnosee = 0.0d0 ! frequency of the thermostat ( in THz )
|
|
|
|
REAL(dbl) :: qne = 0.0d0 ! mass of teh termostat
|
|
|
|
REAL(dbl) :: ekincw = 0.0d0 ! kinetic energy to be kept constant
|
2004-11-19 07:26:26 +08:00
|
|
|
|
|
|
|
REAL(dbl) :: xnhe0 = 0.0d0
|
|
|
|
REAL(dbl) :: xnhep = 0.0d0
|
|
|
|
REAL(dbl) :: xnhem = 0.0d0
|
2005-07-13 04:08:01 +08:00
|
|
|
REAL(dbl) :: vnhe = 0.0d0
|
|
|
|
|
|
|
|
REAL(dbl) :: fccc = 0.0d0
|
2004-11-02 00:43:29 +08:00
|
|
|
!
|
2005-01-15 18:53:46 +08:00
|
|
|
!------------------------------------------------------------------------------!
|
|
|
|
CONTAINS
|
|
|
|
!------------------------------------------------------------------------------!
|
|
|
|
|
|
|
|
subroutine electrons_nose_init( ekincw_ , fnosee_ )
|
|
|
|
USE constants, ONLY: factem, pi, terahertz
|
|
|
|
REAL(dbl), INTENT(IN) :: ekincw_, fnosee_
|
|
|
|
! set thermostat parameter for electrons
|
2005-03-26 23:29:07 +08:00
|
|
|
qne = 0.0d0
|
2005-01-15 18:53:46 +08:00
|
|
|
ekincw = ekincw_
|
2005-03-26 23:29:07 +08:00
|
|
|
fnosee = fnosee_
|
|
|
|
xnhe0 = 0.0d0
|
|
|
|
xnhep = 0.0d0
|
|
|
|
xnhem = 0.0d0
|
|
|
|
vnhe = 0.0d0
|
|
|
|
if( fnosee > 0.0d0 ) qne = 4.d0 * ekincw / ( fnosee * ( 2.d0 * pi ) * terahertz )**2
|
2005-01-15 18:53:46 +08:00
|
|
|
return
|
2005-05-18 17:38:45 +08:00
|
|
|
end subroutine electrons_nose_init
|
2005-01-15 18:53:46 +08:00
|
|
|
|
|
|
|
|
|
|
|
function electrons_nose_nrg( xnhe0, vnhe, qne, ekincw )
|
|
|
|
! compute energy term for nose thermostat
|
|
|
|
implicit none
|
|
|
|
real(kind=8) :: electrons_nose_nrg
|
|
|
|
real(kind=8), intent(in) :: xnhe0, vnhe, qne, ekincw
|
|
|
|
!
|
|
|
|
electrons_nose_nrg = 0.5d0 * qne * vnhe * vnhe + 2.0d0 * ekincw * xnhe0
|
|
|
|
!
|
|
|
|
return
|
2005-05-18 01:07:57 +08:00
|
|
|
end function electrons_nose_nrg
|
2005-01-15 18:53:46 +08:00
|
|
|
|
|
|
|
subroutine electrons_nose_shiftvar( xnhep, xnhe0, xnhem )
|
|
|
|
! shift values of nose variables to start a new step
|
|
|
|
implicit none
|
2005-03-15 01:03:35 +08:00
|
|
|
real(kind=8), intent(out) :: xnhem
|
|
|
|
real(kind=8), intent(inout) :: xnhe0
|
2005-01-15 18:53:46 +08:00
|
|
|
real(kind=8), intent(in) :: xnhep
|
|
|
|
!
|
|
|
|
xnhem = xnhe0
|
|
|
|
xnhe0 = xnhep
|
|
|
|
!
|
|
|
|
return
|
2005-05-18 17:38:45 +08:00
|
|
|
end subroutine electrons_nose_shiftvar
|
2005-01-15 18:53:46 +08:00
|
|
|
|
2005-03-26 23:29:07 +08:00
|
|
|
subroutine electrons_nosevel( vnhe, xnhe0, xnhem, delt )
|
|
|
|
implicit none
|
|
|
|
real(kind=8), intent(inout) :: vnhe
|
|
|
|
real(kind=8), intent(in) :: xnhe0, xnhem, delt
|
|
|
|
vnhe=2.*(xnhe0-xnhem)/delt-vnhe
|
|
|
|
return
|
2005-05-18 17:38:45 +08:00
|
|
|
end subroutine electrons_nosevel
|
2005-03-26 23:29:07 +08:00
|
|
|
|
|
|
|
subroutine electrons_noseupd( xnhep, xnhe0, xnhem, delt, qne, ekinc, ekincw, vnhe )
|
|
|
|
implicit none
|
|
|
|
real(kind=8), intent(out) :: xnhep, vnhe
|
|
|
|
real(kind=8), intent(in) :: xnhe0, xnhem, delt, qne, ekinc, ekincw
|
|
|
|
xnhep = 2.0d0 * xnhe0 - xnhem + 2.0d0 * ( delt**2 / qne ) * ( ekinc - ekincw )
|
|
|
|
vnhe = ( xnhep - xnhem ) / ( 2.0d0 * delt )
|
|
|
|
return
|
2005-05-18 17:38:45 +08:00
|
|
|
end subroutine electrons_noseupd
|
2005-03-26 23:29:07 +08:00
|
|
|
|
|
|
|
|
|
|
|
SUBROUTINE electrons_nose_info()
|
|
|
|
|
|
|
|
use constants, only: factem, terahertz, pi
|
|
|
|
use time_step, only: delt
|
|
|
|
USE io_global, ONLY: stdout
|
|
|
|
USE control_flags, ONLY: tnosee
|
|
|
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
|
|
|
INTEGER :: nsvar, i
|
|
|
|
REAL(dbl) :: wnosee
|
|
|
|
|
|
|
|
IF( tnosee ) THEN
|
|
|
|
!
|
|
|
|
IF( fnosee <= 0.D0) &
|
|
|
|
CALL errore(' electrons_nose_info ', ' fnosee less than zero ', 1)
|
|
|
|
IF( delt <= 0.D0) &
|
|
|
|
CALL errore(' electrons_nose_info ', ' delt less than zero ', 1)
|
|
|
|
|
|
|
|
wnosee = fnosee * ( 2.d0 * pi ) * terahertz
|
|
|
|
nsvar = ( 2.d0 * pi ) / ( wnosee * delt )
|
|
|
|
|
|
|
|
WRITE( stdout,563) ekincw, nsvar, fnosee, qne
|
|
|
|
END IF
|
|
|
|
|
|
|
|
563 format( //, &
|
|
|
|
& 3X,'electrons dynamics with nose` temperature control:', /, &
|
|
|
|
& 3X,'Kinetic energy required = ', f10.5, ' (a.u.) ', /, &
|
|
|
|
& 3X,'time steps per nose osc. = ', i5, /, &
|
|
|
|
& 3X,'nose` frequency = ', f10.3, ' (THz) ', /, &
|
|
|
|
& 3X,'nose` mass(es) = ', 20(1X,f10.3),//)
|
|
|
|
|
|
|
|
|
|
|
|
RETURN
|
|
|
|
END SUBROUTINE electrons_nose_info
|
|
|
|
|
2005-01-15 18:53:46 +08:00
|
|
|
|
2004-11-02 00:43:29 +08:00
|
|
|
|
|
|
|
!------------------------------------------------------------------------------!
|
|
|
|
END MODULE electrons_nose
|
|
|
|
!------------------------------------------------------------------------------!
|