From 71c38d94944f9f2c63a4311fc3838225c1c5ee4c Mon Sep 17 00:00:00 2001 From: dalcorso Date: Fri, 21 Oct 2005 13:01:42 +0000 Subject: [PATCH] Changed symmetrization in the non-collinear case. (A. Smogunov and ADC) git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2326 c92efa57-630b-4861-b058-cf58834340f0 --- D3/Makefile | 1 + Gamma/Makefile | 1 + PH/Makefile | 1 + PP/Makefile | 1 + PW/Makefile | 1 + PW/inverse_s.f90 | 40 ++++++++++++++++++++++++++++++++++++++++ PW/sgam_at_mag.f90 | 6 ++++-- PW/sgama.f90 | 32 +------------------------------- PW/symrho_mag.f90 | 20 +++++++++++++++++--- PWCOND/Makefile | 1 + pwtools/Makefile | 1 + 11 files changed, 69 insertions(+), 36 deletions(-) create mode 100644 PW/inverse_s.f90 diff --git a/D3/Makefile b/D3/Makefile index ff6f825b4..a7caed5e3 100644 --- a/D3/Makefile +++ b/D3/Makefile @@ -286,6 +286,7 @@ PWOBJS = \ ../PW/init_at_1.o \ ../PW/init_vloc.o \ ../PW/interpolate.o \ +../PW/inverse_s.o \ ../PW/io_pot.o \ ../PW/irrek.o \ ../PW/iweights.o \ diff --git a/Gamma/Makefile b/Gamma/Makefile index c53361f64..d48bd27c8 100644 --- a/Gamma/Makefile +++ b/Gamma/Makefile @@ -109,6 +109,7 @@ PWOBJS = \ ../PW/init_at_1.o \ ../PW/init_vloc.o \ ../PW/interpolate.o \ +../PW/inverse_s.o \ ../PW/io_pot.o \ ../PW/irrek.o \ ../PW/iweights.o \ diff --git a/PH/Makefile b/PH/Makefile index 57d890402..ef9390cec 100644 --- a/PH/Makefile +++ b/PH/Makefile @@ -272,6 +272,7 @@ PWOBJS = \ ../PW/init_at_1.o \ ../PW/init_vloc.o \ ../PW/interpolate.o \ +../PW/inverse_s.o \ ../PW/io_pot.o \ ../PW/irrek.o \ ../PW/iweights.o \ diff --git a/PP/Makefile b/PP/Makefile index a787563f9..93d380ac7 100644 --- a/PP/Makefile +++ b/PP/Makefile @@ -162,6 +162,7 @@ PWOBJS = \ ../PW/init_at_1.o \ ../PW/init_vloc.o \ ../PW/interpolate.o \ +../PW/inverse_s.o \ ../PW/io_pot.o \ ../PW/irrek.o \ ../PW/iweights.o \ diff --git a/PW/Makefile b/PW/Makefile index 0be66f01b..d7b8afd9d 100644 --- a/PW/Makefile +++ b/PW/Makefile @@ -122,6 +122,7 @@ init_at_1.o \ init_vloc.o \ input.o \ interpolate.o \ +inverse_s.o \ io_pot.o \ ions.o \ irrek.o \ diff --git a/PW/inverse_s.f90 b/PW/inverse_s.f90 new file mode 100644 index 000000000..331476d33 --- /dev/null +++ b/PW/inverse_s.f90 @@ -0,0 +1,40 @@ +! +! 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 . +! +! +!----------------------------------------------------------------------- + +subroutine inverse_s (nrot, s, table, invs) + !--------------------------------------------------------------------- + implicit none + integer :: nrot, s (3, 3, 48), table (48, 48), invs (3, 3, 48) + ! input: number of symmetries of the original + ! input: matrices of the symmetry operations + ! input: multiplication table of the group + ! output: contains the inverse of each rotati + + + integer :: irot, jrot, ipol, jpol + ! counter over the rotations + ! counter over the rotations + ! counter over the polarizations + ! counter over the polarizations + do irot = 1, nrot + do jrot = 1, nrot + if (table (irot, jrot) .eq.1) then + do ipol = 1, 3 + do jpol = 1, 3 + invs (ipol, jpol, irot) = s (ipol, jpol, jrot) + enddo + enddo + endif + enddo + + enddo + return +end subroutine inverse_s + diff --git a/PW/sgam_at_mag.f90 b/PW/sgam_at_mag.f90 index 4a2be51cc..12f2b6790 100644 --- a/PW/sgam_at_mag.f90 +++ b/PW/sgam_at_mag.f90 @@ -8,7 +8,7 @@ ! !----------------------------------------------------------------------- subroutine sgam_at_mag (nrot, s, nat, tau, ityp, at, bg, nr1, nr2, & - nr3, sym, irt, ftau, m_loc) + nr3, sym, irt, ftau, m_loc, sname) !----------------------------------------------------------------------- ! ! given a point group, this routine finds the subgroup which is @@ -56,6 +56,7 @@ subroutine sgam_at_mag (nrot, s, nat, tau, ityp, at, bg, nr1, nr2, & ! atomic coordinates in crystal axis logical :: fractional_translations real(DP) :: ft (3), ft1, ft2, ft3 + character :: sname (48) * 45 ! external checksym ! @@ -94,7 +95,7 @@ subroutine sgam_at_mag (nrot, s, nat, tau, ityp, at, bg, nr1, nr2, & ft (3) = xau(3,na) - xau(3,nb) - nint( xau(3,na) - xau(3,nb) ) - call checksym_mag (irot, nat, ityp, xau, xau, ft, sym, irt,mxau,mrau) + call checksym_mag (irot, nat, ityp, xau, xau, ft, sym, irt, mxau, mxau) if (sym (irot) .and. (abs (ft (1) **2 + ft (2) **2 + ft (3) ** & 2) ) .lt.1.d-8) call errore ('sgam_at', 'overlapping atoms', na) @@ -134,6 +135,7 @@ subroutine sgam_at_mag (nrot, s, nat, tau, ityp, at, bg, nr1, nr2, & ! operation enddo enddo + if (sname(irot)(1:3)=='inv') mrau=-mrau ! ! first attempt: no fractional translation ! diff --git a/PW/sgama.f90 b/PW/sgama.f90 index bbfb461d8..21f4e845c 100644 --- a/PW/sgama.f90 +++ b/PW/sgama.f90 @@ -104,7 +104,7 @@ subroutine sgama (nrot, nat, s, sname, at, bg, tau, ityp, nsym, & call sgam_at (nrot, s, nat, tau, ityp, at, bg, nr1, nr2, nr3, sym, & irt, ftau) IF (noncolin) CALL sgam_at_mag (nrot, s, nat, tau, ityp, at, bg, & - nr1, nr2, nr3, sym, irt, ftau, m_loc) + nr1, nr2, nr3, sym, irt, ftau, m_loc, sname) ! ! If xq.ne.(0,0,0) this is a preparatory run for a linear response ! calculation at xq. The relevant point group is therefore only the @@ -200,33 +200,3 @@ subroutine sgama (nrot, nat, s, sname, at, bg, tau, ityp, nsym, & end subroutine sgama !----------------------------------------------------------------------- -subroutine inverse_s (nrot, s, table, invs) - !----------------------------------------------------------------------- - implicit none - integer :: nrot, s (3, 3, 48), table (48, 48), invs (3, 3, 48) - ! input: number of symmetries of the original - ! input: matrices of the symmetry operations - ! input: multiplication table of the group - ! output: contains the inverse of each rotati - - - integer :: irot, jrot, ipol, jpol - ! counter over the rotations - ! counter over the rotations - ! counter over the polarizations - ! counter over the polarizations - do irot = 1, nrot - do jrot = 1, nrot - if (table (irot, jrot) .eq.1) then - do ipol = 1, 3 - do jpol = 1, 3 - invs (ipol, jpol, irot) = s (ipol, jpol, jrot) - enddo - enddo - endif - enddo - - enddo - return -end subroutine inverse_s - diff --git a/PW/symrho_mag.f90 b/PW/symrho_mag.f90 index 3c407c90e..1efbb602b 100644 --- a/PW/symrho_mag.f90 +++ b/PW/symrho_mag.f90 @@ -15,6 +15,7 @@ subroutine symrho_mag (rho, nrx1, nrx2, nrx3, nr1, nr2, nr3, nsym, s, & ! #include "f_defs.h" USE kinds + USE CHAR, ONLY : sname implicit none ! ! first the dummy variables @@ -32,11 +33,22 @@ subroutine symrho_mag (rho, nrx1, nrx2, nrx3, nr1, nr2, nr3, nsym, s, & ! inp/out: the charge density integer , allocatable :: symflag (:,:,:) integer :: ri (48), rj (48), rk (48), kpol, i, j, k, isym + integer :: table(48, 48), invs(3, 3, 48) real(DP) :: sumx, sumy, sumz, mag(3), magrot(3) ! auxiliary variables if (nsym.eq.1) return + ! + ! We compute the multiplication table of the group + ! + call multable (nsym, s, table) + ! + ! And we set the matrices of the inverse + ! + call inverse_s (nsym, s, table, invs) + + allocate (symflag(nrx1, nrx2, nrx3)) do k = 1, nr3 do j = 1, nr2 @@ -64,10 +76,11 @@ subroutine symrho_mag (rho, nrx1, nrx2, nrx3, nr1, nr2, nr3, nsym, s, & enddo ! rotate the magnetic moment do kpol = 1, 3 - magrot(kpol) = s(1,kpol,isym)*mag(1) + & - s(2,kpol,isym)*mag(2) + & - s(3,kpol,isym)*mag(3) + magrot(kpol) = invs(1,kpol,isym)*mag(1) + & + invs(2,kpol,isym)*mag(2) + & + invs(3,kpol,isym)*mag(3) enddo + if (sname(isym)(1:3)=='inv') magrot=-magrot sumx = sumx + magrot(1) sumy = sumy + magrot(2) sumz = sumz + magrot(3) @@ -89,6 +102,7 @@ subroutine symrho_mag (rho, nrx1, nrx2, nrx3, nr1, nr2, nr3, nsym, s, & s(2,kpol,isym)*mag(2) + & s(3,kpol,isym)*mag(3) enddo + if (sname(isym)(1:3)=='inv') magrot=-magrot ! go back to carthesian coordinates do kpol = 1, 3 mag(kpol)=at(kpol,1)*magrot(1) + & diff --git a/PWCOND/Makefile b/PWCOND/Makefile index 7a3bbe4f0..e9262cce7 100644 --- a/PWCOND/Makefile +++ b/PWCOND/Makefile @@ -173,6 +173,7 @@ PWOBJS = \ ../PW/init_at_1.o \ ../PW/init_vloc.o \ ../PW/interpolate.o \ +../PW/inverse_s.o \ ../PW/io_pot.o \ ../PW/irrek.o \ ../PW/iweights.o \ diff --git a/pwtools/Makefile b/pwtools/Makefile index 2949a1f8c..b7a8525ee 100644 --- a/pwtools/Makefile +++ b/pwtools/Makefile @@ -12,6 +12,7 @@ PWOBJS = \ ../PW/error_handler.o \ ../PW/hexsym.o \ ../PW/irrek.o \ +../PW/inverse_s.o \ ../PW/kpoint_grid.o \ ../PW/mode_group.o \ ../PW/multable.o \