Minor symmetry cleanup

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@8088 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2011-08-15 13:08:03 +00:00
parent 5aca42ec3f
commit 2c1c3c2bfd
7 changed files with 106 additions and 136 deletions

View File

@ -1742,7 +1742,7 @@ SUBROUTINE gen_qpoints (ibrav, at_, bg_, nat, tau, ityp, nk1, nk2, nk3, &
!
USE kinds, ONLY : DP
USE cell_base, ONLY : at, bg
USE symm_base, ONLY : set_sym_bl, find_sym, s, ftau, irt, nsym, &
USE symm_base, ONLY : set_sym_bl, find_sym, s, irt, nsym, &
nrot, t_rev, time_reversal, sname
!
IMPLICIT NONE
@ -2234,7 +2234,7 @@ SUBROUTINE find_representations_mode_q( nat, ntyp, xq, w2, u, tau, ityp, pmass,&
USE cell_base, ONLY : at, bg
USE symm_base, ONLY : find_sym, s, sr, ftau, irt, nsym, &
nrot, t_rev, time_reversal, sname, copy_sym, &
s_axis_to_cart, symmorphic
s_axis_to_cart
IMPLICIT NONE
INTEGER, INTENT(IN) :: nat, ntyp, nspin_mag
@ -2246,7 +2246,7 @@ SUBROUTINE find_representations_mode_q( nat, ntyp, xq, w2, u, tau, ityp, pmass,&
INTEGER, INTENT(OUT) :: num_rap_mode(3*nat)
REAL(DP) :: gi (3, 48), gimq (3), sr_is(3,3,48), rtau(3,48,nat)
INTEGER :: irgq (48), irotmq, nsymq, nsym_is, isym, i
LOGICAL :: minus_q, search_sym, is_symmorphic, sym(48), magnetic_sym
LOGICAL :: minus_q, search_sym, sym(48), magnetic_sym
!
! find the small group of q
!
@ -2259,15 +2259,11 @@ SUBROUTINE find_representations_mode_q( nat, ntyp, xq, w2, u, tau, ityp, pmass,&
CALL smallgq (xq,at,bg,s,nsym,irgq,nsymq,irotmq,minus_q,gi,gimq)
!
! decide if the small group of q is symmorphic
!
is_symmorphic=symmorphic(nsymq,ftau)
!
! if it is non symmorphic search the symmetries only if there are no
! G such that Sq -> q+G
! if the small group of q is non symmorphic,
! search the symmetries only if there are no G such that Sq -> q+G
!
search_sym=.TRUE.
IF (.NOT.is_symmorphic) THEN
IF ( ANY ( ftau(:,1:nsymq) /= 0 ) ) THEN
DO isym=1,nsymq
search_sym=( search_sym.and.(abs(gi(1,irgq(isym)))<1.d-8).and. &
(abs(gi(2,irgq(isym)))<1.d-8).and. &

View File

@ -35,7 +35,6 @@ subroutine set_irr (nat, at, bg, xq, s, sr, tau, ntyp, ityp, ftau, invs, nsym, &
USE kinds, only : DP
USE constants, ONLY: tpi
USE random_numbers, ONLY : randy
USE symm_base, ONLY : symmorphic
USE rap_point_group, ONLY : name_rap
#ifdef __PARA
use mp, only: mp_bcast
@ -111,7 +110,7 @@ subroutine set_irr (nat, at, bg, xq, s, sr, tau, ntyp, ityp, ftau, invs, nsym, &
! rotated pattern
! the phase factor
logical :: lgamma, is_symmorphic, magnetic_sym
logical :: lgamma, magnetic_sym
! if true gamma point
!
! Allocate the necessary quantities
@ -121,8 +120,9 @@ subroutine set_irr (nat, at, bg, xq, s, sr, tau, ntyp, ityp, ftau, invs, nsym, &
! find the small group of q
!
call smallgq (xq,at,bg,s,nsym,irgq,nsymq,irotmq,minus_q,gi,gimq)
is_symmorphic=symmorphic(nsymq, ftau)
IF (.not.is_symmorphic) THEN
! are there non-symmorphic operations?
! note that in input search_sym should be initialized to=.true.
IF ( ANY ( ftau(:,1:nsymq) /= 0 ) ) THEN
DO isym=1,nsymq
search_sym=( search_sym.and.(abs(gi(1,irgq(isym)))<1.d-8).and. &
(abs(gi(2,irgq(isym)))<1.d-8).and. &

View File

@ -96,7 +96,7 @@ MODULE pw_restart
USE ldaU, ONLY : lda_plus_u, Hubbard_lmax, Hubbard_l, &
Hubbard_U, Hubbard_alpha
USE spin_orb, ONLY : lspinorb, domag
USE symm_base, ONLY : nrot, nsym, invsym, s, ft, ftau, irt, &
USE symm_base, ONLY : nrot, nsym, invsym, s, ft, irt, &
t_rev, sname, time_reversal, no_t_rev
USE lsda_mod, ONLY : nspin, isk, lsda, starting_magnetization
USE noncollin_module, ONLY : angle1, angle2, i_cons, mcons, bfield, &

View File

@ -25,7 +25,7 @@ SUBROUTINE setup()
! ... s symmetry matrices in the direct lattice vectors basis
! ... nsym number of crystal symmetry operations
! ... nrot number of lattice symmetry operations
! ... ftau fractionary translations
! ... ft fractionary translations
! ... 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
@ -57,7 +57,7 @@ SUBROUTINE setup()
USE start_k, ONLY : nks_start, xk_start, wk_start, &
nk1, nk2, nk3, k1, k2, k3
USE ktetra, ONLY : tetra, ntetra, ltetra
USE symm_base, ONLY : s, t_rev, irt, ftau, nrot, nsym, invsym, &
USE symm_base, ONLY : s, t_rev, irt, nrot, nsym, invsym, &
d1,d2,d3, time_reversal, sname, set_sym_bl, &
find_sym
USE wvfct, ONLY : nbnd, nbndx, ecutwfc

View File

@ -438,7 +438,8 @@ SUBROUTINE print_symmetries ( iverbosity, noncolin, domag )
!
USE kinds, ONLY : dp
USE io_global, ONLY : stdout
USE symm_base, ONLY : nsym, invsym, s, sr, t_rev, ftau, sname
USE symm_base, ONLY : nsym, nsym_ns, nsym_na, invsym, s, sr, &
t_rev, ftau, sname
USE rap_point_group, ONLY : code_group, nclass, nelem, elem, &
which_irr, char_mat, name_rap, name_class, gname, ir_ram
USE rap_point_group_so, ONLY : nrap, nelem_so, elem_so, has_e, &
@ -463,11 +464,29 @@ SUBROUTINE print_symmetries ( iverbosity, noncolin, domag )
WRITE( stdout, '(/5x,"No symmetry found")')
ELSE
IF (invsym) THEN
WRITE( stdout, '(/5x,i2," Sym.Ops. (with inversion)",/)') nsym
IF ( nsym_ns > 0 ) THEN
WRITE( stdout, '(/5x,i2," Sym.Ops. (including inversion) found", &
& "(",i2," are non-symmorphic ops)")' ) nsym, nsym_ns
ELSE
WRITE( stdout, '(/5x,i2," Sym.Ops. (no inversion)",/)') nsym
WRITE( stdout, '(/5x,i2," Sym.Ops. (including inversion) found")' )&
nsym
END IF
ELSE
IF ( nsym_ns > 0 ) THEN
WRITE( stdout, '(/5x,i2," Sym.Ops. (no inversion) found",&
& "(",i2," are non-symmorphic ops)")' ) nsym, nsym_ns
ELSE
WRITE( stdout,'(/5x,i2," Sym.Ops. (no inversion) found")' ) nsym
END IF
ENDIF
ENDIF
IF ( nsym_na > 0 ) THEN
WRITE( stdout, '(10x,"(note: ",i2," additional sym.ops. were found ", &
& "but ignored",/,10x," their fractional transations ", &
& "are incommensurate with FFT grid)",/)') nsym_na
ELSE
WRITE( stdout, '(/)' )
END IF
IF ( iverbosity > 0 ) THEN
WRITE( stdout, '(36x,"s",24x,"frac. trans.")')
nsym_is=0

View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2010 Quantum ESPRESSO group
! Copyright (C) 2010-2011 Quantum ESPRESSO 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,
@ -15,7 +15,7 @@ MODULE symm_base
! ... The variables needed to describe the symmetry properties
! ... and the routines to find crystal symmetries
!
! ... are acceptance criteria
! ... these are acceptance criteria
!
REAL(DP), parameter :: eps1 = 1.0d-6, eps2 = 1.0d-5
!
@ -25,17 +25,24 @@ MODULE symm_base
!
! ... Exported variables
!
PUBLIC :: s, sr, sname, ft, ftau, nrot, nsym, t_rev, no_t_rev, &
time_reversal, irt, invs, invsym, is_symmorphic, d1, d2, d3
PUBLIC :: s, sr, sname, ft, ftau, nrot, nsym, nsym_ns, nsym_na, t_rev, &
no_t_rev, time_reversal, irt, invs, invsym, d1, d2, d3
INTEGER :: &
s(3,3,48), &! symmetry matrices, in crystal axis
invs(48), &! index of inverse operation: S^{-1}_i=S(invs(i))
ftau(3,48), &! fractional translations, in FFT coordinates
nrot, &! number of bravais lattice symmetries
nsym ! number of crystal symmetries
nsym = 1, &! total number of crystal symmetries
nsym_ns = 0, &! nonsymmorphic (fractional translation) symms
nsym_na = 0 ! excluded nonsymmorphic symmetries because
! fract. transl. is noncommensurate with FFT grid
REAL (DP) :: &
ft (3,48), &! fractional translations, in crystal axis
sr (3,3,48) ! symmetry matrices, in cartesian axis
!
! ... note: ftau are used for symmetrization in real space (phonon, exx)
! ... in which case they must be commensurated with the FFT grid
!
CHARACTER(LEN=45) :: sname(48) ! name of the symmetries
INTEGER :: &
t_rev(48) = 0 ! time reversal flag, for noncolinear magnetism
@ -44,7 +51,6 @@ MODULE symm_base
LOGICAL :: &
time_reversal=.true., &! if .TRUE. the system has time_reversal symmetry
invsym, &! if .TRUE. the system has inversion symmetry
is_symmorphic, &! if .TRUE. the space group is symmorphic
no_t_rev=.FALSE. ! if .TRUE. remove the symmetries that
! require time reversal
REAL(DP),TARGET :: &
@ -55,12 +61,7 @@ MODULE symm_base
! ... Exported routines
!
PUBLIC :: find_sym, inverse_s, copy_sym, checkallsym, &
s_axis_to_cart, set_sym, set_sym_bl, symmorphic
!
! ... Note about fractional translations: ftau should be replaced by ft,
! ... that do not depend upon either upon the FFT grid or the lattice
! ... parameter (important for variable-cell calculations).
! ... The ftau are used only for symmetrization in the phonon code
s_axis_to_cart, set_sym, set_sym_bl
!
CONTAINS
!
@ -336,7 +337,7 @@ SUBROUTINE find_sym ( nat, tau, ityp, nr1, nr2, nr3, nofrac, &
!
nsym = copy_sym ( nrot, sym )
!
IF ( .not. is_group(nr1,nr2,nr3) ) THEN
IF ( .not. is_group ( ) ) THEN
CALL infomsg ('find_sym', 'Not a group! symmetry disabled')
nsym = 1
END IF
@ -349,7 +350,7 @@ SUBROUTINE find_sym ( nat, tau, ityp, nr1, nr2, nr3, nofrac, &
!
CALL s_axis_to_cart ( )
!
is_symmorphic=symmorphic(nsym, ftau)
! is_symmorphic = ALL ( ft(:,1:nsym) == 0.0_dp )
!
return
!
@ -437,6 +438,7 @@ subroutine sgam_at ( nat, tau, ityp, nr1, nr2, nr3, nofrac, sym )
end if
enddo
!
nsym_ns = 0
do irot = 1, nrot
!
! check that the grid is compatible with the S rotation
@ -452,8 +454,8 @@ subroutine sgam_at ( nat, tau, ityp, nr1, nr2, nr3, nofrac, sym )
& " not compatible with FFT grid. ")') irot
WRITE( stdout, '(3i4)') ( (s (i, j, irot) , j = 1, 3) , i = 1, 3)
goto 100
endif
do na = 1, nat
! rau = rotated atom coordinates
rau (:, na) = s (1,:, irot) * xau (1, na) + &
@ -481,29 +483,10 @@ subroutine sgam_at ( nat, tau, ityp, nr1, nr2, nr3, nofrac, sym )
sym(irot) = checksym ( irot, nat, ityp, xau, rau, ft_ )
!
if (sym (irot) ) then
nsym_ns = nsym_ns + 1
ft (:,irot) = ft_(:)
! convert ft to FFT coordinates
! for later use in symmetrization
ft1 = ft_(1) * nr1
ft2 = ft_(2) * nr2
ft3 = ft_(3) * nr3
! check if the fractional translations are commensurate
! with the FFT grid, discard sym.op. if not
! (needed because ph.x symmetrizes in real space)
if (abs (ft1 - nint (ft1) ) / nr1 > eps2 .or. &
abs (ft2 - nint (ft2) ) / nr2 > eps2 .or. &
abs (ft3 - nint (ft3) ) / nr3 > eps2 ) then
WRITE( stdout, '(5x,"warning: symmetry operation", &
& " # ",i2," not allowed. fractional ", &
& "translation:"/5x,3f11.7," in crystal", &
& " coordinates")') irot, ft_
sym (irot) = .false.
endif
ftau (1, irot) = nint (ft1)
ftau (2, irot) = nint (ft2)
ftau (3, irot) = nint (ft3)
goto 100
endif
go to 100
end if
endif
enddo
@ -511,6 +494,34 @@ subroutine sgam_at ( nat, tau, ityp, nr1, nr2, nr3, nofrac, sym )
100 continue
enddo
!
! convert ft to FFT coordinates - for real-space symmetrization
!
nsym_na = 0
do irot =1, nrot
if ( sym(irot) ) then
ft1 = ft(1,irot) * nr1
ft2 = ft(2,irot) * nr2
ft3 = ft(3,irot) * nr3
! check if the fractional translations are commensurate
! with the FFT grid, discard sym.op. if not
! (needed because ph.x symmetrizes in real space)
if (abs (ft1 - nint (ft1) ) / nr1 > eps2 .or. &
abs (ft2 - nint (ft2) ) / nr2 > eps2 .or. &
abs (ft3 - nint (ft3) ) / nr3 > eps2 ) then
! WRITE( stdout, '(5x,"warning: symmetry operation", &
! & " # ",i2," not allowed. fractional ", &
! & "translation:"/5x,3f11.7," in crystal", &
! & " coordinates")') irot, ft_
sym (irot) = .false.
nsym_na = nsym_na + 1
nsym_ns = nsym_ns - 1
endif
ftau (1, irot) = nint (ft1)
ftau (2, irot) = nint (ft2)
ftau (3, irot) = nint (ft3)
end if
end do
!
! deallocate work space
!
deallocate (rau)
@ -617,7 +628,7 @@ SUBROUTINE set_sym(nat, tau, ityp, nspin_mag, m_loc, nr1, nr2, nr3, &
!
! This routine receives as input atomic types and positions, if there
! is noncollinear magnetism and the initial magnetic moments, the fft
! dimesions nr1, nr2, nr3; it sets the symmetry elements of this module.
! dimensions nr1, nr2, nr3; it sets the symmetry elements of this module.
! Note that at and bg are those in cell_base. It sets nrot, nsym, s,
! sname, sr, invs, ftau, irt, t_rev, time_reversal, and invsym
!
@ -698,24 +709,24 @@ END FUNCTION copy_sym
!
!-----------------------------------------------------------------------
LOGICAL FUNCTION is_group ( nr1, nr2, nr3 )
LOGICAL FUNCTION is_group ( )
!-----------------------------------------------------------------------
!
! Checks that {S} is a group
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: nr1,nr2,nr3
!
INTEGER :: isym, jsym, ksym, ss (3, 3), stau(3)
INTEGER :: isym, jsym, ksym, ss (3, 3)
REAL (DP) :: st(3), dt(3)
LOGICAL :: found
!
DO isym = 1, nsym
DO jsym = 1, nsym
!
ss = MATMUL (s(:,:,isym),s(:,:,jsym))
stau(:)= ftau(:,jsym) + s(1,:,jsym)*ftau(1,isym) + &
s(2,:,jsym)*ftau(2,isym) + s(3,:,jsym)*ftau(3,isym)
st(:)= ft(:,jsym) + s(1,:,jsym)*ft(1,isym) + &
s(2,:,jsym)*ft(2,isym) + &
s(3,:,jsym)*ft(3,isym)
!
! here we check that the input matrices really form a group:
! S(k) = S(i)*S(j)
@ -723,10 +734,11 @@ LOGICAL FUNCTION is_group ( nr1, nr2, nr3 )
!
found = .false.
DO ksym = 1, nsym
dt(:) = ft(:,ksym) - st(:) - NINT( ft(:,ksym) - st(:) )
IF ( ALL( s(:,:,ksym) == ss(:,:) ) .AND. &
( MOD( ftau(1,ksym)-stau(1), nr1 ) == 0 ) .AND. &
( MOD( ftau(2,ksym)-stau(2), nr2 ) == 0 ) .AND. &
( MOD( ftau(3,ksym)-stau(3), nr3 ) == 0 ) ) THEN
( ABS ( dt(1) ) < eps2 ) .AND. &
( ABS ( dt(2) ) < eps2 ) .AND. &
( ABS ( dt(3) ) < eps2 ) ) THEN
IF (found) THEN
is_group = .false.
RETURN
@ -810,7 +822,7 @@ subroutine checkallsym ( nat, tau, ityp, nr1, nr2, nr3 )
!
integer :: na, kpol, isym, i, j, k, l
logical :: loksym (48)
real(DP) :: sx (3, 3), sy(3,3), ft_(3)
real(DP) :: sx (3, 3), sy(3,3)
real(DP) , allocatable :: xau(:,:), rau(:,:)
!
allocate (xau( 3 , nat))
@ -853,11 +865,7 @@ subroutine checkallsym ( nat, tau, ityp, nr1, nr2, nr3 )
enddo
enddo
!
ft_(1) = ftau (1, isym) / DBLE (nr1)
ft_(2) = ftau (2, isym) / DBLE (nr2)
ft_(3) = ftau (3, isym) / DBLE (nr3)
!
loksym(isym) = checksym ( isym, nat, ityp, xau, rau, ft_ )
loksym(isym) = checksym ( isym, nat, ityp, xau, rau, ft(1,isym) )
!
enddo
!
@ -871,8 +879,8 @@ subroutine checkallsym ( nat, tau, ityp, nr1, nr2, nr3 )
'the following symmetry operation is not satisfied ', -isym)
end do
if (ANY (.not.loksym (1:nsym) ) ) then
!call symmetrize_at(nsym, s, nat, tau, ityp, at, bg, nr1, nr2, &
! nr3, irt, ftau, alat, omega)
!call symmetrize_at (nsym, s, invs, ft, irt, nat, tau, at, bg, &
! alat, omega)
call errore ('checkallsym', &
'some of the original symmetry operations not satisfied ',1)
end if
@ -901,27 +909,4 @@ subroutine s_axis_to_cart ( )
!
end subroutine s_axis_to_cart
LOGICAL FUNCTION symmorphic(nrot, ftau)
!
! This function receives the fractionary translations and check if
! one of them is non zero. In this case the space group is non symmorphic and
! the function returns .false.
!
IMPLICIT NONE
INTEGER, INTENT(IN) :: ftau(3,nrot)
INTEGER, INTENT(IN) :: nrot
INTEGER :: isym
symmorphic=.TRUE.
DO isym=1,nrot
symmorphic=( symmorphic.AND.(ftau(1,isym)==0).AND. &
(ftau(2,isym)==0).AND. &
(ftau(3,isym)==0) )
END DO
RETURN
END FUNCTION symmorphic
END MODULE symm_base

View File

@ -7,77 +7,47 @@
!
!
!-----------------------------------------------------------------------
subroutine symmetrize_at(nsym, s, nat, tau, ityp, at, bg, &
nr1, nr2, nr3, irt, ftau, alat, omega)
subroutine symmetrize_at(nsym, s, invs, ft, irt, nat, tau, at, bg, alat, omega)
!-----------------------------------------------------------------------
!
! given a point group, this routine finds the subgroup which is
! the point group of the crystal under consideration
! non symmorphic groups non allowed, provided that fractional
! translations are commensurate with the FFT grid
!
! It sets the array sym, which for each operation of the original
! point group is true if this operation is also an operation of the
! total point group
! force atomic coordinates to have the symmetry of a given point group
! do the same for
!
USE io_global, ONLY : stdout
USE cellmd, ONLY: at_old, lmovecell
USE symm_base, ONLY: invs
USE kinds
implicit none
!
! input variables
!
integer :: nsym, s (3, 3, 48), nat, ityp (nat), nr1, nr2, nr3
real(DP) :: tau (3, nat), at (3, 3), bg (3, 3), alat, omega
! nsym : number of symmetry operation of the crystal
! s : symmetry operations of parent group
! nat : number of atoms in the unit cell
! ityp : species of each atom in the unit cell
! nr* : dimensions of the FFT mesh
! tau : cartesian coordinates of the atoms
! at : basis of the real-space lattice
! bg : " " " reciprocal-space lattice
!
! output variables
!
integer :: irt (48, nat), ftau (3, 48)
! irt(isym,na) : sym.op. isym sends atom na into atom irt(isym,na)
! ftau(:,isym) : fractional translation associated to sym.op. isym
! (in FFT coordinates: crystal axis, multiplied by nr*)
! sym(isym) : flag indicating if sym.op. isym in the parent group
! is a true symmetry operation of the crystal
integer, intent(in) :: nsym, s(3,3,48), invs(48), nat, irt (48, nat)
real(DP), intent(in) :: ft (3, 48)
real(DP), intent(inout) :: tau (3, nat), at (3, 3), bg (3, 3), alat, omega
!
! local variables
!
integer :: na, icar, ipol, jpol, kpol, lpol, irot
! counters
real(DP) , allocatable :: xau (:,:)
! atomic coordinates in crystal axis
real(DP) :: work, obnr(3), bg_old(3,3), sat(3,3), wrk(3,3), ba(3,3)
real(DP) :: work, bg_old(3,3), sat(3,3), wrk(3,3), ba(3,3)
!
allocate(xau(3,nat))
!
! Compute the coordinates of each atom in the basis of
! the direct lattice vectors
!
xau = tau
tau = 0.d0
call cryst_to_cart( nat, xau, bg, -1 )
!
obnr(1) = 1.d0/DBLE(nr1)
obnr(2) = 1.d0/DBLE(nr2)
obnr(3) = 1.d0/DBLE(nr3)
do irot = 1, nsym
do na = 1, nat
do kpol = 1, 3
work = s (1, kpol, irot) * xau (1, na) + &
s (2, kpol, irot) * xau (2, na) + &
s (3, kpol, irot) * xau (3, na) - &
ftau(kpol,irot)* obnr(kpol)
ft(kpol,irot)
tau (kpol, irt(irot,na)) = tau (kpol, irt(irot,na)) + work &
- nint(work-xau(kpol,irt(irot,na)))
enddo