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

Phonon-specific stuff moved away from PW into PH, calculation='phonon' 

(temporarily) disabled


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@5117 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2008-08-10 09:35:18 +00:00
parent bee3152f5a
commit fe30f83548
11 changed files with 252 additions and 207 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
PH/Makefile
View File

@ -102,6 +102,7 @@ random_matrix.o \
rotate_and_add_dyn.o \
save_ph_input.o \
set_asr_c.o \
set_defaults_pw.o \
set_drhoc.o \
set_int12_nc.o \
set_irr.o \
@ -110,6 +111,7 @@ set_irr_nosym.o \
setlocq.o \
setqmod.o \
setup_dgc.o \
sgam_ph.o \
smallgq.o \
solve_e.o \
solve_e_fpol.o \

18
PH/make.depend
View File

@ -16,6 +16,7 @@ add_for_charges.o : phcom.o
add_zstar_ue.o : ../Modules/io_files.o
add_zstar_ue.o : ../Modules/kind.o
add_zstar_ue.o : ../Modules/wavefunctions.o
add_zstar_ue.o : ../PW/noncol.o
add_zstar_ue.o : ../PW/pwcom.o
add_zstar_ue.o : phcom.o
add_zstar_ue_us.o : ../Modules/io_files.o
@ -243,6 +244,7 @@ dhdrhopsi.o : ../PW/becmod.o
dhdrhopsi.o : ../PW/pwcom.o
dhdrhopsi.o : phcom.o
dhdrhopsi.o : ramanm.o
dielec.o : ../Modules/constants.o
dielec.o : ../Modules/io_files.o
dielec.o : ../Modules/io_global.o
dielec.o : ../Modules/kind.o
@ -711,6 +713,18 @@ save_ph_input.o : ../Modules/ions_base.o
save_ph_input.o : ../Modules/kind.o
save_ph_input.o : phcom.o
set_asr_c.o : ../Modules/kind.o
set_defaults_pw.o : ../Modules/bfgs_module.o
set_defaults_pw.o : ../Modules/cell_base.o
set_defaults_pw.o : ../Modules/constants.o
set_defaults_pw.o : ../Modules/control_flags.o
set_defaults_pw.o : ../Modules/io_global.o
set_defaults_pw.o : ../Modules/ions_base.o
set_defaults_pw.o : ../Modules/kind.o
set_defaults_pw.o : ../Modules/mp_global.o
set_defaults_pw.o : ../Modules/parameters.o
set_defaults_pw.o : ../PW/a2fmod.o
set_defaults_pw.o : ../PW/noncol.o
set_defaults_pw.o : ../PW/pwcom.o
set_drhoc.o : ../Modules/atom.o
set_drhoc.o : ../Modules/cell_base.o
set_drhoc.o : ../Modules/constants.o
@ -744,6 +758,7 @@ setup_dgc.o : ../PW/noncol.o
setup_dgc.o : ../PW/pwcom.o
setup_dgc.o : ../PW/scf_mod.o
setup_dgc.o : phcom.o
sgam_ph.o : ../Modules/kind.o
smallgq.o : ../Modules/kind.o
solve_e.o : ../Modules/check_stop.o
solve_e.o : ../Modules/io_files.o
@ -1013,6 +1028,7 @@ rigid.o : ../include/f_defs.h
rotate_and_add_dyn.o : ../include/f_defs.h
save_ph_input.o : ../include/f_defs.h
set_asr_c.o : ../include/f_defs.h
set_defaults_pw.o : ../include/f_defs.h
set_drhoc.o : ../include/f_defs.h
set_dvscf.o : ../include/f_defs.h
set_irr.o : ../include/f_defs.h
@ -1020,6 +1036,7 @@ set_irr_mode.o : ../include/f_defs.h
set_irr_nosym.o : ../include/f_defs.h
setlocq.o : ../include/f_defs.h
setup_dgc.o : ../include/f_defs.h
sgam_ph.o : ../include/f_defs.h
smallgq.o : ../include/f_defs.h
solve_e.o : ../include/f_defs.h
solve_e2.o : ../include/f_defs.h
@ -1047,6 +1064,5 @@ transform_int_nc.o : ../include/f_defs.h
transform_int_so.o : ../include/f_defs.h
trntnsc.o : ../include/f_defs.h
trntnsr_3.o : ../include/f_defs.h
xk_wk_collect.o : ../include/f_defs.h
zstar_eu.o : ../include/f_defs.h
zstar_eu_us.o : ../include/f_defs.h

7
PH/matdyn.f90
View File

@ -1601,9 +1601,10 @@ SUBROUTINE gen_qpoints (ibrav, at, bg, nat, tau, ityp, nk1, nk2, nk3, &
CALL kpoint_grid ( nrot, time_reversal, s, t_rev, bg, nqx, &
0,0,0, nk1,nk2,nk3, nq, q, wk)
!
CALL sgama (nrot, nat, s, sname, t_rev, at, bg, tau, ityp, nsym, &
6, 6, 6, irt, ftau, invsym, minus_q, xqq, &
0, time_reversal, .NOT.time_reversal, mdum)
CALL sgama2 (nrot, nat, s, sname, t_rev, at, bg, tau, ityp, &
nsym, 6, 6, 6, irt, ftau, invsym, &
.NOT.time_reversal, mdum)
minus_q = time_reversal
!
CALL irreducible_BZ (nrot, s, nsym, at, bg, nqx, nq, q, wk, minus_q)
!

0
PW/set_defaults_pw.f90 → PH/set_defaults_pw.f90
View File

172
PH/sgam_ph.f90 Normal file
View File

@ -0,0 +1,172 @@
!
! Copyright (C) 2001-2008 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 .
!
!-----------------------------------------------------------------------
subroutine sgama (nrot, nat, s, sname, t_rev, at, bg, tau, ityp, nsym,&
nr1, nr2, nr3, irt, ftau, invsym, minus_q, xq, &
modenum, time_reversal, magnetic_sym, m_loc)
!-----------------------------------------------------------------------
!
! This routine performs the following tasks:
! 1) It finds the point group of the crystal, by eliminating the
! symmetries of the Bravais lattice which are not allowed
! by the atomic positions.
! 2) If xq.ne.0 it restricts the symmetries to those of the small
! group of q. In this case the small group of q is determined
! seeking all sym.op. such that Sq=q+G (and Sq=-q+G is also
! considered)
! 3) if modenum.ne.0 keep only symmetries which send mode
! "modenum" into itself
! 4) It checks if the point group has the inversion symmetry.
!
! This routine is mainly the driver of separate routines which
! perform each single task.
!
! Modified by SdG to include the "small group of q" stuff for the
! linear-response preparation run.
!
#include "f_defs.h"
USE kinds, only : DP
implicit none
!
integer, intent(in) :: nrot, nat, ityp (nat), nr1, nr2, nr3, modenum
real(DP), intent(in) :: at (3,3), bg (3,3), tau (3,nat), xq (3), m_loc(3,nat)
logical, intent(in) :: time_reversal, magnetic_sym
!
character(len=45), intent(inout) :: sname (48)
! name of the rotation part of each symmetry operation
integer, intent(inout) :: s(3,3,48)
!
integer, intent(out) :: nsym, irt (48, nat), ftau (3, 48)
logical, intent(out) :: invsym, minus_q
! minus_q : if true a symmetry sends q->-q+G
!
real(DP), allocatable :: rtau (:,:,:)
! direct translations of each point
integer :: t_rev(48)
! for magnetic symmetries: if 1 there is time reversal operation
logical :: sym (48)
! if true the corresponding operation is a symmetry operation
integer, external :: copy_sym
!
! Here we find the true symmetries of the crystal
!
CALL sgam_at (nrot, s, nat, tau, ityp, at, bg, nr1, nr2, nr3, &
sym, irt, ftau)
IF ( magnetic_sym ) &
CALL sgam_at_mag (nrot, s, nat, bg, irt, m_loc, sname, sym, t_rev)
!
! 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
! small group of q. Here we exclude from the list the symmetries
! that do not belong to it
!
call smallg_q (xq, modenum, at, bg, nrot, s, ftau, sym, minus_q)
!
IF ( .not. time_reversal ) minus_q = .false.
!
! If somebody wants to implement phonon calculations in non
! collinear magnetic case he/she has to pay attention to the
! fact that in non collinear case the symmetry k -> -k is not
! always allowed as in collinear case. Adriano
!
if (modenum /= 0) then
allocate(rtau (3, 48, nat))
call sgam_ph (at, bg, nrot, s, irt, tau, rtau, nat, sym)
call mode_group (modenum, xq, at, bg, nat, nrot, s, irt, rtau, &
sym, minus_q)
deallocate (rtau)
endif
!
! Here we re-order all rotations in such a way that true sym.ops
! are the first nsym; rotations that are not sym.ops. follow
!
nsym = copy_sym ( nrot, sym, s, sname, ftau, nat, irt, t_rev )
!
! check if inversion (I) is a symmetry.
! If so, it should be the (nsym/2+1)-th operation of the group
!
invsym = ALL ( s(:,:,nsym/2+1) == -s(:,:,1) )
!
return
!
end subroutine sgama
!
!-----------------------------------------------------------------------
subroutine sgam_ph (at, bg, nsym, s, irt, tau, rtau, nat, sym)
!-----------------------------------------------------------------------
!
! This routine computes the vector rtau which contains for each
! atom and each rotation the vector S\tau_a - \tau_b, where
! b is the rotated a atom, given by the array irt. These rtau are
! non zero only if fractional translations are present.
!
#include "f_defs.h"
USE kinds
implicit none
!
! first the dummy variables
!
integer, intent(in) :: nsym, s (3, 3, 48), nat, irt (48, nat)
! nsym: number of symmetries of the point group
! s: matrices of symmetry operations
! nat : number of atoms in the unit cell
! irt(n,m) = transformed of atom m for symmetry n
real(DP), intent(in) :: at (3, 3), bg (3, 3), tau (3, nat)
! at: direct lattice vectors
! bg: reciprocal lattice vectors
! tau: coordinates of the atoms
logical, intent(in) :: sym (nsym)
! sym(n)=.true. if operation n is a symmetry
real(DP), intent(out):: rtau (3, 48, nat)
! rtau: the direct translations
!
! here the local variables
!
integer :: na, nb, isym, ipol
! counters on: atoms, symmetry operations, polarization
real(DP) , allocatable :: xau (:,:)
real(DP) :: ft (3)
!
allocate (xau(3,nat))
!
! compute the atomic coordinates in crystal axis, xau
!
do na = 1, nat
do ipol = 1, 3
xau (ipol, na) = bg (1, ipol) * tau (1, na) + &
bg (2, ipol) * tau (2, na) + &
bg (3, ipol) * tau (3, na)
enddo
enddo
!
! for each symmetry operation, compute the atomic coordinates
! of the rotated atom, ft, and calculate rtau = Stau'-tau
!
do isym = 1, nsym
if (sym (isym) ) then
do na = 1, nat
nb = irt (isym, na)
do ipol = 1, 3
ft (ipol) = s (1, ipol, isym) * xau (1, na) + &
s (2, ipol, isym) * xau (2, na) + &
s (3, ipol, isym) * xau (3, na) - xau (ipol, nb)
enddo
do ipol = 1, 3
rtau (ipol, isym, na) = at (ipol, 1) * ft (1) + &
at (ipol, 2) * ft (2) + &
at (ipol, 3) * ft (3)
enddo
enddo
endif
enddo
!
! deallocate workspace
!
deallocate(xau)
return
end subroutine sgam_ph

2
PW/Makefile
View File

@ -176,7 +176,6 @@ save_in_ions.o \
scale_h.o \
scf_mod.o \
seqopn.o \
set_defaults_pw.o \
set_fft_dim.o \
set_hubbard_l.o \
set_kplusq.o \
@ -189,7 +188,6 @@ setup.o \
setupkpt.o \
sgam_at.o \
sgam_at_mag.o \
sgam_ph.o \
sgama.o \
smallg_q.o \
spinor.o \

1
PW/input.f90
View File

@ -698,6 +698,7 @@ SUBROUTINE iosys()
!
CASE( 'phonon' )
!
CALL errore ('iosys','calculation="phonon" temporarily disabled',1)
lforce = .FALSE.
lphonon = .TRUE.
!

8
PW/make.depend
View File

@ -1189,11 +1189,6 @@ scf_mod.o : paw_onecenter.o
scf_mod.o : pwcom.o
seqopn.o : ../Modules/io_files.o
seqopn.o : ../Modules/kind.o
set_defaults_pw.o : ../Modules/bfgs_module.o
set_defaults_pw.o : ../Modules/control_flags.o
set_defaults_pw.o : ../Modules/kind.o
set_defaults_pw.o : a2fmod.o
set_defaults_pw.o : pwcom.o
set_fft_dim.o : ../Modules/cell_base.o
set_fft_dim.o : ../Modules/fft_scalar.o
set_fft_dim.o : ../Modules/io_global.o
@ -1250,7 +1245,6 @@ setupkpt.o : ../Modules/kind.o
sgam_at.o : ../Modules/io_global.o
sgam_at.o : ../Modules/kind.o
sgam_at_mag.o : ../Modules/kind.o
sgam_ph.o : ../Modules/kind.o
sgama.o : ../Modules/kind.o
smallg_q.o : ../Modules/kind.o
sph_ind.o : ../Modules/kind.o
@ -1634,11 +1628,9 @@ rotate_wfc_gamma.o : ../include/f_defs.h
rotate_wfc_k.o : ../include/f_defs.h
s_psi.o : ../include/f_defs.h
scale_h.o : ../include/f_defs.h
set_defaults_pw.o : ../include/f_defs.h
set_rhoc.o : ../include/f_defs.h
setlocal.o : ../include/f_defs.h
setup.o : ../include/f_defs.h
sgam_ph.o : ../include/f_defs.h
sgama.o : ../include/f_defs.h
smallg_q.o : ../include/f_defs.h
stres_cc.o : ../include/f_defs.h

59
PW/setup.f90
View File

@ -44,7 +44,7 @@ SUBROUTINE setup()
USE basis, ONLY : startingpot, natomwfc
USE gvect, ONLY : gcutm, ecutwfc, dual, nr1, nr2, nr3
USE gsmooth, ONLY : doublegrid, gcutms
USE klist, ONLY : xk, wk, xqq, nks, nelec, degauss, lgauss, &
USE klist, ONLY : xk, wk, nks, nelec, degauss, lgauss, &
lxkcry, nkstot, &
nelup, neldw, two_fermi_energies, &
tot_charge, tot_magnetization, multiplicity
@ -57,8 +57,8 @@ SUBROUTINE setup()
USE symme, ONLY : s, t_rev, irt, ftau, nsym, invsym, d1,d2,d3, &
time_reversal
USE wvfct, ONLY : nbnd, nbndx
USE control_flags, ONLY : tr2, ethr, lscf, lmd, lpath, lphonon, david, &
isolve, niter, noinv, nosym, modenum, lbands, &
USE control_flags, ONLY : tr2, ethr, lscf, lmd, lpath, david, &
isolve, niter, noinv, nosym, lbands, &
use_para_diag, gamma_only
USE cellmd, ONLY : calc
USE uspp_param, ONLY : upf
@ -88,7 +88,7 @@ SUBROUTINE setup()
IMPLICIT NONE
!
INTEGER :: na, nt, input_nks, nrot, irot, isym, tipo, is, nb, ierr, ibnd, ik
LOGICAL :: minus_q, magnetic_sym, ltest
LOGICAL :: minus_q, magnetic_sym
REAL(DP) :: iocc, ionic_charge
!
INTEGER, EXTERNAL :: n_atom_wfc, set_Hubbard_l
@ -337,31 +337,13 @@ SUBROUTINE setup()
! ... iteration of for the first ionic step
! ... for subsequent steps ethr is automatically updated in electrons
!
ltest = ( ethr == 0.D0 )
!
IF ( lphonon ) THEN
IF ( .NOT. lscf ) THEN
!
! ... in the case of a phonon calculation ethr can not be specified
! ... in the input file
!
IF ( .NOT. ltest ) &
WRITE( UNIT = stdout, &
& FMT = '(5X,"diago_thr_init overwritten ", &
& "with conv_thr / nelec")' )
!
ethr = 0.1D0 * MIN( 1.D-2, tr2 / nelec )
!
ELSE IF ( .NOT. lscf ) THEN
!
IF ( ltest ) THEN
!
ethr = 0.1D0 * MIN( 1.D-2, tr2 / nelec )
!
END IF
IF ( ethr == 0.D0 ) ethr = 0.1D0 * MIN( 1.D-2, tr2 / nelec )
!
ELSE
!
IF ( ltest ) THEN
IF ( ethr == 0.D0 ) THEN
!
IF ( startingpot == 'file' ) THEN
!
@ -566,12 +548,12 @@ SUBROUTINE setup()
!
ELSE
!
! ... "sgama" eliminates rotations that are not symmetry operations
!
CALL sgama( nrot, nat, s, sname, t_rev, at, bg, tau, ityp, nsym, &
nr1, nr2, nr3, irt, ftau, invsym, minus_q, xqq, &
modenum, time_reversal, magnetic_sym, m_loc)
! ... eliminate rotations that are not symmetry operations
!
CALL sgama2 ( nrot, nat, s, sname, t_rev, at, bg, tau, ityp, &
nsym, nr1, nr2, nr3, irt, ftau, invsym, &
magnetic_sym, m_loc)
minus_q = time_reversal
CALL checkallsym( nsym, s, nat, tau, ityp, at, &
bg, nr1, nr2, nr3, irt, ftau, alat, omega )
!
@ -626,10 +608,6 @@ SUBROUTINE setup()
!
END IF
!
! ... phonon calculation: add k+q to the list of k
!
IF ( lphonon ) CALL set_kplusq( xk, wk, xqq, nkstot, npk )
!
#if defined (EXX)
IF ( dft_is_hybrid() ) CALL exx_grid_init()
#endif
@ -666,21 +644,10 @@ SUBROUTINE setup()
!
#ifdef __PARA
!
! ... set the granularity for k-point distribution
!
IF ( ( ABS( xqq(1) ) < eps8 .AND. ABS( xqq(2) ) < eps8 .AND. &
ABS( xqq(3) ) < eps8) .OR. ( .NOT. lphonon ) ) THEN
!
kunit = 1
!
ELSE
!
kunit = 2
!
ENDIF
!
! ... distribute k-points (and their weights and spin indices)
!
kunit = 1
CALL divide_et_impera( xk, wk, isk, lsda, nkstot, nks )
!
#else

83
PW/sgam_ph.f90
View File

@ -1,83 +0,0 @@
!
! Copyright (C) 2001-2008 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 .
!
!
!-----------------------------------------------------------------------
subroutine sgam_ph (at, bg, nsym, s, irt, tau, rtau, nat, sym)
!-----------------------------------------------------------------------
!
! This routine computes the vector rtau which contains for each
! atom and each rotation the vector S\tau_a - \tau_b, where
! b is the rotated a atom, given by the array irt. These rtau are
! non zero only if fractional translations are present.
!
#include "f_defs.h"
USE kinds
implicit none
!
! first the dummy variables
!
integer, intent(in) :: nsym, s (3, 3, 48), nat, irt (48, nat)
! nsym: number of symmetries of the point group
! s: matrices of symmetry operations
! nat : number of atoms in the unit cell
! irt(n,m) = transformed of atom m for symmetry n
real(DP), intent(in) :: at (3, 3), bg (3, 3), tau (3, nat)
! at: direct lattice vectors
! bg: reciprocal lattice vectors
! tau: coordinates of the atoms
logical, intent(in) :: sym (nsym)
! sym(n)=.true. if operation n is a symmetry
real(DP), intent(out):: rtau (3, 48, nat)
! rtau: the direct translations
!
! here the local variables
!
integer :: na, nb, isym, ipol
! counters on: atoms, symmetry operations, polarization
real(DP) , allocatable :: xau (:,:)
real(DP) :: ft (3)
!
allocate (xau(3,nat))
!
! compute the atomic coordinates in crystal axis, xau
!
do na = 1, nat
do ipol = 1, 3
xau (ipol, na) = bg (1, ipol) * tau (1, na) + &
bg (2, ipol) * tau (2, na) + &
bg (3, ipol) * tau (3, na)
enddo
enddo
!
! for each symmetry operation, compute the atomic coordinates
! of the rotated atom, ft, and calculate rtau = Stau'-tau
!
do isym = 1, nsym
if (sym (isym) ) then
do na = 1, nat
nb = irt (isym, na)
do ipol = 1, 3
ft (ipol) = s (1, ipol, isym) * xau (1, na) + &
s (2, ipol, isym) * xau (2, na) + &
s (3, ipol, isym) * xau (3, na) - xau (ipol, nb)
enddo
do ipol = 1, 3
rtau (ipol, isym, na) = at (ipol, 1) * ft (1) + &
at (ipol, 2) * ft (2) + &
at (ipol, 3) * ft (3)
enddo
enddo
endif
enddo
!
! deallocate workspace
!
deallocate(xau)
return
end subroutine sgam_ph

107
PW/sgama.f90
View File

@ -1,87 +1,76 @@
!!
! Copyright (C) 2001-2008 Quantum-Espresso group
!
! Copyright (C) 2008 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 .
!
!-----------------------------------------------------------------------
subroutine sgama (nrot, nat, s, sname, t_rev, at, bg, tau, ityp, nsym,&
nr1, nr2, nr3, irt, ftau, invsym, minus_q, xq, &
modenum, time_reversal, magnetic_sym, m_loc)
SUBROUTINE sgama2 ( nrot, nat, s, sname, t_rev, at, bg, tau, ityp, &
nsym, nr1, nr2, nr3, irt, ftau, invsym, &
magnetic_sym, m_loc )
!-----------------------------------------------------------------------
!
! This routine performs the following tasks:
! 1) It finds the point group of the crystal, by eliminating the
! symmetries of the Bravais lattice which are not allowed
! by the atomic positions.
! 2) If xq.ne.0 it restricts the symmetries to those of the small
! group of q. In this case the small group of q is determined
! seeking all sym.op. such that Sq=q+G (and Sq=-q+G is also
! considered)
! 3) if modenum.ne.0 keep only symmetries which send mode
! "modenum" into itself
! 4) It checks if the point group has the inversion symmetry.
! This routine finds the point group of the crystal, by eliminating
! the symmetries of the Bravais lattice which are not allowed
! by the atomic positions (or by the magnetization if present)
!
! This routine is mainly the driver of separate routines which
! perform each single task.
!
! Modified by SdG to include the "small group of q" stuff for the
! linear-response preparation run.
!
#include "f_defs.h"
USE kinds, only : DP
implicit none
!
integer, intent(in) :: nrot, nat, ityp (nat), nr1, nr2, nr3, modenum
real(DP), intent(in) :: at (3,3), bg (3,3), tau (3,nat), xq (3), m_loc(3,nat)
logical, intent(in) :: time_reversal, magnetic_sym
integer, intent(in) :: nrot, nat, ityp (nat), nr1, nr2, nr3
real(DP), intent(in) :: at (3,3), bg (3,3), tau (3,nat), m_loc(3,nat)
logical, intent(in) :: magnetic_sym
!
character(len=45), intent(inout) :: sname (48)
! name of the rotation part of each symmetry operation
integer, intent(inout) :: s(3,3,48)
!
integer, intent(out) :: nsym, irt (48, nat), ftau (3, 48)
logical, intent(out) :: invsym, minus_q
! minus_q : if true a symmetry sends q->-q+G
logical, intent(out) :: invsym
!
real(DP), allocatable :: rtau (:,:,:)
! direct translations of each point
integer :: stemp(3,3), irot, jrot, ipol, jpol, na
! counters
integer :: t_rev(48)
! for magnetic symmetries: if 1 there is time reversal operation
logical :: sym (48)
! if true the corresponding operation is a symmetry operation
integer, external :: copy_sym
!
! Here we find the true symmetries of the crystal
!
CALL sgam_at (nrot, s, nat, tau, ityp, at, bg, nr1, nr2, nr3, &
sym, irt, ftau)
!
! Here we check for magnetic symmetries
!
IF ( magnetic_sym ) &
CALL sgam_at_mag (nrot, s, nat, bg, irt, m_loc, sname, sym, t_rev)
!
! 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
! small group of q. Here we exclude from the list the symmetries
! that do not belong to it
! Here we re-order all rotations in such a way that true sym.ops
! are the first nsym; rotations that are not sym.ops. follow
!
call smallg_q (xq, modenum, at, bg, nrot, s, ftau, sym, minus_q)
nsym = copy_sym ( nrot, sym, s, sname, ftau, nat, irt, t_rev )
!
IF ( .not. time_reversal ) minus_q = .false.
! check if inversion (I) is a symmetry.
! If so, it should be the (nsym/2+1)-th operation of the group
!
! If somebody wants to implement phonon calculations in non
! collinear magnetic case he/she has to pay attention to the
! fact that in non collinear case the symmetry k -> -k is not
! always allowed as in collinear case. Adriano
invsym = ALL ( s(:,:,nsym/2+1) == -s(:,:,1) )
!
if (modenum /= 0) then
allocate(rtau (3, 48, nat))
call sgam_ph (at, bg, nrot, s, irt, tau, rtau, nat, sym)
call mode_group (modenum, xq, at, bg, nat, nrot, s, irt, rtau, &
sym, minus_q)
deallocate (rtau)
endif
return
!
END SUBROUTINE sgama2
!
!-----------------------------------------------------------------------
INTEGER FUNCTION copy_sym ( nrot, sym, s, sname, ftau, nat, irt, t_rev )
!-----------------------------------------------------------------------
!
implicit none
integer, intent(in) :: nrot, nat
integer, intent(inout) :: s (3,3,48), irt (48, nat), ftau (3, 48), &
t_rev(48)
character(len=45), intent(inout) :: sname (48)
logical, intent(inout) :: sym(48)
!
integer :: stemp(3,3), irot, jrot
!
! copy symm. operations in sequential order so that
! s(i,j,irot) , irot <= nsym are the sym.ops. of the crystal
@ -99,26 +88,18 @@ subroutine sgama (nrot, nat, s, sname, t_rev, at, bg, tau, ityp, nsym,&
t_rev (jrot) = t_rev(irot)
endif
enddo
nsym = jrot
sym (1:nsym) = .true.
sym (nsym+1:nrot) = .false.
sym (1:jrot) = .true.
sym (jrot+1:nrot) = .false.
!
! Sets to zero the first matrix that is not a symmetry of the crystal.
! This will be used by d3toten program.
! This will be used by d3toten program (obsolete?)
!
if (nrot < 48) s(:,:, nrot+1) = 0
!
! check if inversion (I) is a symmetry.
! If so, it should be the (nsym/2+1)-th operation of the group
!
irot = nsym/2+1
invsym = ALL ( s(:,:,irot) == -s(:,:,1) )
!
copy_sym = jrot
return
!
end subroutine sgama
!-----------------------------------------------------------------------
END FUNCTION copy_sym
!
!-----------------------------------------------------------------------
subroutine irreducible_BZ (nrot, s, nsym, at, bg, npk, nks, xk, wk, minus_q)
@ -166,5 +147,3 @@ subroutine irreducible_BZ (nrot, s, nsym, at, bg, npk, nks, xk, wk, minus_q)
return
!
end subroutine irreducible_BZ
!-----------------------------------------------------------------------