diff --git a/HP/src/hp_check_type.f90 b/HP/src/hp_check_type.f90 index 3e3479677..835eb47cd 100644 --- a/HP/src/hp_check_type.f90 +++ b/HP/src/hp_check_type.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. diff --git a/HP/src/hp_setup_q.f90 b/HP/src/hp_setup_q.f90 index 17345d1bc..b76d527d5 100644 --- a/HP/src/hp_setup_q.f90 +++ b/HP/src/hp_setup_q.f90 @@ -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. diff --git a/HP/src/hp_summary_q.f90 b/HP/src/hp_summary_q.f90 index 592833662..45e7245b7 100644 --- a/HP/src/hp_summary_q.f90 +++ b/HP/src/hp_summary_q.f90 @@ -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," )")') & diff --git a/HP/src/hp_symdvscf.f90 b/HP/src/hp_symdvscf.f90 index 9eefe66a4..d7426da1a 100644 --- a/HP/src/hp_symdvscf.f90 +++ b/HP/src/hp_symdvscf.f90 @@ -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 diff --git a/PHonon/FD/fd.f90 b/PHonon/FD/fd.f90 index 9489ef53b..269346789 100644 --- a/PHonon/FD/fd.f90 +++ b/PHonon/FD/fd.f90 @@ -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 diff --git a/PHonon/FD/fd_ef.f90 b/PHonon/FD/fd_ef.f90 index a46547185..94df19ca1 100644 --- a/PHonon/FD/fd_ef.f90 +++ b/PHonon/FD/fd_ef.f90 @@ -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 diff --git a/PHonon/PH/dfile_star.f90 b/PHonon/PH/dfile_star.f90 index 66a0d1243..7164dee13 100644 --- a/PHonon/PH/dfile_star.f90 +++ b/PHonon/PH/dfile_star.f90 @@ -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 diff --git a/PHonon/PH/elphon.f90 b/PHonon/PH/elphon.f90 index c0f1b55e3..ab140e0b2 100644 --- a/PHonon/PH/elphon.f90 +++ b/PHonon/PH/elphon.f90 @@ -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) diff --git a/PHonon/PH/matdyn.f90 b/PHonon/PH/matdyn.f90 index 300c27183..0b13eda44 100644 --- a/PHonon/PH/matdyn.f90 +++ b/PHonon/PH/matdyn.f90 @@ -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. & diff --git a/PHonon/PH/phq_summary.f90 b/PHonon/PH/phq_summary.f90 index c38852d10..d931b7135 100644 --- a/PHonon/PH/phq_summary.f90 +++ b/PHonon/PH/phq_summary.f90 @@ -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 diff --git a/PHonon/PH/sym_dmag.f90 b/PHonon/PH/sym_dmag.f90 index cc982b1d8..cfba17daa 100644 --- a/PHonon/PH/sym_dmag.f90 +++ b/PHonon/PH/sym_dmag.f90 @@ -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 diff --git a/PHonon/PH/sym_dmage.f90 b/PHonon/PH/sym_dmage.f90 index 282e39b91..b06d870aa 100644 --- a/PHonon/PH/sym_dmage.f90 +++ b/PHonon/PH/sym_dmage.f90 @@ -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 diff --git a/PHonon/PH/symdvscf.f90 b/PHonon/PH/symdvscf.f90 index 5363b9f4b..6b2f4a7b6 100644 --- a/PHonon/PH/symdvscf.f90 +++ b/PHonon/PH/symdvscf.f90 @@ -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(:) + & diff --git a/PHonon/PH/syme.f90 b/PHonon/PH/syme.f90 index 5bc3e06c5..c812f4230 100644 --- a/PHonon/PH/syme.f90 +++ b/PHonon/PH/syme.f90 @@ -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 diff --git a/PHonon/PH/syme2.f90 b/PHonon/PH/syme2.f90 index 0377885f7..7de984673 100644 --- a/PHonon/PH/syme2.f90 +++ b/PHonon/PH/syme2.f90 @@ -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 diff --git a/PHonon/PH/symmorphic_or_nzb.f90 b/PHonon/PH/symmorphic_or_nzb.f90 index 99839f12c..2cb36a592 100644 --- a/PHonon/PH/symmorphic_or_nzb.f90 +++ b/PHonon/PH/symmorphic_or_nzb.f90 @@ -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 diff --git a/PP/src/pw_export.f90 b/PP/src/pw_export.f90 index 0384b2c65..5c74ccdcd 100644 --- a/PP/src/pw_export.f90 +++ b/PP/src/pw_export.f90 @@ -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 ! diff --git a/TDDFPT/src/lr_summary.f90 b/TDDFPT/src/lr_summary.f90 index e8b15208c..515b30d3f 100644 --- a/TDDFPT/src/lr_summary.f90 +++ b/TDDFPT/src/lr_summary.f90 @@ -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 diff --git a/TDDFPT/src/lr_sym_eels.f90 b/TDDFPT/src/lr_sym_eels.f90 index c97c97678..a1cedebff 100644 --- a/TDDFPT/src/lr_sym_eels.f90 +++ b/TDDFPT/src/lr_sym_eels.f90 @@ -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 ! !------------------------------------------------------------------------!