More symmetry cleanup: symtns => symmatrix (works in cartesian coordinates,

supersedes GIPAW/sym_cart_tensor.f90) - GIPAW and VdW untested


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@6288 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2010-01-11 22:48:10 +00:00
parent 6f7e69f3d3
commit 655b713f25
18 changed files with 113 additions and 142 deletions

View File

@ -17,7 +17,6 @@ greenfunction.o \
h_psiq.o \
cg_psi.o \
cgsolve_all.o \
sym_cart_tensor.o \
symmetrize_field.o \
ch_psi_all.o \
test_sum_rule.o \

View File

@ -25,7 +25,7 @@ SUBROUTINE g_tensor_crystal
current_k
USE lsda_mod, ONLY : current_spin, lsda, isk, nspin
USE becmod, ONLY : becp, calbec
USE symme, ONLY : nsym, s, ftau
USE symme, ONLY : symmatrix
USE scf, ONLY : v, vltot, rho
USE gvect, ONLY : ngm, nr1, nr2, nr3, nrx1, nrx2, &
nrx3, nrxx, nlm, g, ecutwfc, nl
@ -267,7 +267,7 @@ SUBROUTINE g_tensor_crystal
write(stdout, '(5X,''f-sum rule:'')')
write(stdout, '(3(5X,3(F12.6,2X)/))') f_sum
endif
call sym_cart_tensor(f_sum)
call symmatrix(f_sum)
write(stdout, '(5X,''f-sum rule (symmetrized):'')')
write(stdout, '(3(5X,3(F12.6,2X)/))') f_sum
@ -310,7 +310,7 @@ SUBROUTINE g_tensor_crystal
write(stdout, '(5X,''chi_bare pGv (HH) in paratec units:'')')
write(stdout, '(3(5X,3(F12.6,2X)/))') chi_bare_pGv(:,:) / alpha ** 2
endif
call sym_cart_tensor(chi_bare_pGv)
call symmatrix(chi_bare_pGv)
if (iverbosity > 0) then
write(stdout, '(3(5X,3(F12.6,2X)/))') chi_bare_pGv(:,:) / alpha ** 2
endif
@ -322,7 +322,7 @@ SUBROUTINE g_tensor_crystal
write(stdout, '(5X,''chi_bare vGv (VV) in paratec units:'')')
write(stdout, '(3(5X,3(F12.6,2X)/))') chi_bare_vGv(:,:) / alpha ** 2
endif
call sym_cart_tensor(chi_bare_vGv)
call symmatrix(chi_bare_vGv)
if (iverbosity > 0) then
write(stdout, '(3(5X,3(F12.6,2X)/))') chi_bare_vGv(:,:) / alpha ** 2
endif
@ -486,7 +486,7 @@ SUBROUTINE g_tensor_crystal
write (stdout,*)
if (iverbosity > 0) &
write (stdout, '(3(5X,3(F12.4,2X)/),/)' ) delta_g_bare(:,:)
call sym_cart_tensor(delta_g_bare)
call symmatrix(delta_g_bare)
write (stdout, '(3(5X,3(F12.4,2X)/))' ) delta_g_bare(:,:)
write (stdout,*) '**********************************************'
@ -495,7 +495,7 @@ SUBROUTINE g_tensor_crystal
write (stdout,*)
if (iverbosity > 0) &
write ( stdout, '(3(5X,3(F12.4,2X)/),/)' ) delta_g_diamagn(:,:)
call sym_cart_tensor(delta_g_diamagn)
call symmatrix(delta_g_diamagn)
write (stdout, '(3(5X,3(F12.4,2X)/))' ) delta_g_diamagn(:,:)
write (stdout,*) '**********************************************'
@ -504,7 +504,7 @@ SUBROUTINE g_tensor_crystal
write (stdout,*)
if (iverbosity > 0) &
write (stdout, '(3(5X,3(F12.4,2X)/),/)' ) delta_g_paramagn(:,:)
call sym_cart_tensor(delta_g_paramagn)
call symmatrix(delta_g_paramagn)
write (stdout, '(3(5X,3(F12.4,2X)/))' ) delta_g_paramagn(:,:)
write (stdout,*) '**********************************************'
@ -513,7 +513,7 @@ SUBROUTINE g_tensor_crystal
write (stdout,*)
if (iverbosity > 0) &
write (stdout, '(3(5X,3(F12.4,2X)/),/)' ) delta_g_soo(:,:)
call sym_cart_tensor(delta_g_soo)
call symmatrix(delta_g_soo)
write (stdout, '(3(5X,3(F12.4,2X)/))' ) delta_g_soo(:,:)
write (stdout,*) '**********************************************'
@ -522,7 +522,7 @@ SUBROUTINE g_tensor_crystal
write (stdout,*)
if (iverbosity > 0) &
write (stdout, '(3(5X,3(F12.4,2X)/),/)' ) delta_g_soo_2(:,:)
call sym_cart_tensor(delta_g_soo_2)
call symmatrix(delta_g_soo_2)
write (stdout, '(3(5X,3(F12.4,2X)/))' ) delta_g_soo_2(:,:)
write (stdout,*) '**********************************************'
@ -531,7 +531,7 @@ SUBROUTINE g_tensor_crystal
write (stdout,*)
if (iverbosity > 0) &
write (stdout, '(3(5X,3(F12.4,2X)/),/)' ) delta_g_total(:,:)
call sym_cart_tensor(delta_g_total)
call symmatrix(delta_g_total)
write (stdout, '(3(5X,3(F12.4,2X)/))' ) delta_g_total(:,:)
write (stdout,*) '**********************************************'

View File

@ -188,9 +188,6 @@ suscept_crystal.o : ../PW/pwcom.o
suscept_crystal.o : ../PW/symme.o
suscept_crystal.o : gipaw_module.o
suscept_crystal.o : paw_gipaw.o
sym_cart_tensor.o : ../Modules/cell_base.o
sym_cart_tensor.o : ../Modules/kind.o
sym_cart_tensor.o : ../PW/symme.o
symmetrize_field.o : ../Modules/cell_base.o
symmetrize_field.o : ../Modules/fft_base.o
symmetrize_field.o : ../Modules/kind.o
@ -208,6 +205,7 @@ test_sum_rule.o : ../Modules/uspp.o
test_sum_rule.o : ../Modules/wavefunctions.o
test_sum_rule.o : ../PW/buffers.o
test_sum_rule.o : ../PW/pwcom.o
test_sum_rule.o : ../PW/symme.o
test_sum_rule.o : gipaw_module.o
write_tensor_field.o : ../Modules/cell_base.o
write_tensor_field.o : ../Modules/constants.o

View File

@ -23,7 +23,7 @@ SUBROUTINE suscept_crystal
current_k
USE lsda_mod, ONLY : current_spin, lsda, isk
USE becmod, ONLY : becp, calbec
USE symme, ONLY : nsym, s, ftau
USE symme, ONLY : symmatrix
USE parameters, ONLY : lmaxx
USE constants, ONLY : pi
USE gvect, ONLY : ngm, g, ecutwfc
@ -208,7 +208,7 @@ SUBROUTINE suscept_crystal
write(stdout, '(5X,''f-sum rule:'')')
write(stdout, tens_fmt) f_sum
endif
call sym_cart_tensor(f_sum)
call symmatrix (f_sum)
write(stdout, '(5X,''f-sum rule (symmetrized):'')')
write(stdout, tens_fmt) f_sum
@ -231,7 +231,7 @@ SUBROUTINE suscept_crystal
write(stdout, '(5X,''chi_bare pGv (HH) in paratec units:'')')
write(stdout, '(3(5X,3(F12.6,2X)/))') chi_bare_pGv(:,:) / alpha ** 2
endif
call sym_cart_tensor(chi_bare_pGv)
call symmatrix (chi_bare_pGv)
if (iverbosity > 0) then
write(stdout, '(3(5X,3(F12.6,2X)/))') chi_bare_pGv(:,:) / alpha ** 2
endif
@ -243,7 +243,7 @@ SUBROUTINE suscept_crystal
write(stdout, '(5X,''chi_bare vGv (VV) in paratec units:'')')
write(stdout, '(3(5X,3(F12.6,2X)/))') chi_bare_vGv(:,:) / alpha ** 2
endif
call sym_cart_tensor(chi_bare_vGv)
call symmatrix(chi_bare_vGv)
if (iverbosity > 0) then
write(stdout, '(3(5X,3(F12.6,2X)/))') chi_bare_vGv(:,:) / alpha ** 2
endif

View File

@ -1,30 +0,0 @@
!
! Copyright (C) 2001-2005 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 sym_cart_tensor(tens)
!-----------------------------------------------------------------------
!
! ... symmetrize a rank-2 tensor in cartesian coordinates
!
USE kinds, ONLY : DP
USE cell_base, ONLY : at, bg
USE symme, ONLY : s, nsym
IMPLICIT NONE
REAL(DP), INTENT(INOUT) :: tens(3,3)
! cartesian to crystal
call trntns (tens, at, bg, -1)
! symmetrize
call symtns (tens, nsym, s)
! crystal to cartesian
call trntns (tens, at, bg, 1)
END SUBROUTINE sym_cart_tensor

View File

@ -31,6 +31,7 @@ SUBROUTINE test_f_sum_rule
USE gipaw_module, ONLY : nbnd_occ
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
USE symme, ONLY : symmatrix
!-- local variables ----------------------------------------------------
@ -104,7 +105,7 @@ SUBROUTINE test_f_sum_rule
write(stdout, '(5X,''f-sum rule:'')')
write(stdout, '(3(5X,3(F12.6,2X)/))') f_sum(:,:)
call sym_cart_tensor(f_sum)
call symmatrix(f_sum)
write(stdout, '(5X,''f-sum rule (symmetrized):'')')
write(stdout, '(3(5X,3(F12.6,2X)/))') f_sum

View File

@ -38,12 +38,10 @@ subroutine solve_head
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum, mp_barrier, mp_bcast
USE becmod, ONLY : calbec
USE symme, ONLY : nsym, s
USE symme, ONLY : symmatrix
implicit none
real(DP) :: thresh, anorm, averlt, dr2
! thresh: convergence threshold
! anorm : the norm of the error
@ -368,14 +366,14 @@ subroutine solve_head
WRITE( stdout,'(10x,"(",3f15.5," )")') ((epsilon_g(ipol,jpol,i),&
& ipol=1,3),jpol=1,3)
!
call symtns (epsilon_g(:,:,i), nsym, s)
call trntns (epsilon_g(:,:,i), at, bg,-1)
call symmatrix (epsilon_g(:,:,i) )
!
! pass to cartesian axis
!
WRITE( stdout,'(/,10x,"Symmetrized in crystal axis ",/)')
WRITE( stdout,'(/,10x,"Symmetrized in cartesian axis ",/)')
WRITE( stdout,'(10x,"(",3f15.5," )")') ((epsilon_g(ipol,jpol,i),&
& ipol=1,3),jpol=1,3)
call trntns (epsilon_g(:,:,i), at, bg, 1)
!
! add the diagonal part
! and print the result

View File

@ -18,7 +18,7 @@ subroutine dielec()
USE constants, ONLY: fpi, bohr_radius_angs
USE cell_base, ONLY: at, bg, omega
USE klist, ONLY: wk
USE symme, ONLY: s, nsym
USE symme, ONLY: symmatrix
USE wvfct, ONLY: npw, npwx, igk
USE noncollin_module, ONLY : npol
USE kinds, only : DP
@ -74,14 +74,14 @@ subroutine dielec()
! WRITE( stdout,'(10x,"(",3f15.5," )")') ((epsilon(ipol,jpol),
! + ipol=1,3),jpol=1,3)
call symtns (epsilon, nsym, s)
call trntns (epsilon, at, bg,-1)
call symmatrix ( epsilon )
!
! pass to cartesian axis
!
! WRITE( stdout,'(/,10x,"Symmetrized in crystal axis ",/)')
! WRITE( stdout,'(/,10x,"Symmetrized in cartesian axis ",/)')
! WRITE( stdout,'(10x,"(",3f15.5," )")') ((epsilon(ipol,jpol),
! + ipol=1,3),jpol=1,3)
call trntns (epsilon, at, bg, 1)
!
! add the diagonal part
!

View File

@ -18,7 +18,7 @@ subroutine dielec_test
USE cell_base,ONLY : omega, at, bg
USE klist, ONLY : wk
USE wvfct, ONLY : npw, igk
USE symme, ONLY : nsym, s
USE symme, ONLY : symmatrix
USE io_files, ONLY : iunigk
USE wavefunctions_module, ONLY: evc
USE efield_mod, ONLY : epsilon
@ -63,21 +63,19 @@ subroutine dielec_test
call mp_sum ( epsilon, inter_pool_comm )
#endif
!
! symmetrize
! symmetrize (pass to cartesian axis first)
!
! write(6,'(/,10x,''Unsymmetrized in crystal axis '',/)')
! write(6,'(10x,''('',3f15.5,'' )'')') ((epsilon(ipol,jpol), &
! ipol=1,3),jpol=1,3)
call symtns(epsilon,nsym,s)
call trntns(epsilon,at,bg,-1)
call symmatrix(epsilon)
!
! pass to cartesian axis
!
! write(6,'(/,10x,''Symmetrized in crystal axis '',/)')
! write(6,'(/,10x,''Symmetrized in cartesian axis '',/)')
! write(6,'(10x,''('',3f15.5,'' )'')') ((epsilon(ipol,jpol), &
! ipol=1,3),jpol=1,3)
call trntns(epsilon,at,bg,1)
!
! add the diagonal part
!

View File

@ -18,7 +18,7 @@ subroutine polariz ( iw )
USE constants, ONLY : fpi
USE cell_base, ONLY : at, bg, omega
USE klist, ONLY : wk
USE symme, ONLY : s, nsym
USE symme, ONLY : symmatrix
USE wvfct, ONLY : npw, npwx, igk
USE kinds, ONLY : DP
USE efield_mod, ONLY : epsilon
@ -79,15 +79,14 @@ subroutine polariz ( iw )
! WRITE( stdout,'(/,10x,"Unsymmetrized in crystal axis ",/)')
! WRITE( stdout,'(10x,"(",3f15.5," )")') ((epsilon(ipol,jpol),
! + ipol=1,3),jpol=1,3)
call symtns (epsilon, nsym, s)
call trntns (epsilon, at, bg,-1)
call symmatrix ( epsilon )
!
! pass to cartesian axis
!
! WRITE( stdout,'(/,10x,"Symmetrized in crystal axis ",/)')
! WRITE( stdout,'(/,10x,"Symmetrized in cartesian axis ",/)')
! WRITE( stdout,'(10x,"(",3f15.5," )")') ((epsilon(ipol,jpol),
! + ipol=1,3),jpol=1,3)
call trntns (epsilon, at, bg, 1)
!
! add the diagonal part
!

View File

@ -207,7 +207,6 @@ sumkt.o \
summary.o \
symme.o \
symmetrize_at.o \
symtns.o \
tabd.o \
transform_becsum_so.o \
transform_becsum_nc.o \

View File

@ -1441,7 +1441,6 @@ symmetrize_at.o : ../Modules/io_global.o
symmetrize_at.o : ../Modules/kind.o
symmetrize_at.o : pwcom.o
symmetrize_at.o : symme.o
symtns.o : ../Modules/kind.o
tabd.o : ../Modules/kind.o
tabd.o : ../Modules/uspp.o
transform_becsum_nc.o : ../Modules/ions_base.o

View File

@ -22,7 +22,7 @@ SUBROUTINE stres_hub ( sigmah )
hubbard_alpha, U_projection
USE scf, ONLY : v
USE lsda_mod, ONLY : nspin
USE symme, ONLY : s, nsym
USE symme, ONLY : symmatrix
USE io_files, ONLY : prefix, iunocc
USE io_global, ONLY : stdout, ionode
!
@ -91,11 +91,9 @@ SUBROUTINE stres_hub ( sigmah )
END DO
IF (nspin.EQ.1) sigmah(:,:) = 2.d0 * sigmah(:,:)
CALL trntns(sigmah,at,bg,-1)
CALL symtns(sigmah,nsym,s)
CALL trntns(sigmah,at,bg,1)
CALL symmatrix ( sigmah )
!
! Symmetrize the stress tensor with respect to cartesian coordinates
! Impose symmetry s(i,j) = s(j,i) to the stress tensor
! it should NOT be needed, let's do it for safety.
!
DO ipol = 1,3

View File

@ -17,7 +17,7 @@ subroutine stres_knl (sigmanlc, sigmakin)
USE klist, ONLY: nks, xk, ngk
USE io_files, ONLY: iunwfc, nwordwfc, iunigk
USE buffers, ONLY: get_buffer
USE symme, ONLY: s, nsym
USE symme, ONLY: symmatrix
USE wvfct, ONLY: npw, npwx, nbnd, igk, wg
USE control_flags, ONLY: gamma_only
USE noncollin_module, ONLY: noncolin, npol
@ -87,7 +87,6 @@ subroutine stres_knl (sigmanlc, sigmakin)
!
! add the US term from augmentation charge derivatives
!
call addusstres (sigmanlc)
#ifdef __PARA
call mp_sum( sigmakin, intra_pool_comm )
@ -95,8 +94,6 @@ subroutine stres_knl (sigmanlc, sigmakin)
call mp_sum( sigmanlc, intra_pool_comm )
call mp_sum( sigmanlc, inter_pool_comm )
#endif
!
! symmetrize stress
!
do l = 1, 3
do m = 1, l - 1
@ -110,14 +107,12 @@ subroutine stres_knl (sigmanlc, sigmakin)
else
sigmakin(:,:) = e2 / omega * sigmakin(:,:)
end if
call trntns (sigmakin, at, bg, - 1)
call symtns (sigmakin, nsym, s)
call trntns (sigmakin, at, bg, 1)
!
sigmanlc(:,:) = -1.d0 / omega * sigmanlc(:,:)
call trntns (sigmanlc, at, bg, - 1)
call symtns (sigmanlc, nsym, s)
call trntns (sigmanlc, at, bg, 1)
!
! symmetrize stress
!
call symmatrix ( sigmakin )
call symmatrix ( sigmanlc )
deallocate(kfac)
deallocate(gk)

View File

@ -25,7 +25,7 @@ subroutine stress
USE control_flags, ONLY : iverbosity, gamma_only, llondon
USE noncollin_module, ONLY : noncolin
USE funct, ONLY : dft_is_meta, dft_is_gradient
USE symme, ONLY : s, nsym
USE symme, ONLY : symmatrix
USE bp, ONLY : lelfield
USE uspp, ONLY : okvan
USE london_module, ONLY : stres_london
@ -122,12 +122,10 @@ subroutine stress
sigmanlc(:,:) + sigmah(:,:) + sigmael(:,:) + &
sigmaion(:,:) + sigmalon(:,:)
! Resymmetrize the total stress, this should not be strictly necessary,
! Resymmetrize the total stress. This should not be strictly necessary,
! but prevents loss of symmetry in long vc-bfgs runs
CALL trntns(sigma,at,bg,-1)
CALL symtns(sigma,nsym,s)
CALL trntns(sigma,at,bg,1)
CALL symmatrix ( sigma )
!
! write results in Ryd/(a.u.)^3 and in kbar
!

View File

@ -41,7 +41,7 @@ MODULE symme
!
! General-purpose routines
!
PUBLIC :: inverse_s, symscalar, symvector, symtensor
PUBLIC :: inverse_s, symscalar, symvector, symtensor, symmatrix
!
! For symmetrization in reciprocal space (all variables are private)
!
@ -239,6 +239,68 @@ CONTAINS
!
END SUBROUTINE symtensor
!
SUBROUTINE symmatrix ( matr )
!-----------------------------------------------------------------------
! Symmetrize a function f(i,j), i,j=cartesian components
! e.g. : stress, dielectric tensor (in cartesian axis)
!
USE cell_base, ONLY : at, bg
!
IMPLICIT NONE
!
REAL(DP), intent(INOUT) :: matr(3,3)
!
INTEGER :: isym, i,j,k,l
REAL(DP) :: work (3,3)
!
IF (nsym == 1) RETURN
!
! bring matrix to crystal axis
!
work (:,:) = 0.0_dp
DO i = 1, 3
DO j = 1, 3
DO k = 1, 3
DO l = 1, 3
work(i,j) = work(i,j) + matr(k,l) * at(k,i) * at(l,j)
END DO
END DO
END DO
END DO
!
! symmetrize in crystal axis
!
matr (:,:) = 0.0_dp
DO isym = 1, nsym
DO i = 1, 3
DO j = 1, 3
DO k = 1, 3
DO l = 1, 3
matr (i,j) = matr (i,j) + &
s (i,k,isym) * s (j,l,isym) * work (k,l)
END DO
END DO
END DO
END DO
END DO
work (:,:) = matr (:,:) / DBLE(nsym)
!
! bring matrix back to cartesian axis
!
matr (:,:) = 0.0_dp
DO i = 1, 3
DO j = 1, 3
DO k = 1, 3
DO l = 1, 3
matr(i,j) = matr(i,j) + &
work(k,l) * bg(i,k) * bg(j,l)
END DO
END DO
END DO
END DO
!
END SUBROUTINE symmatrix
!
SUBROUTINE sym_rho_init ( gamma_only )
!-----------------------------------------------------------------------
!

View File

@ -1,42 +0,0 @@
!
! Copyright (C) 2001 PWSCF 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 symtns (phi, nsym, s)
!-----------------------------------------------------------------------
!
! symmetrize a tensor in the basis of crystallographic axis
!
USE kinds
implicit none
integer :: nsym, s (3, 3, 48), isym, i, j, k, l
real(DP) :: phi (3, 3), work (3, 3)
external dscal, dcopy
!
if (nsym.eq.1) return
work(:,:) = 0.d0
!
do isym = 1, nsym
do i = 1, 3
do j = 1, 3
do k = 1, 3
do l = 1, 3
work (i, j) = work (i, j) + s (i, k, isym) * s (j, l, isym) &
* phi (k, l)
enddo
enddo
enddo
enddo
enddo
!
call dscal (9, 1.d0 / nsym, work, 1)
call dcopy (9, work, 1, phi, 1)
!
return
end subroutine symtns

View File

@ -19,7 +19,7 @@ subroutine polariz_vdw ( iu )
USE kinds, ONLY : DP
USE phcom
USE cell_base, ONLY : omega
USE symme, ONLY : nsym, s
USE symme, ONLY : symmatrix
USE eff_v, ONLY : nelecr, veff, et_c, dvext, dpsi_eff
USE mp_global, ONLY : intra_pool_comm, inter_pool_comm
USE mp, ONLY : mp_sum
@ -73,15 +73,14 @@ subroutine polariz_vdw ( iu )
! WRITE( stdout,'(/,10x,"Unsymmetrized in crystal axis ",/)')
! WRITE( stdout,'(10x,"(",3f15.5," )")') ((epsilon(ipol,jpol),
! + ipol=1,3),jpol=1,3)
call symtns (epsilon, nsym, s)
call trntns (epsilon, at, bg,-1)
call symmatrix (epsilon)
!
! pass to cartesian axis
!
! WRITE( stdout,'(/,10x,"Symmetrized in crystal axis ",/)')
! WRITE( stdout,'(/,10x,"Symmetrized in cartisian axis ",/)')
! WRITE( stdout,'(10x,"(",3f15.5," )")') ((epsilon(ipol,jpol),
! + ipol=1,3),jpol=1,3)
call trntns (epsilon, at, bg, 1)
!
! add the diagonal part
!