mirror of https://gitlab.com/QEF/q-e.git
88 lines
2.8 KiB
Fortran
88 lines
2.8 KiB
Fortran
!
|
|
! Copyright (C) 2006 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,
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
!
|
|
#include "f_defs.h"
|
|
!-----------------------------------------------------------------------
|
|
SUBROUTINE smallgk (xk, at, bg, s, ftau, t_rev, sname, nsym, sk, ftauk, gk, &
|
|
t_revk, snamek, nsymk)
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! This routine selects, among the symmetry matrices of the point group
|
|
! of a crystal, the symmetry operations which leave k unchanged.
|
|
!
|
|
!
|
|
USE kinds, ONLY : DP
|
|
IMPLICIT NONE
|
|
CHARACTER(LEN=45) :: snamek(48), sname(48)
|
|
|
|
REAL(DP) :: bg (3, 3), at (3, 3), xk (3)
|
|
! input: the reciprocal lattice vectors
|
|
! input: the direct lattice vectors
|
|
! input: the k point of the crystal
|
|
|
|
INTEGER :: s (3, 3, 48), ftau(3,48), t_rev(48), nsym, sk (3, 3, 48), &
|
|
ftauk(3,48), t_revk(48), gk(3,48), nsymk
|
|
! input: the symmetry matrices
|
|
! input: fractional translation associated to each rotation
|
|
! input: possible time reversal associated to the rotation
|
|
! input: dimension of the point group
|
|
! output: the symmetry matrices of the small group of k
|
|
! output: the fract. trans. associated to the operations of the small group of k
|
|
! output: the time reversal associated to the operations of the small group of k
|
|
! output: the G vector which connects k and the rotated k.
|
|
|
|
REAL(DP) :: ak (3), rak (3), zero (3)
|
|
! k vector in crystal basis
|
|
! the rotated of the k vector
|
|
! the zero vector
|
|
|
|
INTEGER :: isym, ipol, jpol
|
|
! counter on symmetry operations
|
|
! counter on polarizations
|
|
! counter on polarizations
|
|
|
|
LOGICAL :: eqvect
|
|
! logical function, check if two vectors are equal
|
|
!
|
|
! Set to zero some variables and transform xq to the crystal basis
|
|
!
|
|
zero = 0.d0
|
|
ak = xk
|
|
CALL cryst_to_cart (1, ak, at, - 1)
|
|
!
|
|
! test all symmetries to see if the operation S sends k in k+G ...
|
|
!
|
|
nsymk = 0
|
|
DO isym = 1, nsym
|
|
rak = 0.d0
|
|
DO ipol = 1, 3
|
|
DO jpol = 1, 3
|
|
rak (ipol) = rak (ipol) + DBLE (s (ipol, jpol, isym) ) * &
|
|
ak (jpol)
|
|
ENDDO
|
|
ENDDO
|
|
IF ((t_rev(isym)==0 .AND. eqvect(rak, ak, zero)) .OR. &
|
|
(t_rev(isym)==1 .AND. eqvect(rak, -ak, zero)) ) THEN
|
|
nsymk=nsymk+1
|
|
sk(:,:,nsymk)=s(:,:,isym)
|
|
ftauk(:,nsymk)=ftau(:,isym)
|
|
snamek(nsymk)=sname(isym)
|
|
t_revk(nsymk)=t_rev(isym)
|
|
IF (t_rev(isym)==0) THEN
|
|
gk(:,nsymk)=NINT(rak(:)-ak(:))
|
|
ELSEIF (t_rev(isym)==1) THEN
|
|
gk(:,nsymk)=NINT(rak(:)+ak(:))
|
|
ELSE
|
|
CALL errore('smallgk','wrong t_rev',1)
|
|
ENDIF
|
|
END IF
|
|
ENDDO
|
|
!
|
|
RETURN
|
|
END SUBROUTINE smallgk
|
|
|