2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! Copyright (C) 2001 PWSCF group
|
|
|
|
|
! 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 .
|
|
|
|
|
!
|
|
|
|
|
!-----------------------------------------------------------------------
|
2003-02-08 00:04:36 +08:00
|
|
|
subroutine init_ns
|
2003-01-20 05:58:50 +08:00
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! This routine computes the starting ns (for lda+U calculation) filling
|
|
|
|
|
! up the d states (the only interested by the on-site potential for the
|
|
|
|
|
! moment) according to the Hund's rule (valid for the isolated atoms on
|
|
|
|
|
! which starting potential is built), and to the starting_magnetization:
|
|
|
|
|
! majority spin levels are populated first, then the remaining electrons
|
|
|
|
|
! are equally distributed among the minority spin states
|
|
|
|
|
!
|
|
|
|
|
#include "machine.h"
|
|
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
use pwcom
|
2003-01-20 05:58:50 +08:00
|
|
|
implicit none
|
|
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
real(kind=DP) :: totoc
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
integer :: na, nt, is, m1, majs, mins, i
|
2003-01-20 05:58:50 +08:00
|
|
|
logical :: nm ! true if the atom is non magnetic
|
|
|
|
|
|
|
|
|
|
ns(:,:,:,:) = 0.d0
|
|
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
do na = 1, nat
|
|
|
|
|
nt = ityp (na)
|
|
|
|
|
if (Hubbard_U(nt).ne.0.d0 .or. Hubbard_alpha(nt).ne.0.d0) then
|
|
|
|
|
call tabd (nt, totoc)
|
2003-01-20 05:58:50 +08:00
|
|
|
nm=.false.
|
2003-02-10 16:58:33 +08:00
|
|
|
if (starting_magnetization (nt) .gt.0.d0) then
|
|
|
|
|
majs = 1
|
|
|
|
|
mins = 2
|
|
|
|
|
elseif (starting_magnetization (nt) .lt.0.d0) then
|
|
|
|
|
majs = 2
|
|
|
|
|
mins = 1
|
|
|
|
|
else
|
|
|
|
|
nm = .true.
|
|
|
|
|
endif
|
|
|
|
|
if (.not.nm) then
|
|
|
|
|
if (totoc.gt.2*Hubbard_l(nt)+1) then
|
|
|
|
|
do m1 = 1, 2*Hubbard_l(nt)+1
|
|
|
|
|
ns (na, majs, m1, m1) = 1.d0
|
|
|
|
|
ns (na, mins, m1, m1) = (totoc - 2*Hubbard_l(nt)+1 ) / &
|
|
|
|
|
(2*Hubbard_l(nt)+1)
|
|
|
|
|
enddo
|
|
|
|
|
else
|
|
|
|
|
do m1 = 1, 2*Hubbard_l(nt)+1
|
|
|
|
|
ns (na, majs, m1, m1) = totoc / (2*Hubbard_l(nt)+1)
|
|
|
|
|
enddo
|
|
|
|
|
endif
|
|
|
|
|
else
|
|
|
|
|
do m1 = 1, 2*Hubbard_l(nt)+1
|
|
|
|
|
ns (na, 1, m1, m1) = totoc / 2.d0 / (2*Hubbard_l(nt)+1)
|
|
|
|
|
ns (na, 2, m1, m1) = ns (na, 1, m1, m1)
|
|
|
|
|
enddo
|
|
|
|
|
endif
|
|
|
|
|
endif
|
|
|
|
|
enddo
|
|
|
|
|
return
|
2003-01-20 05:58:50 +08:00
|
|
|
end subroutine init_ns
|
|
|
|
|
|
