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

Cleanup of the phonon code. In the noncollinear case, the spin 

indeces are calculated only once, not in every routine.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@5380 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
dalcorso 2009-02-04 17:18:31 +00:00
parent b6a6652874
commit 9ee2377238
25 changed files with 152 additions and 188 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
PH/addnlcc.f90
View File

@ -20,6 +20,7 @@ subroutine addnlcc (imode0, drhoscf, npe)
USE gvect, ONLY : nrxx, g, ngm, nl, nrx1, nrx2, nrx3, nr1, nr2, nr3
USE lsda_mod, ONLY : nspin
USE spin_orb, ONLY : domag
USE noncollin_module, ONLY : nspin_lsda, nspin_gga
USE dynmat, ONLY : dyn, dyn_rec
USE modes, ONLY : nirr, npert, npertx
USE gc_ph, ONLY: grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s
@ -39,7 +40,7 @@ subroutine addnlcc (imode0, drhoscf, npe)
complex(DP) :: drhoscf (nrxx, nspin, npertx)
integer :: nrtot, ipert, jpert, is, is1, irr, ir, mode, mode1, nspin0, nspin1
integer :: nrtot, ipert, jpert, is, is1, irr, ir, mode, mode1
! the total number of points
! counter on perturbations
! counter on spin
@ -60,14 +61,6 @@ subroutine addnlcc (imode0, drhoscf, npe)
if (.not.nlcc_any) return
nspin0=nspin
nspin1=nspin
if (nspin==4) then
nspin0=1
nspin1=1
if (domag) nspin1=2
endif
allocate (drhoc( nrxx))
allocate (dvaux( nrxx , nspin))
@ -76,13 +69,13 @@ subroutine addnlcc (imode0, drhoscf, npe)
! compute the exchange and correlation potential for this mode
!
nrtot = nr1 * nr2 * nr3
fac = 1.d0 / DBLE (nspin0)
fac = 1.d0 / DBLE (nspin_lsda)
do ipert = 1, npe
mode = imode0 + ipert
dvaux (:,:) = (0.d0, 0.d0)
call addcore (mode, drhoc)
do is = 1, nspin0
do is = 1, nspin_lsda
call DAXPY (nrxx, fac, rho_core, 1, rho%of_r(1, is), 1)
call DAXPY (2 * nrxx, fac, drhoc, 1, drhoscf (1, is, ipert), 1)
enddo
@ -101,8 +94,8 @@ subroutine addnlcc (imode0, drhoscf, npe)
if ( dft_is_gradient() ) &
call dgradcorr (rho%of_r, grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, xq, &
drhoscf (1, 1, ipert), nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, &
nspin, nspin1, nl, ngm, g, alat, omega, dvaux)
do is = 1, nspin0
nspin, nspin_gga, nl, ngm, g, alat, omega, dvaux)
do is = 1, nspin_lsda
call DAXPY (nrxx, - fac, rho_core, 1, rho%of_r(1, is), 1)
call DAXPY (2 * nrxx, - fac, drhoc, 1, drhoscf (1, is, ipert), 1)
enddo
@ -111,7 +104,7 @@ subroutine addnlcc (imode0, drhoscf, npe)
do jpert = 1, npert (irr)
mode1 = mode1 + 1
call addcore (mode1, drhoc)
do is = 1, nspin0
do is = 1, nspin_lsda
dyn1 (mode, mode1) = dyn1 (mode, mode1) + &
ZDOTC (nrxx, dvaux (1, is), 1, drhoc, 1) * &
omega * fac / DBLE (nrtot)

22
PH/addnlcc_zstar_eu_us.f90
View File

@ -18,6 +18,7 @@ SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
USE lsda_mod, ONLY : nspin
USE gvect, ONLY : nrxx, ngm, nl, g, nrx1, nrx2, nrx3, nr1, nr2, nr3
USE spin_orb, ONLY : domag
USE noncollin_module, ONLY : nspin_lsda, nspin_gga
USE efield_mod, ONLY : zstareu0
USE qpoint, ONLY : xq
@ -35,7 +36,7 @@ SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
INTEGER :: nrtot, ipert, jpert, is, is1, irr, ir, mode, mode1
INTEGER :: imode0, npe, ipol, nspin0, nspin1
INTEGER :: imode0, npe, ipol
REAL(DP) :: fac
@ -46,15 +47,6 @@ SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
IF ( my_pool_id /= 0 ) RETURN
nspin0=nspin
nspin1=nspin
if (nspin==4) then
nspin0=1
nspin1=1
if (domag) nspin1=2
endif
DO ipol = 1, 3
imode0 = 0
DO irr = 1, nirr
@ -63,14 +55,14 @@ SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
! compute the exchange and correlation potential for this mode
!
nrtot = nr1 * nr2 * nr3
fac = 1.d0 / DBLE (nspin0)
fac = 1.d0 / DBLE (nspin_lsda)
DO ipert = 1, npe
mode = imode0 + ipert
dvaux = (0.0_dp,0.0_dp)
CALL addcore (mode, drhoc)
DO is = 1, nspin0
DO is = 1, nspin_lsda
rho%of_r(:,is) = rho%of_r(:,is) + fac * rho_core
END DO
@ -91,13 +83,13 @@ SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
IF ( dft_is_gradient() ) &
CALL dgradcorr (rho%of_r, grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, &
xq, drhoscf (1, 1, ipert), nr1, nr2, nr3, nrx1, nrx2, &
nrx3, nrxx, nspin, nspin1, nl, ngm, g, alat, omega, dvaux)
nrx3, nrxx, nspin, nspin_gga, nl, ngm, g, alat, omega, dvaux)
DO is = 1, nspin0
DO is = 1, nspin_lsda
rho%of_r(:,is) = rho%of_r(:,is) - fac * rho_core
END DO
DO is = 1, nspin0
DO is = 1, nspin_lsda
zstareu0(ipol,mode) = zstareu0(ipol,mode) - &
omega * fac / REAL(nrtot, DP) * &
DOT_PRODUCT(dvaux(1:nrxx,is),drhoc(1:nrxx))

9
PH/addusddens.f90
View File

@ -29,6 +29,7 @@ subroutine addusddens (drhoscf, dbecsum, irr, mode0, npe, iflag)
USE wavefunctions_module, ONLY: psic
USE uspp_param, ONLY: upf, lmaxq, nh, nhm
USE paw_variables, ONLY : okpaw
USE noncollin_module, ONLY : nspin_mag
USE modes, ONLY : u, npert, npertx
USE qpoint, ONLY : xq, eigqts
@ -57,7 +58,7 @@ subroutine addusddens (drhoscf, dbecsum, irr, mode0, npe, iflag)
! here the local variables
!
integer :: ig, na, nt, ih, jh, ir, mu, mode, ipert, is, ijh, nspin0
integer :: ig, na, nt, ih, jh, ir, mu, mode, ipert, is, ijh
! counter on G vectors
! counter on atoms
! counter on atomic type
@ -85,8 +86,6 @@ subroutine addusddens (drhoscf, dbecsum, irr, mode0, npe, iflag)
if (.not.okvan) return
call start_clock ('addusddens')
nspin0=nspin
if (nspin==4.and..not.domag) nspin0=1
allocate (aux( ngm , nspin , npertx))
allocate (sk ( ngm))
allocate (ylmk0(ngm , lmaxq * lmaxq))
@ -134,7 +133,7 @@ subroutine addusddens (drhoscf, dbecsum, irr, mode0, npe, iflag)
! And qgmq and becp and dbecq
!
do ipert = 1, npert (irr)
do is = 1, nspin0
do is = 1, nspin_mag
mode = mode0 + ipert
if (iflag==1) then
zsum = dbecsum (ijh, na, is, ipert)
@ -180,7 +179,7 @@ subroutine addusddens (drhoscf, dbecsum, irr, mode0, npe, iflag)
!
do ipert = 1, npert (irr)
mu = mode0 + ipert
do is = 1, nspin0
do is = 1, nspin_mag
psic(:) = (0.d0, 0.d0)
do ig = 1, ngm
psic (nl (ig) ) = aux (ig, is, ipert)

9
PH/addusddense.f90
View File

@ -23,6 +23,7 @@ subroutine addusddense (drhoscf, dbecsum)
ngm, eigts1, eigts2, eigts3, ig1, ig2, ig3
USE uspp, ONLY: okvan
USE uspp_param, ONLY: upf, lmaxq, nh, nhm
USE noncollin_module, ONLY : nspin_mag
USE qpoint, ONLY : eigqts
USE lsda_mod, ONLY : nspin
@ -43,7 +44,7 @@ subroutine addusddense (drhoscf, dbecsum)
! here the local variables
!
integer :: ig, na, nt, ih, jh, ir, mode, ipert, ijh, is, nspin0
integer :: ig, na, nt, ih, jh, ir, mode, ipert, ijh, is
! counters
@ -65,8 +66,6 @@ subroutine addusddense (drhoscf, dbecsum)
allocate (qgm (ngm))
allocate (qmod (ngm))
nspin0=nspin
if (nspin==4.and..not.domag) nspin0=1
!
! And then we compute the additional charge in reciprocal space
!
@ -95,7 +94,7 @@ subroutine addusddense (drhoscf, dbecsum)
!
! And qgmq and becp and dbecq
!
do is=1,nspin0
do is=1,nspin_mag
do ipert = 1, 3
zsum = dbecsum (ijh, na, is,ipert)
call ZAXPY(ngm,zsum,sk,1,aux(1,is,ipert),1)
@ -110,7 +109,7 @@ subroutine addusddense (drhoscf, dbecsum)
!
! convert aux to real space
!
do is=1,nspin0
do is=1,nspin_mag
do ipert = 1, 3
qg (:) = (0.d0, 0.d0)
qg (nl (:) ) = aux (:, is, ipert)

8
PH/addusdynmat.f90
View File

@ -24,6 +24,7 @@ subroutine addusdynmat (dynwrk)
USE uspp_param, only: upf, nh
USE lsda_mod, ONLY : nspin
USE spin_orb, ONLY : lspinorb
USE noncollin_module, ONLY : nspin_lsda
USE phus, ONLY : int1, int1_nc, int2, int2_so, int4, int4_nc, &
int5, int5_so, alphasum, alphasum_nc, becsum, becsum_nc
@ -35,7 +36,7 @@ subroutine addusdynmat (dynwrk)
! inp/out: the dynamical matrix
integer :: ipol, jpol, np, na, nb, nu_i, nu_j, ih, jh, ijh, dim, &
is, is1, is2, ijs, nspin0
is, is1, is2, ijs
! counter on polarizations
! counter on pseudopotentials
! counter on atoms
@ -52,9 +53,6 @@ subroutine addusdynmat (dynwrk)
if (.not.okvan) return
call start_clock ('addusdynmat')
nspin0=nspin
if (nspin==4) nspin0=1
IF (noncolin) CALL set_int12_nc(1)
dyn1 (:,:) = (0.d0, 0.d0)
@ -178,7 +176,7 @@ subroutine addusdynmat (dynwrk)
enddo
enddo
ELSE
do is = 1, nspin0
do is = 1, nspin_lsda
dyn1(nu_i,nu_j)=dyn1(nu_i,nu_j) + &
CONJG(int2(ih,jh,ipol,nb,na)) * &
alphasum(ijh,jpol,na,is) + &

16
PH/compute_vsgga.f90
View File

@ -17,18 +17,18 @@ SUBROUTINE compute_vsgga( rhoout, grho, vsgga )
nl, ngm, g
USE lsda_mod, ONLY : nspin
USE cell_base, ONLY : alat
USE noncollin_module, ONLY : noncolin
USE noncollin_module, ONLY : noncolin, nspin_gga
USE funct, ONLY : gcxc, gcx_spin, gcc_spin, &
gcc_spin_more, dft_is_gradient, get_igcc
USE spin_orb, ONLY : domag
!
IMPLICIT NONE
!
REAL(DP), INTENT(IN) :: rhoout(nrxx,2)
REAL(DP), INTENT(IN) :: grho(3,nrxx,2)
REAL(DP), INTENT(IN) :: rhoout(nrxx,nspin_gga)
REAL(DP), INTENT(IN) :: grho(3,nrxx,nspin_gga)
REAL(DP), INTENT(OUT) :: vsgga(nrxx)
!
INTEGER :: k, ipol, is, nspin0, jpol, ir
INTEGER :: k, ipol, is, jpol, ir
!
REAL(DP), ALLOCATABLE :: h(:,:,:), dh(:)
REAL(DP), ALLOCATABLE :: vaux(:,:)
@ -51,10 +51,8 @@ SUBROUTINE compute_vsgga( rhoout, grho, vsgga )
igcc_is_lyp = (get_igcc() == 3)
!
nspin0=2
!
ALLOCATE( h( 3, nrxx, nspin0) )
ALLOCATE( vaux( nrxx, nspin0 ) )
ALLOCATE( h( 3, nrxx, nspin_gga) )
ALLOCATE( vaux( nrxx, nspin_gga ) )
DO k = 1, nrxx
!
@ -155,7 +153,7 @@ SUBROUTINE compute_vsgga( rhoout, grho, vsgga )
! ... second term of the gradient correction :
! ... \sum_alpha (D / D r_alpha) ( D(rho*Exc)/D(grad_alpha rho) )
!
DO is = 1, nspin0
DO is = 1, nspin_gga
!
CALL grad_dot( nrx1, nrx2, nrx3, nr1, nr2, nr3, &
nrxx, h(1,1,is), ngm, g, nl, alat, dh )

13
PH/drho.f90
View File

@ -24,7 +24,7 @@ subroutine drho
USE lsda_mod, ONLY : nspin
USE cell_base, ONLY : omega
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE noncollin_module, ONLY : noncolin, npol
USE noncollin_module, ONLY : noncolin, npol, nspin_lsda, nspin_mag
USE uspp_param, ONLY : upf, nhm
USE uspp, ONLY : okvan, nkb
USE wvfct, ONLY : nbnd
@ -43,8 +43,7 @@ subroutine drho
implicit none
integer :: nt, mode, mu, na, is, ir, irr, iper, npe, nrstot, nu_i, nu_j, &
nspin0
integer :: nt, mode, mu, na, is, ir, irr, iper, npe, nrstot, nu_i, nu_j
! counter on atomic types
! counter on modes
! counter on atoms and polarizations
@ -150,14 +149,12 @@ subroutine drho
!
allocate (dvlocin( nrxxs))
nspin0=nspin
if (nspin==4) nspin0=1
wdyn (:,:) = (0.d0, 0.d0)
nrstot = nr1s * nr2s * nr3s
do nu_i = 1, 3 * nat
call compute_dvloc (nu_i, dvlocin)
do nu_j = 1, 3 * nat
do is = 1, nspin0
do is = 1, nspin_lsda
wdyn (nu_j, nu_i) = wdyn (nu_j, nu_i) + &
ZDOTC (nrxxs, drhous(1,is,nu_j), 1, dvlocin, 1) * &
omega / DBLE (nrstot)
@ -221,13 +218,11 @@ subroutine drho
END IF
mode = 0
nspin0=nspin
if (nspin==4.and..not.domag) nspin0=1
if (okpaw) becsumort=(0.0_DP,0.0_DP)
do irr = 1, nirr
npe = npert (irr)
if (doublegrid) then
do is = 1, nspin0
do is = 1, nspin_mag
do iper = 1, npe
call cinterpolate (drhoust(1,is,iper), drhous(1,is,mode+iper), 1)
enddo

7
PH/drhodvloc.f90
View File

@ -22,6 +22,7 @@ subroutine drhodvloc (nu_i0, nper, drhoscf, wdyn)
USE cell_base, ONLY : omega
USE lsda_mod, ONLY : nspin
USE modes, ONLY : npertx
USE noncollin_module, ONLY : nspin_lsda
USE mp_global, ONLY: intra_pool_comm
USE mp, ONLY: mp_sum
@ -35,7 +36,7 @@ subroutine drhodvloc (nu_i0, nper, drhoscf, wdyn)
! the change of density due to perturbations
! auxiliary matrix where drhodv is stored
integer :: ipert, is, nu_i, nu_j, nspin0
integer :: ipert, is, nu_i, nu_j
! counter on perturbations
! counter on spin polarizations
! counter on the i modes
@ -45,8 +46,6 @@ subroutine drhodvloc (nu_i0, nper, drhoscf, wdyn)
complex(DP), allocatable :: dvloc (:)
! d Vloc / dtau
nspin0=nspin
if (nspin==4) nspin0=1
allocate (dvloc( nrxxs))
dynwrk (:,:) = (0.d0, 0.d0)
!
@ -56,7 +55,7 @@ subroutine drhodvloc (nu_i0, nper, drhoscf, wdyn)
call compute_dvloc (nu_j, dvloc)
do ipert = 1, nper
nu_i = nu_i0 + ipert
do is = 1, nspin0
do is = 1, nspin_lsda
dynwrk (nu_i, nu_j) = dynwrk (nu_i, nu_j) + &
ZDOTC (nrxxs, drhoscf (1, is, ipert), 1, dvloc, 1) * &
omega / (nr1s * nr2s * nr3s)

9
PH/drhodvus.f90
View File

@ -29,6 +29,7 @@ subroutine drhodvus (irr, imode0, dvscfin, npe)
USE io_global, ONLY : stdout
USE uspp_param, ONLY : upf, nh
USE paw_variables, ONLY : okpaw
USE noncollin_module, ONLY : nspin_mag
USE modes, ONLY : npert, npertx, nirr
USE dynmat, ONLY : dyn, dyn_rec
@ -47,7 +48,7 @@ subroutine drhodvus (irr, imode0, dvscfin, npe)
complex(DP) :: dvscfin (nrxx, nspin, npe)
! input: the change of V_Hxc
integer :: ipert, irr1, mode0, mu, is, nu_i, nu_j, nrtot, nspin0, &
integer :: ipert, irr1, mode0, mu, is, nu_i, nu_j, nrtot, &
ih, jh, ijh, na, nb, nt
! counters
! mode0: starting position of the represention
@ -63,8 +64,6 @@ subroutine drhodvus (irr, imode0, dvscfin, npe)
dyn_rec=(0.0_DP,0.0_DP)
return
endif
nspin0=nspin
if (nspin==4.and..not.domag) nspin0=1
call start_clock ('drhodvus')
allocate (drhous ( nrxx , nspin, npertx))
dyn1 (:,:) = (0.d0, 0.d0)
@ -79,7 +78,7 @@ subroutine drhodvus (irr, imode0, dvscfin, npe)
nu_j = mode0 + ipert
do mu = 1, npert (irr)
nu_i = imode0 + mu
do is = 1, nspin0
do is = 1, nspin_mag
dyn1 (nu_i, nu_j) = dyn1 (nu_i, nu_j) + &
ZDOTC (nrxx, dvscfin (1,is,mu), 1, drhous (1,is,ipert), 1) &
* omega / DBLE (nrtot)
@ -115,7 +114,7 @@ subroutine drhodvus (irr, imode0, dvscfin, npe)
ijh=ijh+1
do na=1,nat
if (ityp(na)==nt) then
do is = 1, nspin0
do is = 1, nspin_mag
dyn1(nu_i,nu_j)=dyn1(nu_i,nu_j)+ &
CONJG(int3_paw(ih,jh,mu,na,is))* &
becsumort(ijh,na,is,nu_j)

21
PH/dv_of_drho.f90
View File

@ -21,6 +21,7 @@ subroutine dv_of_drho (mode, dvscf, flag)
USE cell_base, ONLY : alat, omega, tpiba2
USE lsda_mod, ONLY : nspin
USE spin_orb, ONLY : domag
USE noncollin_module, ONLY : nspin_gga, nspin_lsda
USE funct, ONLY : dft_is_gradient
USE scf, ONLY : rho, rho_core
@ -42,7 +43,7 @@ subroutine dv_of_drho (mode, dvscf, flag)
logical :: flag
! input: if true add core charge
integer :: ir, is, is1, ig, nspin0, nspin1
integer :: ir, is, is1, ig
! counter on r vectors
! counter on spin polarizations
! counter on g vectors
@ -57,14 +58,6 @@ subroutine dv_of_drho (mode, dvscf, flag)
call start_clock ('dv_of_drho')
nspin0=nspin
nspin1=nspin
if (nspin==4) then
nspin0=1
nspin1=1
if (domag) nspin1=2
endif
allocate (dvaux( nrxx, nspin))
allocate (drhoc( nrxx))
!
@ -73,10 +66,10 @@ subroutine dv_of_drho (mode, dvscf, flag)
dvaux (:,:) = (0.d0, 0.d0)
if (lrpa) goto 111
fac = 1.d0 / DBLE (nspin0)
fac = 1.d0 / DBLE (nspin_lsda)
if (nlcc_any.and.flag) then
call addcore (mode, drhoc)
do is = 1, nspin0
do is = 1, nspin_lsda
rho%of_r(:, is) = rho%of_r(:, is) + fac * rho_core (:)
dvscf(:, is) = dvscf(:, is) + fac * drhoc (:)
enddo
@ -94,10 +87,10 @@ subroutine dv_of_drho (mode, dvscf, flag)
!
if ( dft_is_gradient() ) call dgradcorr &
(rho%of_r, grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, xq, &
dvscf, nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, nspin, nspin1, &
dvscf, nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, nspin, nspin_gga, &
nl, ngm, g, alat, omega, dvaux)
if (nlcc_any.and.flag) then
do is = 1, nspin0
do is = 1, nspin_lsda
rho%of_r(:, is) = rho%of_r(:, is) - fac * rho_core (:)
dvscf(:, is) = dvscf(:, is) - fac * drhoc (:)
enddo
@ -114,7 +107,7 @@ subroutine dv_of_drho (mode, dvscf, flag)
!
! hartree contribution is computed in reciprocal space
!
do is = 1, nspin0
do is = 1, nspin_lsda
call cft3 (dvaux (1, is), nr1, nr2, nr3, nrx1, nrx2, nrx3, - 1)
do ig = 1, ngm
qg2 = (g(1,ig)+xq(1))**2 + (g(2,ig)+xq(2))**2 + (g(3,ig)+xq(3))**2

9
PH/dvanqq.f90
View File

@ -26,7 +26,7 @@ subroutine dvanqq
use lsda_mod, only : nspin
use spin_orb, only : lspinorb, domag
use scf, only : v, vltot
use noncollin_module, ONLY : noncolin, npol
use noncollin_module, ONLY : noncolin, npol, nspin_mag
USE uspp, ONLY: okvan
USE uspp_param, ONLY: upf, lmaxq, nh
@ -43,7 +43,7 @@ subroutine dvanqq
! And the local variables
!
integer :: nt, na, nb, ig, nta, ntb, ir, ih, jh, ijh, ipol, jpol, is, nspin0
integer :: nt, na, nb, ig, nta, ntb, ir, ih, jh, ijh, ipol, jpol, is
! counters
integer :: is1, is2, ijs, lh, kh, find_ijh
@ -67,9 +67,6 @@ subroutine dvanqq
if (recover.and..not.ldisp) return
nspin0=nspin
if (nspin==4.and..not.domag) nspin0=1
call start_clock ('dvanqq')
int1(:,:,:,:,:) = (0.d0, 0.d0)
int2(:,:,:,:,:) = (0.d0, 0.d0)
@ -190,7 +187,7 @@ subroutine dvanqq
* eigts3 (ig3 (ig), nb)
enddo
endif
do is = 1, nspin0
do is = 1, nspin_mag
do ipol = 1, 3
do ig = 1, ngm
aux2 (ig) = veff (nl (ig), is) * g (ipol, ig)

12
PH/dynmat_us.f90
View File

@ -29,25 +29,23 @@ SUBROUTINE dynmat_us()
USE cell_base, ONLY : omega, tpiba2
USE io_files, ONLY : iunigk
USE uspp_param, ONLY : nh
USE noncollin_module, ONLY : noncolin, npol
USE noncollin_module, ONLY : noncolin, npol, nspin_lsda
USE spin_orb, ONLY : lspinorb
USE becmod, ONLY : calbec
USE io_global, ONLY : stdout
USE qpoint, ONLY : npwq, nksq, igkq, ikks
USE modes, ONLY : u
USE dynmat, ONLY : dyn
USE phus, ONLY : becp1, becp1_nc, alphap, alphap_nc
USE control_ph, ONLY : nbnd_occ, lgamma
USE units_ph, ONLY : iuwfc, lrwfc
USE io_global, ONLY : stdout
USE mp_global, ONLY : my_pool_id, inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
IMPLICIT NONE
INTEGER :: icart, jcart, na_icart, na_jcart, na, nb, ng, nt, ik, &
ig, ir, is, ibnd, nu_i, nu_j, ijkb0, ikb, jkb, ih, jh, ikk, nspin0, &
ig, ir, is, ibnd, nu_i, nu_j, ijkb0, ikb, jkb, ih, jh, ikk, &
js, ijs
! counters
! ikk: record position of wfc at k
@ -66,8 +64,6 @@ SUBROUTINE dynmat_us()
! work space
CALL start_clock ('dynmat_us')
nspin0=nspin
if (nspin==4) nspin0=1
ALLOCATE (rhog ( nrxx))
ALLOCATE (work1 ( npwx))
ALLOCATE (work2 ( npwx))
@ -88,7 +84,7 @@ SUBROUTINE dynmat_us()
!
rhog (:) = (0.d0, 0.d0)
DO is = 1, nspin0
DO is = 1, nspin_lsda
rhog (:) = rhog (:) + CMPLX (rho%of_r(:, is), 0.d0)
ENDDO

23
PH/ef_shift.f90
View File

@ -23,6 +23,7 @@ subroutine ef_shift (drhoscf, ldos, ldoss, dos_ef, irr, npe, flag)
USE klist, ONLY : degauss, ngauss, ngk
USE ener, ONLY : ef
USE spin_orb, ONLY : domag
USE noncollin_module, ONLY : nspin_mag, nspin_lsda
! modules from phcom
USE qpoint, ONLY : nksq
USE control_ph, ONLY : nbnd_occ, lgamma_gamma
@ -66,7 +67,7 @@ subroutine ef_shift (drhoscf, ldos, ldoss, dos_ef, irr, npe, flag)
real(DP), external :: w0gauss
! the smeared delta function
integer :: ibnd, ik, is, ipert, nrec, ikrec, nspin0, nspin1
integer :: ibnd, ik, is, ipert, nrec, ikrec
! counter on occupied bands
! counter on k-point
! counter on spin polarizations
@ -79,15 +80,11 @@ subroutine ef_shift (drhoscf, ldos, ldoss, dos_ef, irr, npe, flag)
! determines Fermi energy shift (such that each pertubation is neutral)
!
call start_clock ('ef_shift')
nspin0=nspin
if (nspin==4.and. .not. domag) nspin0=1
nspin1=nspin
if (nspin==4) nspin1=1
if (.not.flag) then
WRITE( stdout, * )
do ipert = 1, npert (irr)
delta_n = (0.d0, 0.d0)
do is = 1, nspin1
do is = 1, nspin_lsda
call cft3 (drhoscf(1,is,ipert), nr1, nr2, nr3, nrx1, nrx2, nrx3, -1)
if (gg(1).lt.1.0d-8) delta_n = delta_n + omega*drhoscf(nl(1),is,ipert)
call cft3 (drhoscf(1,is,ipert), nr1, nr2, nr3, nrx1, nrx2, nrx3, +1)
@ -105,7 +102,7 @@ subroutine ef_shift (drhoscf, ldos, ldoss, dos_ef, irr, npe, flag)
! corrects the density response accordingly...
!
do ipert = 1, npert (irr)
call ZAXPY (nrxx*nspin0, def(ipert), ldos, 1, drhoscf(1,1,ipert), 1)
call ZAXPY (nrxx*nspin_mag, def(ipert), ldos, 1, drhoscf(1,1,ipert), 1)
enddo
else
!
@ -142,7 +139,7 @@ subroutine ef_shift (drhoscf, ldos, ldoss, dos_ef, irr, npe, flag)
enddo
enddo
do ipert = 1, npert (irr)
do is = 1, nspin0
do is = 1, nspin_mag
call ZAXPY (nrxxs, def(ipert), ldoss(1,is), 1, drhoscf(1,is,ipert), 1)
enddo
enddo
@ -176,7 +173,7 @@ subroutine ef_shift_paw (drhoscf, dbecsum, ldos, ldoss, becsum1, &
! modules from phcom
USE qpoint, ONLY : nksq
USE control_ph, ONLY : nbnd_occ, lgamma_gamma
USE noncollin_module, ONLY : noncolin, npol
USE noncollin_module, ONLY : noncolin, npol, nspin_lsda
USE units_ph, ONLY : lrwfc, iuwfc, lrdwf, iudwf
USE eqv, ONLY : dpsi
USE modes, ONLY : npert
@ -219,7 +216,7 @@ subroutine ef_shift_paw (drhoscf, dbecsum, ldos, ldoss, becsum1, &
real(DP), external :: w0gauss
! the smeared delta function
integer :: ibnd, ik, is, ipert, nrec, ikrec, nspin0
integer :: ibnd, ik, is, ipert, nrec, ikrec
! counter on occupied bands
! counter on k-point
! counter on spin polarizations
@ -231,13 +228,11 @@ subroutine ef_shift_paw (drhoscf, dbecsum, ldos, ldoss, becsum1, &
! determines Fermi energy shift (such that each pertubation is neutral)
!
call start_clock ('ef_shift')
nspin0=nspin
if (nspin==4) nspin0=1
if (.not.flag) then
WRITE( stdout, * )
do ipert = 1, npert (irr)
delta_n = (0.d0, 0.d0)
do is = 1, nspin0
do is = 1, nspin_lsda
call cft3 (drhoscf(1,is,ipert), nr1, nr2, nr3, nrx1, nrx2, nrx3, -1)
if (gg(1).lt.1.0d-8) delta_n = delta_n + omega*drhoscf(nl(1),is,ipert)
call cft3 (drhoscf(1,is,ipert), nr1, nr2, nr3, nrx1, nrx2, nrx3, +1)
@ -294,7 +289,7 @@ subroutine ef_shift_paw (drhoscf, dbecsum, ldos, ldoss, becsum1, &
enddo
enddo
do ipert = 1, npert (irr)
do is = 1, nspin0
do is = 1, nspin_lsda
call ZAXPY (nrxxs, def(ipert), ldoss(1,is), 1, drhoscf(1,is,ipert), 1)
enddo
enddo

15
PH/newdq.f90
View File

@ -18,7 +18,7 @@ subroutine newdq (dvscf, npe)
!
USE kinds, ONLY : DP
USE ions_base, ONLY : nat, ityp, ntyp => nsp
USE noncollin_module, ONLY : noncolin
USE noncollin_module, ONLY : noncolin, nspin_mag
USE cell_base, ONLY : omega
USE gvect, ONLY : nr1, nr2, nr3, nrx1, nrx2, nrx3, &
nrxx, g, gg, ngm, ig1, ig2, ig3, &
@ -49,7 +49,7 @@ subroutine newdq (dvscf, npe)
!
! And the local variables
!
integer :: na, ig, nt, ir, ipert, is, ih, jh, nspin0
integer :: na, ig, nt, ir, ipert, is, ih, jh
! countera
real(DP), allocatable :: qmod (:), qg (:,:), ylmk0 (:,:)
@ -66,12 +66,9 @@ subroutine newdq (dvscf, npe)
if (.not.okvan) return
call start_clock ('newdq')
nspin0=nspin
if (nspin==4.and..not.domag) nspin0=1
int3 (:,:,:,:,:) = (0.d0, 0.0d0)
allocate (aux1 (ngm))
allocate (aux2 (ngm , nspin0))
allocate (aux2 (ngm , nspin_mag))
allocate (veff (nrxx))
allocate (ylmk0(ngm , lmaxq * lmaxq))
allocate (qgm (ngm))
@ -100,7 +97,7 @@ subroutine newdq (dvscf, npe)
!
do ipert = 1, npe
do is = 1, nspin0
do is = 1, nspin_mag
do ir = 1, nrxx
veff (ir) = dvscf (ir, is, ipert)
enddo
@ -123,7 +120,7 @@ subroutine newdq (dvscf, npe)
eigts3(ig3(ig),na) * &
eigqts(na)
enddo
do is = 1, nspin0
do is = 1, nspin_mag
int3(ih,jh,ipert,na,is) = omega * &
ZDOTC(ngm,aux1,1,aux2(1,is),1)
enddo
@ -138,7 +135,7 @@ subroutine newdq (dvscf, npe)
!
do ih = 1, nh (nt)
do jh = ih, nh (nt)
do is = 1, nspin0
do is = 1, nspin_mag
int3(jh,ih,ipert,na,is) = int3(ih,jh,ipert,na,is)
enddo
enddo

9
PH/symdvscf.f90
View File

@ -19,6 +19,7 @@ subroutine symdvscf (nper, irr, dvtosym)
USE cell_base, ONLY : at
USE symme, ONLY : s, ftau
USE lsda_mod, ONLY: nspin
USE noncollin_module, ONLY : nspin_lsda
USE modes, ONLY : minus_q, irotmq, nsymq, irgq, gi, t, tmq, gimq
implicit none
@ -30,7 +31,7 @@ subroutine symdvscf (nper, irr, dvtosym)
! the potential to symmetriz
integer :: is, ri, rj, rk, i, j, k, ipert, jpert, ipol, isym, &
irot, nspin0
irot
! counter on spin polarizations
!
! the rotated points
@ -58,8 +59,6 @@ subroutine symdvscf (nper, irr, dvtosym)
if (nsymq == 1.and. (.not.minus_q) ) return
call start_clock ('symdvscf')
nspin0=nspin
if (nspin==4) nspin0=1
allocate (dvsym( nrx1 , nrx2 , nrx3 , nper))
!
! if necessary we symmetrize with respect to S(irotmq)*q = -q + Gi
@ -79,7 +78,7 @@ subroutine symdvscf (nper, irr, dvtosym)
term (1, 1) = CMPLX (cos (g1 (1) ), sin (g1 (1) ) )
term (2, 1) = CMPLX (cos (g2 (1) ), sin (g2 (1) ) )
term (3, 1) = CMPLX (cos (g3 (1) ), sin (g3 (1) ) )
do is = 1, nspin0
do is = 1, nspin_lsda
phase (1) = (1.d0, 0.d0)
do k = 1, nr3
do j = 1, nr2
@ -134,7 +133,7 @@ subroutine symdvscf (nper, irr, dvtosym)
term (3, isym) = CMPLX (cos (g3 (isym) ), sin (g3 (isym) ) )
enddo
do is = 1, nspin0
do is = 1, nspin_lsda
dvsym(:,:,:,:) = (0.d0, 0.d0)
do isym = 1, nsymq
phase (isym) = (1.d0, 0.d0)

10
PH/syme.f90
View File

@ -21,6 +21,7 @@ subroutine syme (dvsym)
USE gvect, only : nr1,nr2,nr3, nrx1,nrx2,nrx3
USE symme, only : nsym, s, ftau
USE lsda_mod, only : nspin
USE noncollin_module, only : nspin_lsda
USE kinds, only : DP
implicit none
@ -29,24 +30,21 @@ subroutine syme (dvsym)
! the potential to symmetrize
! auxiliary quantity
integer :: is, ri, rj, rk, i, j, k, irot, ipol, jpol, nspin0
integer :: is, ri, rj, rk, i, j, k, irot, ipol, jpol
! counter on spin polarization
! the rotated points
! the point
! counter on symmetries
! counter on polarizations
nspin0=nspin
if (nspin==4) nspin0=1
do is = 1, nspin0
do is = 1, nspin_lsda
do ipol = 1, 3
dvsym(:,:,:,is,ipol) = CMPLX(DBLE(dvsym(:,:,:,is,ipol)),0.d0)
end do
end do
if (nsym == 1) return
allocate (aux(nrx1 , nrx2 , nrx3 , 3))
do is = 1, nspin0
do is = 1, nspin_lsda
do ipol = 1, 3
aux(:,:,:,ipol) = dvsym(:,:,:,is,ipol)
dvsym(:,:,:,is,ipol) = (0.d0, 0.d0)

14
PH/zstar_eu_us.f90
View File

@ -30,7 +30,7 @@ subroutine zstar_eu_us
USE paw_variables, ONLY : okpaw
USE wavefunctions_module, ONLY : evc
USE uspp_param, ONLY : upf, nhm, nh
USE noncollin_module, ONLY : noncolin, npol
USE noncollin_module, ONLY : noncolin, npol, nspin_mag
USE qpoint, ONLY : nksq, npwq
USE control_ph, ONLY : nbnd_occ
USE efield_mod, ONLY : zstareu0
@ -45,7 +45,7 @@ subroutine zstar_eu_us
!
implicit none
integer :: ibnd, jbnd, ipol, jpol, imode0, irr, imode, nrec, mode
integer :: ik, ig, ir, is, i, j, nspin0, mu, ipert
integer :: ik, ig, ir, is, i, j, mu, ipert
integer :: ih, jh, ijh
integer :: iuhxc, lrhxc
!
@ -67,10 +67,6 @@ subroutine zstar_eu_us
call start_clock('zstar_us_1')
#endif
nspin0 = nspin
if (nspin==4.and..not.domag) nspin0=1
! auxiliary space for <psi|ds/du|psi>
allocate (dvscf( nrxx , nspin, 3))
allocate (dbecsum( nhm*(nhm+1)/2, nat, nspin, 3))
@ -182,8 +178,6 @@ subroutine zstar_eu_us
! potenial
!
imode0 = 0
nspin0 = nspin
if (nspin==4.and..not.domag) nspin0=1
allocate(drhoscfh(nrxx,nspin))
do irr = 1, nirr
npe = npert(irr)
@ -191,7 +185,7 @@ subroutine zstar_eu_us
mode = imode0 + imode
call davcio (drhoscfh, lrdrhous, iudrhous, mode, -1)
do jpol = 1, 3
do is=1,nspin0
do is=1,nspin_mag
zstareu0(jpol,mode) = zstareu0(jpol,mode) - &
dot_product(dvscf(1:nrxx,is,jpol),drhoscfh(1:nrxx,is)) &
* omega / DBLE(nr1*nr2*nr3)
@ -302,7 +296,7 @@ subroutine zstar_eu_us
do na=1,nat
if (ityp(na)==nt) then
do jpol = 1, 3
do is=1,nspin0
do is=1,nspin_mag
zstareu0(jpol,mode)=zstareu0(jpol,mode) &
-fact*int3_paw(ih,jh,jpol,na,is)* &
becsumort(ijh,na,is,mode)

13
PW/addusdens.f90
View File

@ -40,7 +40,7 @@ subroutine addusdens_g
eigts3, ig1, ig2, ig3
USE lsda_mod, ONLY : nspin
USE spin_orb, ONLY : domag
USE noncollin_module, ONLY : noncolin
USE noncollin_module, ONLY : noncolin, nspin_mag
USE scf, ONLY : rho
USE uspp, ONLY : becsum, okvan
USE uspp_param, ONLY : upf, lmaxq, nh
@ -52,7 +52,7 @@ subroutine addusdens_g
! here the local variables
!
integer :: ig, na, nt, ih, jh, ijh, is, nspin0
integer :: ig, na, nt, ih, jh, ijh, is
! counters
real(DP), allocatable :: qmod (:), ylmk0 (:,:)
@ -68,10 +68,7 @@ subroutine addusdens_g
call start_clock ('addusdens')
nspin0=nspin
if (noncolin.and..not.domag) nspin0=1
allocate (aux ( ngm, nspin0))
allocate (aux ( ngm, nspin_mag))
allocate (qmod( ngm))
allocate (qgm( ngm))
allocate (ylmk0( ngm, lmaxq * lmaxq))
@ -102,7 +99,7 @@ subroutine addusdens_g
#ifdef DEBUG_ADDUSDENS
call start_clock ('addus:aux')
#endif
do is = 1, nspin0
do is = 1, nspin_mag
do ig = 1, ngm
skk = eigts1 (ig1 (ig), na) * &
eigts2 (ig2 (ig), na) * &
@ -126,7 +123,7 @@ subroutine addusdens_g
!
! convert aux to real space and add to the charge density
!
do is = 1, nspin0
do is = 1, nspin_mag
psic(:) = (0.d0, 0.d0)
psic( nl(:) ) = aux(:,is)
if (gamma_only) psic( nlm(:) ) = CONJG(aux(:,is))

5
PW/compute_dip.f90
View File

@ -19,6 +19,7 @@ SUBROUTINE compute_dip(rho, dip, dipion, z0)
USE cell_base, ONLY : alat, at, bg, omega
USE gvect, ONLY : nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx
USE lsda_mod, ONLY : nspin
USE noncollin_module, ONLY : nspin_lsda
USE extfield, ONLY : edir
USE mp_global, ONLY : me_pool
USE fft_base, ONLY : grid_gather
@ -63,14 +64,14 @@ SUBROUTINE compute_dip(rho, dip, dipion, z0)
#ifdef __PARA
ALLOCATE(aux(nrxx))
aux(:) =0.d0
DO is=1,nspin
DO is=1,nspin_lsda
aux(:) = aux(:) + rho(:,is)
ENDDO
CALL grid_gather (aux, rrho)
DEALLOCATE(aux)
IF ((me_pool+1).EQ.1) THEN
#else
DO is=1,nspin
DO is=1,nspin_lsda
rrho=rrho+rho(:,is)
ENDDO
#endif

17
PW/newd.f90
View File

@ -62,14 +62,14 @@ SUBROUTINE newd_g()
USE control_flags, ONLY : gamma_only
USE wavefunctions_module, ONLY : psic
USE spin_orb, ONLY : lspinorb, domag
USE noncollin_module, ONLY : noncolin
USE noncollin_module, ONLY : noncolin, nspin_mag
USE mp_global, ONLY : intra_pool_comm
USE mp, ONLY : mp_sum
USE uspp, ONLY : nhtol, nhtolm
!
IMPLICIT NONE
!
INTEGER :: ig, nt, ih, jh, na, is, nht, nspin0, nb, mb
INTEGER :: ig, nt, ih, jh, na, is, nht, nb, mb
! counters on g vectors, atom type, beta functions x 2,
! atoms, spin, aux, aux, beta func x2 (again)
COMPLEX(DP), ALLOCATABLE :: aux(:,:), qgm(:), qgm_na(:)
@ -129,10 +129,7 @@ SUBROUTINE newd_g()
!
CALL start_clock( 'newd' )
!
nspin0=nspin
IF (noncolin.and..not.domag) nspin0=1
!
ALLOCATE( aux( ngm, nspin0 ), qgm_na( ngm ), &
ALLOCATE( aux( ngm, nspin_mag ), qgm_na( ngm ), &
qgm( ngm ), qmod( ngm ), ylmk0( ngm, lmaxq*lmaxq ) )
!
deeq(:,:,:,:) = 0.D0
@ -143,9 +140,9 @@ SUBROUTINE newd_g()
!
! ... fourier transform of the total effective potential
!
DO is = 1, nspin0
DO is = 1, nspin_mag
!
IF ( nspin0 == 4 .AND. is /= 1 ) THEN
IF ( nspin_mag == 4 .AND. is /= 1 ) THEN
!
psic(:) = v%of_r(:,is)
!
@ -188,7 +185,7 @@ SUBROUTINE newd_g()
!
! ... and the product with the Q functions
!
DO is = 1, nspin0
DO is = 1, nspin_mag
!
deeq(ih,jh,na,is) = fact * omega * &
DDOT( 2 * ngm, aux(1,is), 1, qgm_na, 1 )
@ -213,7 +210,7 @@ SUBROUTINE newd_g()
!
END DO
!
CALL mp_sum( deeq( :, :, :, 1:nspin0 ), intra_pool_comm )
CALL mp_sum( deeq( :, :, :, 1:nspin_mag ), intra_pool_comm )
!
DEALLOCATE( aux, qgm_na, qgm, qmod, ylmk0 )
!

5
PW/noncol.f90
View File

@ -17,6 +17,11 @@ MODULE noncollin_module
npol, & ! number of coordinates of wfc
report, & ! print the local quantities (magnet. and rho)
! every #report iterations
nspin_lsda = 1, & ! =1 when nspin=1,4 =2 when nspin=2
nspin_mag = 1, & ! =1 when nspin=1,4 (domag=.false.), =2 when
! nspin=2, =4 nspin=4 (domag=.true.)
nspin_gga = 1, & ! =1 when nspin=1,4 (domag=.false.)
! =2 when nspin=2,4 (domag=.true.) (needed with gga)
i_cons = 0 ! indicator for constrained local quantities
!
INTEGER, ALLOCATABLE :: &

19
PW/read_file.f90
View File

@ -32,14 +32,14 @@ SUBROUTINE read_file()
nrx1, nrx2, nrx3, eigts1, eigts2, eigts3, &
nl, gstart
USE gsmooth, ONLY : ngms, nls, nrx1s, nr1s, nr2s, nr3s
USE spin_orb, ONLY : lspinorb
USE spin_orb, ONLY : lspinorb, domag
USE scf, ONLY : rho, rho_core, rhog_core, v
USE wavefunctions_module, ONLY : psic
USE vlocal, ONLY : strf
USE io_files, ONLY : tmp_dir, prefix, iunpun, nwordwfc, iunwfc, qexml_version
USE buffers, ONLY : open_buffer, close_buffer
USE uspp_param, ONLY : upf
USE noncollin_module, ONLY : noncolin, npol
USE noncollin_module, ONLY : noncolin, npol, nspin_lsda, nspin_mag, nspin_gga
USE pw_restart, ONLY : pw_readfile
USE xml_io_base, ONLY : pp_check_file
USE uspp, ONLY : okvan, becsum
@ -155,6 +155,21 @@ SUBROUTINE read_file()
IF (nat > 0) CALL checkallsym( nsym, s, nat, tau, &
ityp, at, bg, nr1, nr2, nr3, irt, ftau, alat, omega )
!
! Set the different spin indices
!
nspin_mag = nspin
nspin_lsda = nspin
nspin_gga = nspin
IF (nspin==4) THEN
nspin_lsda=1
IF (domag) THEN
nspin_gga=2
ELSE
nspin_gga=1
nspin_mag=1
ENDIF
ENDIF
!
! ... read pseudopotentials
!
CALL pw_readfile( 'pseudo', ierr )

27
PW/realus.f90
View File

@ -466,7 +466,7 @@ MODULE realus
USE scf, ONLY : v, vltot
USE uspp, ONLY : okvan, deeq, deeq_nc, dvan, dvan_so
USE uspp_param, ONLY : upf, nh, nhm
USE noncollin_module, ONLY : noncolin
USE noncollin_module, ONLY : noncolin, nspin_mag
USE spin_orb, ONLY : domag, lspinorb
USE mp_global, ONLY : intra_pool_comm
USE mp, ONLY : mp_sum
@ -474,7 +474,7 @@ MODULE realus
IMPLICIT NONE
!
REAL(DP), ALLOCATABLE :: aux(:)
INTEGER :: ia, ih, jh, is, ir, nt, nspin0
INTEGER :: ia, ih, jh, is, ir, nt
INTEGER :: mbia, nht, nhnt, iqs
!
IF ( .NOT. okvan ) THEN
@ -517,17 +517,13 @@ MODULE realus
!
CALL start_clock( 'newd' )
!
nspin0 = nspin
!
IF ( noncolin .AND..NOT. domag ) nspin0 = 1
!
deeq(:,:,:,:) = 0.D0
!
ALLOCATE( aux( nrxx ) )
!
DO is = 1, nspin0
DO is = 1, nspin_mag
!
IF ( nspin0 == 4 .AND. is /= 1 ) THEN
IF ( nspin_mag == 4 .AND. is /= 1 ) THEN
aux(:) = v%of_r(:,is)
ELSE
aux(:) = vltot(:) + v%of_r(:,is)
@ -564,7 +560,7 @@ MODULE realus
!
DEALLOCATE( aux )
!
CALL mp_sum( deeq(:,:,:,1:nspin0) , intra_pool_comm )
CALL mp_sum( deeq(:,:,:,1:nspin_mag) , intra_pool_comm )
!
DO ia = 1, nat
!
@ -582,7 +578,7 @@ MODULE realus
!
nhnt = nh(nt)
!
DO is = 1, nspin0
DO is = 1, nspin_mag
DO ih = 1, nhnt
DO jh = ih, nhnt
deeq(ih,jh,ia,is) = deeq(ih,jh,ia,is) + dvan(ih,jh,nt)
@ -876,14 +872,14 @@ MODULE realus
USE gvect, ONLY : nr1, nr2, nr3
USE uspp, ONLY : okvan, becsum
USE uspp_param, ONLY : upf, nh
USE noncollin_module, ONLY : noncolin
USE noncollin_module, ONLY : noncolin, nspin_mag
USE spin_orb, ONLY : domag
USE mp_global, ONLY : intra_pool_comm
USE mp, ONLY : mp_sum
!
IMPLICIT NONE
!
INTEGER :: ia, nt, ir, irb, ih, jh, ijh, is, nspin0, mbia, nhnt, iqs
INTEGER :: ia, nt, ir, irb, ih, jh, ijh, is, mbia, nhnt, iqs
REAL(DP) :: charge
!
!
@ -891,11 +887,8 @@ MODULE realus
!
CALL start_clock( 'addusdens' )
!
nspin0 = nspin
!
IF ( noncolin .AND..NOT. domag ) nspin0 = 1
!
DO is = 1, nspin0
DO is = 1, nspin_mag
!
iqs = 0
!
@ -933,7 +926,7 @@ MODULE realus
!
! ... check the integral of the total charge
!
charge = SUM( rho%of_r(:,1:nspin0) )*omega / ( nr1*nr2*nr3 )
charge = SUM( rho%of_r(:,1:nspin_mag) )*omega / ( nr1*nr2*nr3 )
!
CALL mp_sum( charge , intra_pool_comm )
!

20
PW/setup.f90
View File

@ -30,7 +30,7 @@ SUBROUTINE setup()
! ... irt for each atom gives the corresponding symmetric
! ... invsym if true the system has inversion symmetry
! ... 3) generates k-points corresponding to the actual crystal symmetry
! ... 4) calculates various quantities used in magnetic,spin-orbit, PAW
! ... 4) calculates various quantities used in magnetic, spin-orbit, PAW
! ... electric-field, LDA+U calculations, and for parallelism
!
USE kinds, ONLY : DP
@ -72,7 +72,8 @@ SUBROUTINE setup()
USE mp_global, ONLY : nimage, kunit
USE spin_orb, ONLY : lspinorb, domag
USE noncollin_module, ONLY : noncolin, npol, m_loc, i_cons, mcons, &
angle1, angle2, bfield, ux
angle1, angle2, bfield, ux, nspin_lsda, &
nspin_gga, nspin_mag
USE pw_restart, ONLY : pw_readfile
USE input_parameters, ONLY : restart_mode
#if defined (EXX)
@ -215,6 +216,21 @@ SUBROUTINE setup()
CALL errore( 'setup', 'i_cons can be 5 only with nspin=2', 1 )
END IF
!
! Set the different spin indices
!
nspin_mag = nspin
nspin_lsda = nspin
nspin_gga = nspin
IF (nspin==4) THEN
nspin_lsda=1
IF (domag) THEN
nspin_gga=2
ELSE
nspin_gga=1
nspin_mag=1
ENDIF
ENDIF
!
! ... if this is not a spin-orbit calculation, all spin-orbit pseudopotentials
! ... are transformed into standard pseudopotentials
!

7
PW/stres_loc.f90
View File

@ -23,6 +23,7 @@ subroutine stres_loc (sigmaloc)
USE control_flags, ONLY : gamma_only
USE wavefunctions_module, ONLY : psic
USE uspp_param, ONLY : upf
USE noncollin_module, ONLY : nspin_lsda
USE mp_global, ONLY : intra_pool_comm
USE mp, ONLY : mp_sum
!
@ -31,7 +32,7 @@ subroutine stres_loc (sigmaloc)
real(DP) :: sigmaloc (3, 3)
real(DP) , allocatable :: dvloc(:)
real(DP) :: evloc, fact
integer :: ng, nt, l, m, is, nspin0
integer :: ng, nt, l, m, is
! counter on g vectors
! counter on atomic type
! counter on angular momentum
@ -40,9 +41,7 @@ subroutine stres_loc (sigmaloc)
allocate(dvloc(ngl))
sigmaloc(:,:) = 0.d0
psic(:)=(0.d0,0.d0)
nspin0=nspin
if (nspin==4) nspin0=1
do is = 1, nspin0
do is = 1, nspin_lsda
call DAXPY (nrxx, 1.d0, rho%of_r (1, is), 1, psic, 2)
enddo