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

More removal of ftau: now is a local variable, obtained from ft, where 

useful (real-space symmetrization). Please verify!
This commit is contained in:
Paolo Giannozzi 2019-04-08 22:44:53 +02:00
parent 215a70b0c8
commit 88ef346c79
19 changed files with 120 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
HP/src/hp_check_type.f90
View File

@ -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.

4
HP/src/hp_setup_q.f90
View File

@ -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.

28
HP/src/hp_summary_q.f90
View File

@ -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," )")') &

9
HP/src/hp_symdvscf.f90
View File

@ -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
PHonon/FD/fd.f90
View File

@ -187,21 +187,17 @@ program fd
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

20
PHonon/FD/fd_ef.f90
View File

@ -12,7 +12,7 @@ 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
@ -135,21 +135,17 @@ program fd_raman
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

9
PHonon/PH/dfile_star.f90
View File

@ -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

9
PHonon/PH/elphon.f90
View File

@ -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)

4
PHonon/PH/matdyn.f90
View File

@ -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
@ -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. &

32
PHonon/PH/phq_summary.f90
View File

@ -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

6
PHonon/PH/sym_dmag.f90
View File

@ -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

7
PHonon/PH/sym_dmage.f90
View File

@ -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

6
PHonon/PH/symdvscf.f90
View File

@ -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(:) + &

6
PHonon/PH/syme.f90
View File

@ -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

7
PHonon/PH/syme2.f90
View File

@ -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

18
PHonon/PH/symmorphic_or_nzb.f90
View File

@ -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
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

10
PP/src/pw_export.f90
View File

@ -363,7 +363,7 @@ SUBROUTINE write_export (pp_file,kunit,uspp_spsi, ascii, single_file, raw)
USE global_version, ONLY : version_number
USE becmod, ONLY : bec_type, becp, calbec, &
allocate_bec_type, deallocate_bec_type
USE symm_base, ONLY : nsym, s, invsym, sname, irt, ftau
USE symm_base, ONLY : nsym, s, invsym, sname, irt, ft
USE uspp, ONLY : nkb, vkb
USE wavefunctions, ONLY : evc
USE io_files, ONLY : nd_nmbr, tmp_dir, prefix, iunwfc, nwordwfc
@ -387,7 +387,7 @@ SUBROUTINE write_export (pp_file,kunit,uspp_spsi, ascii, single_file, raw)
LOGICAL, INTENT(in) :: uspp_spsi, ascii, single_file, raw
INTEGER :: npw, i, j, k, ig, ik, ibnd, na, ngg,ig_, ierr
real(DP) :: xyz(3), tmp(3)
real(DP) :: xyz(3)
INTEGER :: ike, iks, npw_g, npwx_g, ispin, local_pw
INTEGER, EXTERNAL :: global_kpoint_index
INTEGER, ALLOCATABLE :: ngk_g( : )
@ -594,15 +594,11 @@ SUBROUTINE write_export (pp_file,kunit,uspp_spsi, ascii, single_file, raw)
CALL iotk_write_attr ( attr,"name", trim(sname(i)), FIRST=.true. )
CALL iotk_write_empty(50,"info"//trim(iotk_index(i)), ATTR=attr )
!
tmp(1) = ftau(1,i) / dble( dfftp%nr1 )
tmp(2) = ftau(2,i) / dble( dfftp%nr2 )
tmp(3) = ftau(3,i) / dble( dfftp%nr3 )
!
CALL iotk_write_attr(attr,"units","crystal",first=.true.)
!
CALL iotk_write_dat (50,"sym"//trim(iotk_index(i)), &
s(1:3,1:3,i), ATTR=attr, COLUMNS=3)
CALL iotk_write_dat (50,"trasl"//trim(iotk_index(i)), tmp(:), ATTR=attr )
CALL iotk_write_dat (50,"trasl"//trim(iotk_index(i)), ft(:,i), ATTR=attr )
!
ENDDO
!

22
TDDFPT/src/lr_summary.f90
View File

@ -25,7 +25,7 @@ SUBROUTINE lr_summary
USE fft_base, ONLY : dfftp, dffts
USE gvect, ONLY : gcutm, ngm
USE gvecs, ONLY : doublegrid, dual, gcutms, ngms
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
@ -150,21 +150,21 @@ SUBROUTINE lr_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
IF ( ft(1,isym)**2 + ft(2,isym)**2 + ft(3,isym)**2 > 1.d-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, '(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)
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) , 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.",4x,"s(",i2,") = (",3f11.7, " ) f =( ",f10.7," )")') &
isymq, (sr (1, ipol,isym) , ipol = 1, 3) , ft1

7
TDDFPT/src/lr_sym_eels.f90
View File

@ -20,7 +20,7 @@ SUBROUTINE lr_sym_eels (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 lr_symm_base, ONLY : minus_q, nsymq, irotmq, gi, gimq
@ -29,6 +29,7 @@ SUBROUTINE lr_sym_eels (dvtosym)
!
COMPLEX(DP) :: dvtosym(dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, nspin_mag)
! the charge density response to be symmetrized
INTEGER :: ftau(3,48)
INTEGER :: is, ri, rj, rk, i, j, k, ipol, isym, irot
! counters
REAL(DP) :: gf(3), n(3)
@ -51,6 +52,10 @@ SUBROUTINE lr_sym_eels (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)
!
!------------------------------------------------------------------------!
! If necessary, symmetrize with respect to the sym.op. S*q = -q + G !
!------------------------------------------------------------------------!