...
 
Commits (23)
<<<<<<< HEAD
=======
Problems fixed in development branch :
* option "write_unkg" of pw2wannier90.f90 wasn't working as expected
Incompatible changes in development branch :
* fractional translations "ftau" in FFT grid units no longer existing as
global variables: replaced by "ft", in crystal axis, computed locally
where needed (in real-space symmetrization only)
New in 6.4.1 branch :
* A warning is issued if the lattice parameter seems to be a conversion
factor instead of a true lattice parameter. Conversion should be achieved
......@@ -18,7 +24,6 @@ Problems fixed in 6.4.1 branch :
issue #102)
* XML file correctly written if tetrahedra are used (see gitlab issue #103)
>>>>>>> 0efe83d29ae4c5f0bd004403548617d997955670
New in version 6.4:
* Experimental version of SCDM localization with k-points, activated like for
k=0 by specifying in &system namelist a value > 0 for "localization_thr".
......@@ -38,11 +43,8 @@ New in version 6.4:
* XDM now works also for USPP and norm-conserving PP
Problems fixed in version 6.4 (+ = in qe-6.3-backports as well) :
<<<<<<< HEAD
=======
+ Codes reading scf data recomputed celldm parameters also if ibrav=0
This produced confusing output and had the potential to break some codes
>>>>>>> 0efe83d29ae4c5f0bd004403548617d997955670
+ index not correctly initialized in LSDA phonon with core corrections
+ GTH pseudopotentials in analytical form wrongly computed in some cases
+ projwfc.x not working with new xml format in noncolinear/spinorbit case
......
......@@ -1118,7 +1118,7 @@ add preprocessing option \texttt{-Dzdotc=zdotc\_wrapper} to \texttt{DFLAGS}.
IMPORTANT NOTE: ifort versions earlier than v.15 miscompile the new
XML code in QE v.6.4 and later. Please install this patch:\\
\texttt{https://gitlab.com/QEF/q-e/wikis/Patch-for-old-Intel-compilers}.
\texttt{https://gitlab.com/QEF/q-e/wikis/Support/Patch-for-old-Intel-compilers}.
The Intel compiler ifort \texttt{http://software.intel.com/}
produces fast executables, at least on Intel CPUs, but not all versions
......
......@@ -37,7 +37,7 @@
USE io_epw, ONLY : iuepb, iuqpeig
USE pwcom, ONLY : et, xk, nks, nbnd, nkstot
USE cell_base, ONLY : at, bg
USE symm_base, ONLY : irt, s, nsym, ftau, sname, invs, s_axis_to_cart, &
USE symm_base, ONLY : irt, s, nsym, ft, sname, invs, s_axis_to_cart, &
sr, nrot, copy_sym, set_sym_bl, find_sym, &
inverse_s, remove_sym, allfrac
USE start_k, ONLY : nk1, nk2, nk3
......@@ -398,7 +398,7 @@
minus_q = .true.
sym = .false.
sym(1:nsym) = .true.
CALL smallg_q(xq, 0, at, bg, nsym, s, ftau, sym, minus_q) ! s is intent(in)
CALL smallg_q(xq, 0, at, bg, nsym, s, sym, minus_q) ! s is intent(in)
!
! SP: Notice that the function copy_sym reshuffles the s matrix for each irr_q.
! This is why we then need to call gmap_sym for each irr_q [see below].
......@@ -429,7 +429,7 @@
! reshuffles the s matrix for each irr_q [putting the sym of the small group of q first].
!
! [I checked that gmapsym(gmapsym(ig,isym),invs(isym)) = ig]
CALL gmap_sym(nsym, s, ftau, gmapsym, eigv, invs)
CALL gmap_sym(nsym, s, ft, gmapsym, eigv, invs)
!
! Re-set the variables needed for the pattern representation
! and the symmetries of the small group of irr-q
......@@ -485,20 +485,17 @@
CALL s_axis_to_cart() ! give sr(:,:, isym)
DO isym = 1, nsym
WRITE( stdout, '(/6x,"isym = ",i2,5x,a45/)') isym, sname(isym)
IF (ftau(1,isym).ne.0 .OR. ftau(2,isym).ne.0 .OR. ftau(3,isym).ne.0) THEN
ft1 = at(1,1)*ftau(1,isym)/dfftp%nr1 + at(1,2)*ftau(2,isym)/dfftp%nr2 + &
at(1,3)*ftau(3,isym)/dfftp%nr3
ft2 = at(2,1)*ftau(1,isym)/dfftp%nr1 + at(2,2)*ftau(2,isym)/dfftp%nr2 + &
at(2,3)*ftau(3,isym)/dfftp%nr3
ft3 = at(3,1)*ftau(1,isym)/dfftp%nr1 + at(3,2)*ftau(2,isym)/dfftp%nr2 + &
at(3,3)*ftau(3,isym)/dfftp%nr3
IF ( ft(1,isym)**2 + ft(2,isym)**2 + ft(3,isym)**2 > 1.0d-8 ) THEN
ft1 = at(1,1)*ft(1,isym) + at(1,2)*ft(2,isym) + at(1,3)*ft(3,isym)
ft2 = at(2,1)*ft(1,isym) + at(2,2)*ft(2,isym) + at(2,3)*ft(3,isym)
ft3 = at(3,1)*ft(1,isym) + at(3,2)*ft(2,isym) + at(3,3)*ft(3,isym)
WRITE(stdout, '(1x,"cryst.",3x,"s(",i2,") = (",3(i6,5x), &
& " ) f =( ",f10.7," )")') &
isym, (s(1,ipol,isym),ipol=1,3), dble(ftau(1,isym))/dble(dfftp%nr1)
isym, (s(1,ipol,isym),ipol=1,3), ft(1,isym)
WRITE(stdout, '(17x," (",3(i6,5x), " ) ( ",f10.7," )")') &
(s(2,ipol,isym),ipol=1,3), dble(ftau(2,isym))/dble(dfftp%nr2)
(s(2,ipol,isym),ipol=1,3), ft(2,isym)
WRITE(stdout, '(17x," (",3(i6,5x), " ) ( ",f10.7," )"/)') &
(s(3,ipol,isym),ipol=1,3), dble(ftau(3,isym))/dble(dfftp%nr3)
(s(3,ipol,isym),ipol=1,3), ft(3,isym)
WRITE(stdout, '(1x,"cart. ",3x,"s(",i2,") = (",3f11.7, &
& " ) f =( ",f10.7," )")') &
isym, (sr(1,ipol,isym),ipol=1,3), ft1
......@@ -563,7 +560,7 @@
!
! check whether the symmetry belongs to a symmorphic group
!
symmo = (ftau(1,isym).eq.0 .AND. ftau(2,isym).eq.0 .AND. ftau(3,isym).eq.0)
symmo = ( ft(1,isym)**2 + ft(2,isym)**2 + ft(3,isym)**2 > 1.0d-8 )
!
WRITE(stdout,'(3i5,L3,L3)') iq, i, isym, nog, symmo
!
......
......@@ -26,7 +26,7 @@
USE gvect, ONLY : gcutm, ngm
USE gvecs, ONLY : dual, doublegrid, gcutms, ngms
USE gvecw, ONLY : ecutwfc
USE symm_base, ONLY : s, sname, ftau, s_axis_to_cart, sr, t_rev
USE symm_base, ONLY : s, sname, ft, s_axis_to_cart, sr, t_rev
USE noncollin_module, ONLY : noncolin
USE spin_orb, ONLY : lspinorb, domag
USE funct, ONLY : write_dft_name
......@@ -151,25 +151,19 @@
IF (noncolin.and.domag) &
WRITE(stdout,'(1x, "Time Reversal",i3)') t_rev(isym)
!
IF (ftau(1,isym).ne.0 .OR. ftau(2,isym).ne.0 .OR. ftau(3,isym).ne.0) THEN
ft1 = at(1,1) * ftau(1,isym) / dfftp%nr1 &
+ at(1,2) * ftau(2,isym) / dfftp%nr2 &
+ at(1,3) * ftau(3,isym) / dfftp%nr3
ft2 = at(2,1) * ftau(1,isym) / dfftp%nr1 &
+ at(2,2) * ftau(2,isym) / dfftp%nr2 &
+ at(2,3) * ftau(3,isym) / dfftp%nr3
ft3 = at(3,1) * ftau(1,isym) / dfftp%nr1 &
+ at(3,2) * ftau(2,isym) / dfftp%nr2 &
+ at(3,3) * ftau(3,isym) / dfftp%nr3
IF ( ft(1,isym)**2 + ft(2,isym)**2 + ft(3,isym)**2 > 1.0d-8 ) THEN
ft1 = at(1,1)*ft(1,isym) + at(1,2)*ft(2,isym) + at(1,3)*ft(3,isym)
ft2 = at(2,1)*ft(1,isym) + at(2,2)*ft(2,isym) + at(2,3)*ft(3,isym)
ft3 = at(3,1)*ft(1,isym) + at(3,2)*ft(2,isym) + at(3,3)*ft(3,isym)
WRITE(stdout, '(1x,"cryst.",3x,"s(",i2,") = (",3i6, &
& " ) f =( ",f10.7," )")') isymq, &
& (s(1,ipol,isym), ipol = 1, 3), DBLE(ftau(1,isym))/DBLE(dfftp%nr1)
& (s(1,ipol,isym), ipol = 1, 3), ft(1,isym)
WRITE(stdout, '(17x," (",3(i6,5x), &
& " ) ( ",f10.7," )")') &
& (s(2,ipol,isym), ipol = 1, 3), DBLE(ftau(2,isym))/DBLE(dfftp%nr2)
& (s(2,ipol,isym), ipol = 1, 3), ft(2,isym)
WRITE(stdout, '(17x," (",3(i6,5x), &
& " ) ( ",f10.7," )"/)') &
& (s(3,ipol,isym), ipol = 1, 3), DBLE(ftau(3,isym))/DBLE(dfftp%nr3)
& (s(3,ipol,isym), ipol = 1, 3), ft(3,isym)
WRITE(stdout, '(1x,"cart.",3x,"s(",i2,") = (",3f11.7, &
& " ) f =( ",f10.7," )")') isymq, &
& (sr(1,ipol,isym), ipol = 1, 3), ft1
......
......@@ -7,7 +7,7 @@
! present distribution, or http://www.gnu.org/copyleft.gpl.txt .
!
!-----------------------------------------------------------------------
SUBROUTINE gmap_sym( nsym, s, ftau, gmapsym, eigv, invs )
SUBROUTINE gmap_sym( nsym, s, ft, gmapsym, eigv, invs )
!-----------------------------------------------------------------------
!!
!! For every G vector, find S(G) for all the symmetry operations
......@@ -23,7 +23,6 @@
!----------------------------------------------------------------------
USE kinds, ONLY : DP
USE constants_epw, ONLY : twopi, ci, cone
USE fft_base, ONLY : dfftp
USE gvect, ONLY : mill, ngm
!
IMPLICIT NONE
......@@ -32,8 +31,8 @@
!! the number of symmetries of the crystal
INTEGER, INTENT(in) :: s(3,3,48)
!! the symmetry matrices
INTEGER, INTENT(in) :: ftau(3,48)
!! the fractional traslations
REAL(dp), INTENT(in) :: ft(3,48)
!! the fractional traslations in crystal axis
INTEGER, INTENT(in) :: invs(48)
!! inverse symmetry matrix
INTEGER, INTENT(out) :: gmapsym(ngm,48)
......@@ -99,14 +98,11 @@
!
! now the phase factors e^{iGv}
!
IF ( ftau(1,isym) .ne. 0 .OR. ftau(2,isym) .ne. 0 .OR. ftau(3,isym) .ne. 0 ) THEN
IF ( ft(1,isym)**2 + ft(2,isym)**2 + ft(3,isym)**2 > 1.0d-8 ) THEN
!
! fractional traslation in crystal coord is ftau/nr*
! for cart/crys transform of the G-vecctors have a look at the bottom
!
rdotk = dble( mill(1,ig) * ftau(1,isym) ) / dble(dfftp%nr1) &
+ dble( mill(2,ig) * ftau(2,isym) ) / dble(dfftp%nr2) &
+ dble( mill(3,ig) * ftau(3,isym) ) / dble(dfftp%nr3)
rdotk = dble( mill(1,ig) ) * ft(1,isym) &
+ dble( mill(2,ig) ) * ft(2,isym) &
+ dble( mill(3,ig) ) * ft(3,isym)
!
! the actual translation is -v (have a look at ruota_ijk.f90)
!
......
......@@ -25,7 +25,7 @@ subroutine hp_check_type(na)
!
USE ions_base, ONLY : ityp, nat, ntyp => nsp, tau
USE io_global, ONLY : stdout
USE symm_base, ONLY : nsym, set_sym, ft, ftau
USE symm_base, ONLY : nsym, set_sym, ft
USE noncollin_module, ONLY : nspin_mag, m_loc
USE fft_base, ONLY : dfftp
USE ldaU_hp, ONLY : recalc_sym
......@@ -91,15 +91,6 @@ subroutine hp_check_type(na)
!
DEALLOCATE(m_loc)
!
! Since symmetries were recomputed, we need to reinitialize vectors
! of fractional translations
!
DO isym = 1, nsym
ftau(1,isym) = NINT( ft(1,isym) * DBLE(dfftp%nr1) )
ftau(2,isym) = NINT( ft(2,isym) * DBLE(dfftp%nr2) )
ftau(3,isym) = NINT( ft(3,isym) * DBLE(dfftp%nr3) )
ENDDO
!
IF ( nsym == nsym_old ) THEN
WRITE( stdout, '(5x,"The number of symmetries is the same as in PWscf :")')
recalc_sym = .false.
......
......@@ -55,7 +55,7 @@ SUBROUTINE hp_setup_q()
USE fft_base, ONLY : dfftp
USE gvect, ONLY : ngm
USE gvecs, ONLY : doublegrid
USE symm_base, ONLY : nrot, nsym, s, ftau, irt, time_reversal, &
USE symm_base, ONLY : nrot, nsym, s, ft, irt, time_reversal, &
inverse_s, d1, d2, d3
USE uspp_param, ONLY : upf
USE uspp, ONLY : nlcc_any
......@@ -142,7 +142,7 @@ SUBROUTINE hp_setup_q()
! Check if there are fractional translations
! Note: Try to use PH/symmorphic_or_nzb ?
!
is_symmorphic = .NOT.(ANY(ftau(:,1:nsymq) /= 0))
is_symmorphic = .NOT.( ANY( ABS(ft(:,1:nsymq)) > 1.d-8 ) )
!
IF (skip_equivalence_q) THEN
search_sym = .FALSE.
......
......@@ -23,7 +23,7 @@ SUBROUTINE hp_summary_q
USE gvecs, ONLY : doublegrid, dual, gcutms, ngms
USE gvecw, ONLY : ecutwfc
USE fft_base, ONLY : dffts
USE symm_base, ONLY : s, sr, ftau, sname
USE symm_base, ONLY : s, sr, ft, sname
USE funct, ONLY : write_dft_name
USE control_flags, ONLY : iverbosity
USE lr_symm_base, ONLY : irotmq, minus_q, nsymq
......@@ -82,24 +82,24 @@ SUBROUTINE hp_summary_q
!
WRITE( stdout, '(/5x,"isym = ",i2,5x,a45/)') isymq, sname (isym)
!
IF (ftau(1,isym).NE.0 .OR. ftau(2,isym).NE.0 .OR. ftau(3,isym).NE.0) THEN
IF ( ft(1,isym)**2 + ft(2,isym)**2 + ft(3,isym)**2 > 1.0d-8 ) THEN
!
ft1 = at (1, 1) * ftau (1, isym) / dfftp%nr1 + &
at (1, 2) * ftau (2, isym) / dfftp%nr2 + &
at (1, 3) * ftau (3, isym) / dfftp%nr3
ft2 = at (2, 1) * ftau (1, isym) / dfftp%nr1 + &
at (2, 2) * ftau (2, isym) / dfftp%nr2 + &
at (2, 3) * ftau (3, isym) / dfftp%nr3
ft3 = at (3, 1) * ftau (1, isym) / dfftp%nr1 + &
at (3, 2) * ftau (2, isym) / dfftp%nr2 + &
at (3, 3) * ftau (3, isym) / dfftp%nr3
ft1 = at (1, 1) * ft(1, isym) + &
at (1, 2) * ft(2, isym) + &
at (1, 3) * ft(3, isym)
ft2 = at (2, 1) * ft(1, isym) + &
at (2, 2) * ft(2, isym) + &
at (2, 3) * ft(3, isym)
ft3 = at (3, 1) * ft(1, isym) + &
at (3, 2) * ft(2, isym) + &
at (3, 3) * ft(3, isym)
!
WRITE( stdout, '(5x,"cryst.",3x,"s(",i2,") = (",3(i6,5x)," ) f =( ",f10.7," )")') &
& isymq, (s(1,ipol,isym), ipol=1,3), DBLE(ftau(1,isym)) / DBLE(dfftp%nr1)
& isymq, (s(1,ipol,isym), ipol=1,3), ft(1,isym)
WRITE( stdout, '(21x," (",3(i6,5x), " ) ( ",f10.7," )")') &
& (s(2,ipol,isym), ipol=1,3), DBLE(ftau(2,isym)) / DBLE(dfftp%nr2)
& (s(2,ipol,isym), ipol=1,3), ft(2,isym)
WRITE( stdout, '(21x," (",3(i6,5x)," ) ( ",f10.7," )"/)') &
& (s(3,ipol,isym), ipol=1,3), DBLE(ftau(3,isym)) / DBLE(dfftp%nr3)
& (s(3,ipol,isym), ipol=1,3), ft(3,isym)
WRITE( stdout, '(5x,"cart.",4x,"s(",i2,") = (",3f11.7, " ) f =( ",f10.7," )")') &
& isymq, (sr(1,ipol,isym), ipol=1,3), ft1
WRITE( stdout, '(21x," (",3f11.7, " ) ( ",f10.7," )")') &
......
......@@ -16,7 +16,7 @@ SUBROUTINE hp_symdvscf (dvtosym)
USE constants, ONLY : tpi
USE fft_base, ONLY : dfftp
USE cell_base, ONLY : at
USE symm_base, ONLY : s, ftau
USE symm_base, ONLY : s, ft
USE noncollin_module, ONLY : nspin_lsda, nspin_mag
USE ions_base, ONLY : tau
USE qpoint, ONLY : xq
......@@ -27,9 +27,10 @@ SUBROUTINE hp_symdvscf (dvtosym)
complex(DP) :: dvtosym (dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, nspin_mag)
! the potential to be symmetrized
integer :: ftau(3,48)
integer :: is, ri, rj, rk, i, j, k, ipol, isym, irot
! counters
real(DP) :: gf(3), gf2, n(3), ft(3)
real(DP) :: gf(3), gf2, n(3)
! temp variables
complex(DP), allocatable :: dvsym (:,:,:)
! the symmetrized potential
......@@ -48,6 +49,10 @@ SUBROUTINE hp_symdvscf (dvtosym)
n(2) = tpi / DBLE(dfftp%nr2)
n(3) = tpi / DBLE(dfftp%nr3)
!
ftau(1,1:nsymq) = NINT ( ft(1,1:nsymq)*dfftp%nr1 )
ftau(2,1:nsymq) = NINT ( ft(2,1:nsymq)*dfftp%nr2 )
ftau(3,1:nsymq) = NINT ( ft(3,1:nsymq)*dfftp%nr3 )
!
! Symmetrize with -q if present (Sq = -q + G)
!
IF (minus_q) THEN
......
......@@ -18,7 +18,7 @@ SUBROUTINE set_small_group_of_q(nsymq, invsymq, minus_q)
USE kinds, ONLY : DP
USE cell_base, ONLY : at, bg
USE ions_base, ONLY : nat, tau
USE symm_base, ONLY : s, nsym, ftau, irt, time_reversal
USE symm_base, ONLY : s, nsym, irt, time_reversal
USE control_flags, ONLY : modenum
USE qpoint, ONLY : xq
USE symm_base, ONLY : copy_sym, d1, d2, d3, inverse_s, s_axis_to_cart
......@@ -35,7 +35,7 @@ SUBROUTINE set_small_group_of_q(nsymq, invsymq, minus_q)
!
sym(1:nsym)=.true.
!
CALL smallg_q (xq, modenum, at, bg, nsym, s, ftau, sym, minus_q)
CALL smallg_q (xq, modenum, at, bg, nsym, s, sym, minus_q)
!
IF ( .not. time_reversal ) minus_q = .false.
!
......@@ -72,7 +72,7 @@ SUBROUTINE set_small_group_of_q(nsymq, invsymq, minus_q)
END SUBROUTINE set_small_group_of_q
!
!-----------------------------------------------------------------------
SUBROUTINE smallg_q (xq, modenum, at, bg, nrot, s, ftau, sym, minus_q)
SUBROUTINE smallg_q (xq, modenum, at, bg, nrot, s, sym, minus_q)
!-----------------------------------------------------------------------
!
! This routine selects, among the symmetry matrices of the point group
......@@ -93,11 +93,9 @@ SUBROUTINE smallg_q (xq, modenum, at, bg, nrot, s, ftau, sym, minus_q)
! input: the direct lattice vectors
! input: the q point of the crystal
integer, intent(in) :: s (3, 3, 48), nrot, ftau (3, 48), modenum
integer, intent(in) :: s (3, 3, 48), nrot, modenum
! input: the symmetry matrices
! input: number of symmetry operations
! input: fft grid dimension (units for ftau)
! input: fractionary translation of each symmetr
! input: main switch of the program, used for
! q<>0 to restrict the small group of q
! to operation such that Sq=q (exactly,
......
This diff is collapsed.
......@@ -26,13 +26,6 @@ program fd
USE symm_base
USE symme
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, &
which_irr_so, char_mat_so, name_rap_so, name_class_so, d_spin, &
name_class_so1
USE rap_point_group_is, ONLY : nsym_is, sr_is, ftau_is, d_spin_is, &
gname_is, sname_is, code_group_is
USE fft_base, ONLY : dfftp
implicit none
......@@ -184,24 +177,19 @@ program fd
IF (verbose) THEN
WRITE( stdout, '(36x,"s",24x,"frac. trans.")')
nsym_is=0
DO isym = 1, nsym
WRITE( stdout, '(/6x,"isym = ",i2,5x,a45/)') isym, sname(isym)
IF ( ftau(1,isym).NE.0 .OR. ftau(2,isym).NE.0 .OR. &
ftau(3,isym).NE.0) THEN
ft1 = at(1,1)*ftau(1,isym)/dfftp%nr1 + at(1,2)*ftau(2,isym)/dfftp%nr2 + &
at(1,3)*ftau(3,isym)/dfftp%nr3
ft2 = at(2,1)*ftau(1,isym)/dfftp%nr1 + at(2,2)*ftau(2,isym)/dfftp%nr2 + &
at(2,3)*ftau(3,isym)/dfftp%nr3
ft3 = at(3,1)*ftau(1,isym)/dfftp%nr1 + at(3,2)*ftau(2,isym)/dfftp%nr2 + &
at(3,3)*ftau(3,isym)/dfftp%nr3
IF ( ft(1,isym)**2 + ft(2,isym)**2 + ft(3,isym)**2 > 1.0d-8 ) THEN
ft1 = at(1,1)*ft(1,isym) + at(1,2)*ft(2,isym) + at(1,3)*ft(3,isym)
ft2 = at(2,1)*ft(1,isym) + at(2,2)*ft(2,isym) + at(2,3)*ft(3,isym)
ft3 = at(3,1)*ft(1,isym) + at(3,2)*ft(2,isym) + at(3,3)*ft(3,isym)
WRITE( stdout, '(1x,"cryst.",3x,"s(",i2,") = (",3(i6,5x), &
& " ) f =( ",f10.7," )")') &
isym, (s(1,ipol,isym),ipol=1,3), DBLE(ftau(1,isym))/DBLE(dfftp%nr1)
isym, (s(1,ipol,isym),ipol=1,3), ft(1,isym)
WRITE( stdout, '(17x," (",3(i6,5x), " ) ( ",f10.7," )")') &
(s(2,ipol,isym),ipol=1,3), DBLE(ftau(2,isym))/DBLE(dfftp%nr2)
(s(2,ipol,isym),ipol=1,3), ft(2,isym)
WRITE( stdout, '(17x," (",3(i6,5x), " ) ( ",f10.7," )"/)') &
(s(3,ipol,isym),ipol=1,3), DBLE(ftau(3,isym))/DBLE(dfftp%nr3)
(s(3,ipol,isym),ipol=1,3), ft(3,isym)
WRITE( stdout, '(1x,"cart. ",3x,"s(",i2,") = (",3f11.7, &
& " ) f =( ",f10.7," )")') &
isym, (sr(1,ipol,isym),ipol=1,3), ft1
......
......@@ -12,15 +12,8 @@ program fd_raman
USE kinds, ONLY : dp
USE gvecw, ONLY : ecutwfc
USE symm_base, ONLY : nsym, nsym_ns, nsym_na, invsym, s, sr, &
t_rev, ftau, sname
t_rev, ft, sname
USE symme
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, &
which_irr_so, char_mat_so, name_rap_so, name_class_so, d_spin, &
name_class_so1
USE rap_point_group_is, ONLY : nsym_is, sr_is, ftau_is, d_spin_is, &
gname_is, sname_is, code_group_is
USE fft_base, ONLY : dfftp
USE parser, ONLY : field_count, read_line, get_field, parse_unit
......@@ -132,24 +125,19 @@ program fd_raman
write(6,*)
WRITE( stdout, '(36x,"s",24x,"frac. trans.")')
nsym_is=0
DO isym = 1, nsym
WRITE( stdout, '(/6x,"isym = ",i2,5x,a45/)') isym, sname(isym)
IF ( ftau(1,isym).NE.0 .OR. ftau(2,isym).NE.0 .OR. &
ftau(3,isym).NE.0) THEN
ft1 = at(1,1)*ftau(1,isym)/dfftp%nr1 + at(1,2)*ftau(2,isym)/dfftp%nr2 + &
at(1,3)*ftau(3,isym)/dfftp%nr3
ft2 = at(2,1)*ftau(1,isym)/dfftp%nr1 + at(2,2)*ftau(2,isym)/dfftp%nr2 + &
at(2,3)*ftau(3,isym)/dfftp%nr3
ft3 = at(3,1)*ftau(1,isym)/dfftp%nr1 + at(3,2)*ftau(2,isym)/dfftp%nr2 + &
at(3,3)*ftau(3,isym)/dfftp%nr3
IF ( ft(1,isym)**2 + ft(2,isym)**2 + ft(3,isym)**2 > 1.0d-8 ) THEN
ft1 = at(1,1)*ft(1,isym) + at(1,2)*ft(2,isym) + at(1,3)*ft(3,isym)
ft2 = at(2,1)*ft(1,isym) + at(2,2)*ft(2,isym) + at(2,3)*ft(3,isym)
ft3 = at(3,1)*ft(1,isym) + at(3,2)*ft(2,isym) + at(3,3)*ft(3,isym)
WRITE( stdout, '(1x,"cryst.",3x,"s(",i2,") = (",3(i6,5x), &
& " ) f =( ",f10.7," )")') &
isym, (s(1,ipol,isym),ipol=1,3), DBLE(ftau(1,isym))/DBLE(dfftp%nr1)
isym, (s(1,ipol,isym),ipol=1,3), ft(1,isym)
WRITE( stdout, '(17x," (",3(i6,5x), " ) ( ",f10.7," )")') &
(s(2,ipol,isym),ipol=1,3), DBLE(ftau(2,isym))/DBLE(dfftp%nr2)
(s(2,ipol,isym),ipol=1,3), ft(2,isym)
WRITE( stdout, '(17x," (",3(i6,5x), " ) ( ",f10.7," )"/)') &
(s(3,ipol,isym),ipol=1,3), DBLE(ftau(3,isym))/DBLE(dfftp%nr3)
(s(3,ipol,isym),ipol=1,3), ft(3,isym)
WRITE( stdout, '(1x,"cart. ",3x,"s(",i2,") = (",3f11.7, &
& " ) f =( ",f10.7," )")') &
isym, (sr(1,ipol,isym),ipol=1,3), ft1
......
......@@ -26,13 +26,6 @@ program fd_ifc
USE symm_base
USE symme
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, &
which_irr_so, char_mat_so, name_rap_so, name_class_so, d_spin, &
name_class_so1
USE rap_point_group_is, ONLY : nsym_is, sr_is, ftau_is, d_spin_is, &
gname_is, sname_is, code_group_is
USE fft_base, ONLY : dfftp
implicit none
......
......@@ -94,7 +94,7 @@ SUBROUTINE write_dfile_star(descr, source, nsym, xq, u, nq, sxq, isq, s, &
USE fft_base, ONLY : dfftp
USE cell_base, ONLY : at, bg
USE ions_base, ONLY : nat, tau, amass
USE symm_base, ONLY : ftau, t_rev
USE symm_base, ONLY : ft, t_rev
USE lsda_mod, ONLY : nspin
USE modes, ONLY : nirr, npert, npertx
USE units_ph, ONLY : lrdrho
......@@ -152,7 +152,7 @@ SUBROUTINE write_dfile_star(descr, source, nsym, xq, u, nq, sxq, isq, s, &
CHARACTER(LEN=256) :: dfile_rot_name
COMPLEX(DP) :: phase_xq
INTEGER :: ipol,iq,index0,nar
INTEGER :: ichosen_sym(48)
INTEGER :: ichosen_sym(48), ftau(3)
COMPLEX(DP), ALLOCATABLE :: phase_sxq(:)
! fake vars for cartesian "patterns"
TYPE(rotated_pattern_repr) :: rpat
......@@ -279,6 +279,9 @@ SUBROUTINE write_dfile_star(descr, source, nsym, xq, u, nq, sxq, isq, s, &
phase_sxq(k)=1._dp/CMPLX(cos(sxq_tau),sin(sxq_tau))
ENDDO
!
ftau(1) = NINT ( ft(1,isym_inv)*dfftp%nr1 )
ftau(2) = NINT ( ft(2,isym_inv)*dfftp%nr2 )
ftau(3) = NINT ( ft(3,isym_inv)*dfftp%nr3 )
DO is=1,nspin
KLOOP : DO k = 1, dfftp%nr3
JLOOP : DO j = 1, dfftp%nr2
......@@ -286,7 +289,7 @@ SUBROUTINE write_dfile_star(descr, source, nsym, xq, u, nq, sxq, isq, s, &
!
! Here I rotate r
!
CALL ruotaijk(s(1,1,isym_inv), ftau(1,isym_inv), i, j, k, &
CALL ruotaijk(s(1,1,isym_inv), ftau, i, j, k, &
dfftp%nr1, dfftp%nr2, dfftp%nr3, ri, rj, rk)
!
n = (i-1) + (j-1)*dfftp%nr1 + (k-1)*dfftp%nr2*dfftp%nr1 + 1
......
......@@ -1296,7 +1296,7 @@ SUBROUTINE elphfil_epa(iq)
USE mp_pools, ONLY : npool, intra_pool_comm
USE qpoint, ONLY : nksq, nksqtot, ikks, ikqs, eigqts
USE start_k, ONLY : nk1, nk2, nk3, k1, k2, k3
USE symm_base, ONLY : s, invs, ftau, nrot, nsym, nsym_ns, &
USE symm_base, ONLY : s, invs, ft, nrot, nsym, nsym_ns, &
nsym_na, ft, sr, sname, t_rev, irt, time_reversal, &
invsym, nofrac, allfrac, nosym, nosym_evc, no_t_rev
USE wvfct, ONLY : nbnd, et, wg
......@@ -1317,7 +1317,7 @@ SUBROUTINE elphfil_epa(iq)
INTEGER, ALLOCATABLE :: ngk_collect(:)
INTEGER, ALLOCATABLE :: ikks_collect(:), ikqs_collect(:)
COMPLEX(DP), ALLOCATABLE :: el_ph_mat_collect(:,:,:,:)
INTEGER :: ftau(3,48)
INTEGER, EXTERNAL :: find_free_unit, atomic_number
filelph = TRIM(prefix) // '.epa.k'
......@@ -1422,7 +1422,12 @@ SUBROUTINE elphfil_epa(iq)
WRITE(iuelph) (num_rap_mode(ii), ii = 1, nmodes)
WRITE(iuelph) (((s(ii, jj, kk), ii = 1, 3), jj = 1, 3), kk = 1, 48)
WRITE(iuelph) (invs(ii), ii = 1, 48)
! FIXME: should disappear
ftau(1,1:48) = NINT(ft(1,1:48)*dfftp%nr1)
ftau(2,1:48) = NINT(ft(2,1:48)*dfftp%nr2)
ftau(3,1:48) = NINT(ft(3,1:48)*dfftp%nr3)
WRITE(iuelph) ((ftau(ii, jj), ii = 1, 3), jj = 1, 48)
! end FIXME
WRITE(iuelph) ((ft(ii, jj), ii = 1, 3), jj = 1, 48)
WRITE(iuelph) (((sr(ii, jj, kk), ii = 1, 3), jj = 1, 3), kk = 1, 48)
WRITE(iuelph) (sname(ii), ii = 1, 48)
......
......@@ -163,7 +163,7 @@ SUBROUTINE elphsum_wannier(q_index)
USE kinds, ONLY : DP
USE ions_base, ONLY : nat, ityp, tau,amass,tau, ntyp => nsp, atm
USE cell_base, ONLY : at, bg, ibrav, celldm
USE symm_base, ONLY : s, sr, irt, nsym, time_reversal, invs, ftau, copy_sym, inverse_s
USE symm_base, ONLY : s, sr, irt, nsym, time_reversal, invs, copy_sym, inverse_s
USE klist, ONLY : xk, nelec
USE wvfct, ONLY : nbnd, et
USE el_phon
......@@ -264,7 +264,7 @@ SUBROUTINE elphsum_wannier(q_index)
sym = .false.
sym(1:nsym) = .true.
call smallg_q (xq, 0, at, bg, nsym, s, ftau, sym, minus_qloc)
call smallg_q (xq, 0, at, bg, nsym, s, sym, minus_qloc)
nsymq = copy_sym(nsym, sym)
! recompute the inverses as the order of sym.ops. has changed
CALL inverse_s ( )
......
......@@ -19,7 +19,7 @@ subroutine init_representations()
USE ions_base, ONLY : tau, nat
USE cell_base, ONLY : at, bg
USE io_global, ONLY : stdout
USE symm_base, ONLY : nsym, sr, ftau, irt, time_reversal, t_rev, s
USE symm_base, ONLY : nsym, sr, irt, time_reversal, t_rev, s
USE control_ph, ONLY : search_sym, current_iq, u_from_file, &
search_sym_save
USE modes, ONLY : u, npert, nirr, nmodes, name_rap_mode, &
......
......@@ -2533,7 +2533,7 @@ SUBROUTINE find_representations_mode_q ( nat, ntyp, xq, w2, u, tau, ityp, &
USE kinds, ONLY : DP
USE cell_base, ONLY : at, bg
USE symm_base, ONLY : s, sr, ftau, irt, nsym, nrot, t_rev, time_reversal,&
USE symm_base, ONLY : s, sr, ft, irt, nsym, nrot, t_rev, time_reversal,&
sname, copy_sym, s_axis_to_cart
IMPLICIT NONE
......@@ -2553,7 +2553,7 @@ SUBROUTINE find_representations_mode_q ( nat, ntyp, xq, w2, u, tau, ityp, &
IF (.NOT.time_reversal) minus_q=.FALSE.
sym(1:nsym)=.true.
call smallg_q (xq, 0, at, bg, nsym, s, ftau, sym, minus_q)
call smallg_q (xq, 0, at, bg, nsym, s, sym, minus_q)
nsymq=copy_sym(nsym,sym )
call s_axis_to_cart ()
CALL set_giq (xq,s,nsymq,nsym,irotmq,minus_q,gi,gimq)
......@@ -2562,7 +2562,7 @@ SUBROUTINE find_representations_mode_q ( nat, ntyp, xq, w2, u, tau, ityp, &
! search the symmetries only if there are no G such that Sq -> q+G
!
search_sym=.TRUE.
IF ( ANY ( ftau(:,1:nsymq) /= 0 ) ) THEN
IF ( ANY ( ABS(ft(:,1:nsymq)) > 1.0d-8 ) ) THEN
DO isym=1,nsymq
search_sym=( search_sym.and.(abs(gi(1,isym))<1.d-8).and. &
(abs(gi(2,isym))<1.d-8).and. &
......
......@@ -60,7 +60,7 @@ subroutine phq_setup
USE fft_base, ONLY : dfftp
USE gvect, ONLY : ngm
USE gvecs, ONLY : doublegrid
USE symm_base, ONLY : nrot, nsym, s, ftau, irt, t_rev, time_reversal, &
USE symm_base, ONLY : nrot, nsym, s, irt, t_rev, time_reversal, &
sr, invs, inverse_s, d1, d2, d3
USE uspp_param, ONLY : upf
USE uspp, ONLY : nlcc_any
......
......@@ -26,7 +26,7 @@ subroutine phq_summary
USE gvect, ONLY : gcutm, ngm
USE gvecs, ONLY : doublegrid, dual, gcutms, ngms
USE fft_base, ONLY : dffts
USE symm_base, ONLY : s, sr, ftau, sname, t_rev
USE symm_base, ONLY : s, sr, ft, sname, t_rev
USE noncollin_module, ONLY : noncolin
USE spin_orb, ONLY : lspinorb, domag
USE funct, ONLY : write_dft_name
......@@ -185,23 +185,19 @@ subroutine phq_summary
IF (noncolin.and.domag) &
WRITE(stdout,'(1x, "Time Reversal",i3)') t_rev(isym)
if (ftau (1, isym) .ne.0.or.ftau (2, isym) .ne.0.or.ftau (3, &
isym) .ne.0) then
ft1 = at (1, 1) * ftau (1, isym) / dfftp%nr1 + at (1, 2) * ftau ( &
2, isym) / dfftp%nr2 + at (1, 3) * ftau (3, isym) / dfftp%nr3
ft2 = at (2, 1) * ftau (1, isym) / dfftp%nr1 + at (2, 2) * ftau ( &
2, isym) / dfftp%nr2 + at (2, 3) * ftau (3, isym) / dfftp%nr3
ft3 = at (3, 1) * ftau (1, isym) / dfftp%nr1 + at (3, 2) * ftau ( &
2, isym) / dfftp%nr2 + at (3, 3) * ftau (3, isym) / dfftp%nr3
WRITE( stdout, '(1x,"cryst.",3x,"s(",i2,") = (",3(i6,5x), &
& " ) f =( ",f10.7," )")') isymq, (s (1, &
& ipol, isym) , ipol = 1, 3) , DBLE (ftau (1, isym) ) / DBLE (dfftp%nr1)
WRITE( stdout, '(17x," (",3(i6,5x), &
& " ) ( ",f10.7," )")') (s (2, ipol, &
&isym) , ipol = 1, 3) , DBLE (ftau (2, isym) ) / DBLE (dfftp%nr2)
WRITE( stdout, '(17x," (",3(i6,5x), &
& " ) ( ",f10.7," )"/)') (s (3, ipol, &
& isym) , ipol = 1, 3) , DBLE (ftau (3, isym) ) / DBLE (dfftp%nr3)
if ( ft(1,isym)**2 + ft(2,isym)**2 + ft(3,isym)**2 > 1.0d-8 ) then
ft1 = at(1,1)*ft(1,isym) + at(1,2)*ft(2,isym) + at(1,3)*ft(3,isym)
ft2 = at(2,1)*ft(1,isym) + at(2,2)*ft(2,isym) + at(2,3)*ft(3,isym)
ft3 = at(3,1)*ft(1,isym) + at(3,2)*ft(2,isym) + at(3,3)*ft(3,isym)
WRITE(stdout, '(1x,"cryst.",3x,"s(",i2,") = (",3(i6,5x) &
& " ) f =( ",f10.7," )")') isymq, &
& (s(1,ipol,isym), ipol = 1, 3), ft(1,isym)
WRITE(stdout, '(17x," (",3(i6,5x), &
& " ) ( ",f10.7," )")') &
& (s(2,ipol,isym), ipol = 1, 3), ft(2,isym)
WRITE(stdout, '(17x," (",3(i6,5x), &
& " ) ( ",f10.7," )"/)') &
& (s(3,ipol,isym), ipol = 1, 3), ft(3,isym)
WRITE( stdout, '(1x,"cart.",4x,"s(",i2,") = (",3f11.7, &
& " ) f =( ",f10.7," )")') isymq, &
& (sr (1, ipol,isym) , ipol = 1, 3) , ft1
......
......@@ -29,7 +29,7 @@ PROGRAM Q2QSTAR
USE io_global, ONLY : ionode_id, ionode, stdout
USE environment, ONLY : environment_start, environment_end
! symmetry
USE symm_base, ONLY : s, invs, nsym, find_sym, set_sym_bl, irt, ftau, copy_sym, nrot, inverse_s
USE symm_base, ONLY : s, invs, nsym, find_sym, set_sym_bl, irt, copy_sym, nrot, inverse_s
! for reading the dyn.mat.
USE cell_base, ONLY : at, bg, celldm, ibrav, omega
USE ions_base, ONLY : nat, ityp, ntyp => nsp, atm, tau, amass
......@@ -157,7 +157,7 @@ PROGRAM Q2QSTAR
minus_q = .true.
sym = .false.
sym(1:nsym) = .true.
CALL smallg_q(xq, 0, at, bg, nsym, s, ftau, sym, minus_q)
CALL smallg_q(xq, 0, at, bg, nsym, s, sym, minus_q)
nsymq = copy_sym(nsym, sym)
! recompute the inverses as the order of sym.ops. has changed
CALL inverse_s ( )
......
......@@ -25,7 +25,7 @@ subroutine set_irr_new (xq, u, npert, nirr, eigen)
USE kinds, only : DP
USE ions_base, ONLY : nat, tau, ntyp => nsp, ityp, amass
USE cell_base, ONLY : at, bg
USE symm_base, ONLY : s, sr, ftau, invs, nsym, irt, t_rev
USE symm_base, ONLY : s, sr, invs, nsym, irt, t_rev
USE modes, ONLY : num_rap_mode, name_rap_mode
USE noncollin_module, ONLY : noncolin, nspin_mag
USE spin_orb, ONLY : domag
......
......@@ -16,7 +16,7 @@ subroutine sym_dmag (nper, irr, dmagtosym)
USE constants, ONLY: tpi
USE fft_base, ONLY: dfftp
USE cell_base, ONLY : at, bg
USE symm_base, ONLY : s, ftau, t_rev, sname, invs
USE symm_base, ONLY : s, ft, t_rev, sname, invs
USE noncollin_module, ONLY: nspin_mag
USE modes, ONLY : t, tmq
......@@ -31,6 +31,7 @@ subroutine sym_dmag (nper, irr, dmagtosym)
complex(DP) :: dmagtosym (dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, nspin_mag, nper)
! the magnetization to symmetrize (only 2:4 components)
integer :: ftau(3,48)
integer :: is, ri, rj, rk, i, j, k, ipert, jpert, ipol, isym, &
irot, kpol
! counter on spin polarizations
......@@ -69,6 +70,9 @@ subroutine sym_dmag (nper, irr, dmagtosym)
in2 = tpi / DBLE (dfftp%nr2)
in3 = tpi / DBLE (dfftp%nr3)
ftau(1,1:nsymq) = NINT ( ft(1,1:nsymq)*dfftp%nr1 )
ftau(2,1:nsymq) = NINT ( ft(2,1:nsymq)*dfftp%nr2 )
ftau(3,1:nsymq) = NINT ( ft(3,1:nsymq)*dfftp%nr3 )
if (minus_q) then
g1 (1) = 0.d0
g2 (1) = 0.d0
......
......@@ -17,7 +17,7 @@ subroutine sym_dmage (dvsym)
USE kinds, only : DP
USE cell_base,only : at, bg
USE fft_base, only : dfftp
USE symm_base,only : nsym, sname, s, ftau, t_rev, invs
USE symm_base,only : nsym, sname, s, ft, t_rev, invs
USE lsda_mod, only : nspin
implicit none
......@@ -26,7 +26,7 @@ subroutine sym_dmage (dvsym)
complex(DP) :: dmags(3,3), mag(3), magrot(3)
! the potential to symmetrize
! auxiliary quantity
integer :: ftau(3,48)
integer :: is, ri, rj, rk, i, j, k, irot, ipol, jpol, kpol
! counter on spin polarization
! the rotated points
......@@ -51,6 +51,9 @@ subroutine sym_dmage (dvsym)
!
! symmmetrize
!
ftau(1,1:nsym) = NINT ( ft(1,1:nsym)*dfftp%nr1 )
ftau(2,1:nsym) = NINT ( ft(2,1:nsym)*dfftp%nr2 )
ftau(3,1:nsym) = NINT ( ft(3,1:nsym)*dfftp%nr3 )
do k = 1, dfftp%nr3
do j = 1, dfftp%nr2
do i = 1, dfftp%nr1
......
......@@ -16,7 +16,7 @@ subroutine symdvscf (nper, irr, dvtosym)
USE constants, ONLY: tpi
USE fft_base, ONLY: dfftp
USE cell_base, ONLY : at
USE symm_base, ONLY : s, ftau
USE symm_base, ONLY : s, ft
USE noncollin_module, ONLY : nspin_lsda, nspin_mag
USE modes, ONLY : t, tmq
......@@ -27,6 +27,7 @@ subroutine symdvscf (nper, irr, dvtosym)
integer :: nper, irr
! the number of perturbations
! the representation under conside
integer :: ftau(3,48)
complex(DP) :: dvtosym (dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, nspin_mag, nper)
! the potential to be symmetrized
......@@ -53,6 +54,9 @@ subroutine symdvscf (nper, irr, dvtosym)
n(1) = tpi / DBLE (dfftp%nr1)
n(2) = tpi / DBLE (dfftp%nr2)
n(3) = tpi / DBLE (dfftp%nr3)
ftau(1,1:nsymq) = NINT ( ft(1,1:nsymq)*dfftp%nr1 )
ftau(2,1:nsymq) = NINT ( ft(2,1:nsymq)*dfftp%nr2 )
ftau(3,1:nsymq) = NINT ( ft(3,1:nsymq)*dfftp%nr3 )
if (minus_q) then
gf(:) = gimq (1) * at (1, :) * n(:) + &
gimq (2) * at (2, :) * n(:) + &
......
......@@ -18,7 +18,7 @@ subroutine syme (dvsym)
!
USE fft_base, only : dfftp
USE symm_base, only : nsym, s, ftau
USE symm_base, only : nsym, s, ft
USE noncollin_module, only : nspin_lsda, nspin_mag
USE kinds, only : DP
implicit none
......@@ -28,6 +28,7 @@ subroutine syme (dvsym)
! the potential to symmetrize
! auxiliary quantity
integer :: ftau(3,48)
integer :: is, ri, rj, rk, i, j, k, irot, ipol, jpol
! counter on spin polarization
! the rotated points
......@@ -50,6 +51,9 @@ subroutine syme (dvsym)
!
! symmmetrize
!
ftau(1,1:nsym) = NINT ( ft(1,1:nsym)*dfftp%nr1 )
ftau(2,1:nsym) = NINT ( ft(2,1:nsym)*dfftp%nr2 )
ftau(3,1:nsym) = NINT ( ft(3,1:nsym)*dfftp%nr3 )
do k = 1, dfftp%nr3
do j = 1, dfftp%nr2
do i = 1, dfftp%nr1
......
......@@ -18,7 +18,7 @@ subroutine syme2 (dvsym)
!
use kinds, only : DP
USE fft_base, ONLY: dfftp
USE symm_base, ONLY: nsym, s, ftau
USE symm_base, ONLY: nsym, s, ft
USE ramanm, ONLY: jab
implicit none
......@@ -26,7 +26,7 @@ subroutine syme2 (dvsym)
complex(DP), allocatable :: aux (:,:,:,:)
! the function to symmetrize
! auxiliary space
integer :: ftau(3,48)
integer :: ix, jx, kx, ri, rj, rk, irot, ip, jp, lp, mp
! define a real-space point on the grid
! the rotated points
......@@ -44,6 +44,9 @@ subroutine syme2 (dvsym)
!
! symmmetrize
!
ftau(1,1:nsym) = NINT ( ft(1,1:nsym)*dfftp%nr1 )
ftau(2,1:nsym) = NINT ( ft(2,1:nsym)*dfftp%nr2 )
ftau(3,1:nsym) = NINT ( ft(3,1:nsym)*dfftp%nr3 )
do kx = 1, dfftp%nr3
do jx = 1, dfftp%nr2
do ix = 1, dfftp%nr1
......
......@@ -15,32 +15,28 @@ LOGICAL FUNCTION symmorphic_or_nzb()
USE kinds, ONLY : DP
USE cell_base, ONLY : at
USE fft_base, ONLY : dfftp
USE symm_base, ONLY : ftau
USE symm_base, ONLY : ft
USE lr_symm_base, ONLY : gi, nsymq
IMPLICIT NONE
LOGICAL :: is_symmorphic, result_sym
INTEGER :: isym, jsym
REAL(DP) :: ft(3,nsymq)
REAL(DP) :: ft_(3,nsymq)
is_symmorphic=.NOT.(ANY(ftau(:,1:nsymq) /= 0))
is_symmorphic=.NOT.(ANY( ABS(ft(:,1:nsymq)) > 1.0d-8 ) )
IF (is_symmorphic) THEN
symmorphic_or_nzb=.TRUE.
RETURN
ELSE
result_sym=.TRUE.
DO isym = 1, nsymq
ft(1,isym) = DBLE(ftau(1,isym)) / DBLE(dfftp%nr1)
ft(2,isym) = DBLE(ftau(2,isym)) / DBLE(dfftp%nr2)
ft(3,isym) = DBLE(ftau(3,isym)) / DBLE(dfftp%nr3)
END DO
CALL cryst_to_cart(nsymq, ft, at, 1)
ft_(:,1:nsymq) = ft(:,1:nsymq)
CALL cryst_to_cart(nsymq, ft_, at, 1)
DO isym=1,nsymq
DO jsym=1,nsymq
result_sym=( result_sym.AND.(ABS( gi(1,isym)*ft(1,jsym) + &
gi(2,isym)*ft(2,jsym) + &
gi(3,isym)*ft(3,jsym) ) < 1.D-8) )
result_sym=( result_sym.AND.(ABS( gi(1,isym)*ft_(1,jsym) + &
gi(2,isym)*ft_(2,jsym) + &
gi(3,isym)*ft_(3,jsym) ) < 1.D-8) )
END DO
END DO
symmorphic_or_nzb=result_sym
......
......@@ -130,7 +130,7 @@ SUBROUTINE projection (first_band, last_band, min_energy, max_energy, sigma, iop
USE wvfct, ONLY : nbnd, npwx, et
USE ldaU, ONLY : is_Hubbard, Hubbard_lmax, Hubbard_l, &
oatwfc, offsetU, nwfcU, wfcU, copy_U_wfc
USE symm_base, ONLY : nrot, nsym, nsym_ns, nsym_na, ftau, irt, s, sname, d1, d2, d3, ft, sr
USE symm_base, ONLY : nrot, nsym, nsym_ns, nsym_na, irt, s, sname, d1, d2, d3, ft, sr
USE mp_pools, ONLY : me_pool, root_pool, my_pool_id, kunit, npool
USE control_flags, ONLY: gamma_only
USE uspp, ONLY: nkb, vkb
......@@ -403,7 +403,7 @@ SUBROUTINE projection (first_band, last_band, min_energy, max_energy, sigma, iop
WRITE(iun_pp,'("# nrot,nsym,nsym_ns,nsym_na",4I4)') nrot, nsym, nsym_ns, nsym_na
DO i = 1,nsym
WRITE(iun_pp,'("#symm",I3," : ",A)') i, trim(sname(i))
WRITE(iun_pp,'(3I3,I7,5x,3F7.2,F9.2)') ( s(j,:,i), ftau(j,i), sr(j,:,i), ft(j,i), j=1,3 )
WRITE(iun_pp,'(3I3,5x,3F7.2,F9.2)') ( s(j,:,i), sr(j,:,i), ft(j,i), j=1,3 )
WRITE(iun_pp,'(99I3)') irt(i,1:nat)
ENDDO
CLOSE(iun_pp)
......
......@@ -426,7 +426,7 @@ SUBROUTINE write_wfng ( output_file_name, real_or_complex, symm_type, &
USE mp_world, ONLY : mpime, nproc, world_comm
USE mp_bands, ONLY : intra_bgrp_comm, nbgrp
USE start_k, ONLY : nk1, nk2, nk3, k1, k2, k3
USE symm_base, ONLY : s, ftau, nsym
USE symm_base, ONLY : s, ft, nsym
USE wavefunctions, ONLY : evc
USE wvfct, ONLY : npwx, nbnd, et, wg
USE gvecw, ONLY : ecutwfc
......@@ -602,9 +602,9 @@ SUBROUTINE write_wfng ( output_file_name, real_or_complex, symm_type, &
ENDDO
ENDDO
CALL invmat ( 3, r1, r2 )
t1 ( 1 ) = dble ( ftau ( 1, i ) ) / dble ( dfftp%nr1 )
t1 ( 2 ) = dble ( ftau ( 2, i ) ) / dble ( dfftp%nr2 )
t1 ( 3 ) = dble ( ftau ( 3, i ) ) / dble ( dfftp%nr3 )
t1 ( 1 ) = ft ( 1, i )
t1 ( 2 ) = ft ( 2, i )
t1 ( 3 ) = ft ( 3, i )
DO j = 1, nd
t2 ( j ) = 0.0D0
DO k = 1, nd
......@@ -1227,7 +1227,7 @@ SUBROUTINE write_rhog ( output_file_name, real_or_complex, symm_type, &
USE mp, ONLY : mp_sum
USE mp_bands, ONLY : intra_bgrp_comm
USE scf, ONLY : rho, rhoz_or_updw
USE symm_base, ONLY : s, ftau, nsym
USE symm_base, ONLY : s, ft, nsym
USE matrix_inversion
IMPLICIT NONE
......@@ -1296,9 +1296,9 @@ SUBROUTINE write_rhog ( output_file_name, real_or_complex, symm_type, &
ENDDO
ENDDO
CALL invmat ( 3, r1, r2 )
t1 ( 1 ) = dble ( ftau ( 1, i ) ) / dble ( dfftp%nr1 )
t1 ( 2 ) = dble ( ftau ( 2, i ) ) / dble ( dfftp%nr2 )
t1 ( 3 ) = dble ( ftau ( 3, i ) ) / dble ( dfftp%nr3 )
t1 ( 1 ) = ft ( 1, i )
t1 ( 2 ) = ft ( 2, i )
t1 ( 3 ) = ft ( 3, i )
DO j = 1, nd
t2 ( j ) = 0.0D0
DO k = 1, nd
......@@ -1513,7 +1513,7 @@ SUBROUTINE write_vxcg ( output_file_name, real_or_complex, symm_type, &
USE mp, ONLY : mp_sum
USE mp_bands, ONLY : intra_bgrp_comm
USE scf, ONLY : rho, rho_core, rhog_core
USE symm_base, ONLY : s, ftau, nsym
USE symm_base, ONLY : s, ft, nsym
USE wavefunctions, ONLY : psic
USE matrix_inversion
......@@ -1584,9 +1584,9 @@ SUBROUTINE write_vxcg ( output_file_name, real_or_complex, symm_type, &
ENDDO
ENDDO
CALL invmat ( 3, r1, r2 )
t1 ( 1 ) = dble ( ftau ( 1, i ) ) / dble ( dfftp%nr1 )
t1 ( 2 ) = dble ( ftau ( 2, i ) ) / dble ( dfftp%nr2 )
t1 ( 3 ) = dble ( ftau ( 3, i ) ) / dble ( dfftp%nr3 )
t1 ( 1 ) = ft ( 1, i )
t1 ( 2 ) = ft ( 2, i )
t1 ( 3 ) = ft ( 3, i )
DO j = 1, nd
t2 ( j ) = 0.0D0
DO k = 1, nd
......@@ -2218,7 +2218,7 @@ SUBROUTINE write_vscg ( output_file_name, real_or_complex, symm_type )
USE mp, ONLY : mp_sum
USE mp_bands, ONLY : intra_bgrp_comm
USE scf, ONLY : vltot, v
USE symm_base, ONLY : s, ftau, nsym
USE symm_base, ONLY : s, ft, nsym
USE wavefunctions, ONLY : psic
USE matrix_inversion
......@@ -2290,9 +2290,9 @@ SUBROUTINE write_vscg ( output_file_name, real_or_complex, symm_type )
ENDDO
ENDDO
CALL invmat ( 3, r1, r2 )
t1 ( 1 ) = dble ( ftau ( 1, i ) ) / dble ( dfftp%nr1 )
t1 ( 2 ) = dble ( ftau ( 2, i ) ) / dble ( dfftp%nr2 )
t1 ( 3 ) = dble ( ftau ( 3, i ) ) / dble ( dfftp%nr3 )
t1 ( 1 ) = ft ( 1, i )
t1 ( 2 ) = ft ( 2, i )
t1 ( 3 ) = ft ( 3, i )
DO j = 1, nd
t2 ( j ) = 0.0D0
DO k = 1, nd
......@@ -2432,7 +2432,7 @@ SUBROUTINE write_vkbg (output_file_name, symm_type, wfng_kgrid, &
intra_pool_comm, inter_pool_comm
USE mp_wave, ONLY : mergewf
USE start_k, ONLY : nk1, nk2, nk3, k1, k2, k3
USE symm_base, ONLY : s, ftau, nsym
USE symm_base, ONLY : s, ft, nsym
USE uspp, ONLY : nkb, vkb, deeq
USE uspp_param, ONLY : nhm, nh
USE wvfct, ONLY : npwx
......@@ -2516,9 +2516,9 @@ SUBROUTINE write_vkbg (output_file_name, symm_type, wfng_kgrid, &
ENDDO
ENDDO
CALL invmat ( 3, r1, r2 )
t1 ( 1 ) = dble ( ftau ( 1, i ) ) / dble ( dfftp%nr1 )
t1 ( 2 ) = dble ( ftau ( 2, i ) ) / dble ( dfftp%nr2 )
t1 ( 3 ) = dble ( ftau ( 3, i ) ) / dble ( dfftp%nr3 )
t1 ( 1 ) = ft ( 1, i )
t1 ( 2 ) = ft ( 2, i )
t1 ( 3 ) = ft ( 3, i )
DO j =