mirror of https://gitlab.com/QEF/q-e.git
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:
parent
5aca42ec3f
commit
2c1c3c2bfd
|
@ -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. &
|
||||
|
|
|
@ -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. &
|
||||
|
|
|
@ -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, &
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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. (including inversion) found")' )&
|
||||
nsym
|
||||
END IF
|
||||
ELSE
|
||||
WRITE( stdout, '(/5x,i2," Sym.Ops. (no inversion)",/)') nsym
|
||||
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
|
||||
|
|
141
PW/symm_base.f90
141
PW/symm_base.f90
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue