2009-09-18 19:00:43 +08:00
|
|
|
!
|
2016-02-07 23:10:04 +08:00
|
|
|
! Copyright (C) 2001-2016 Quantum ESPRESSO group
|
2015-03-23 21:31:01 +08:00
|
|
|
! 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 .
|
|
|
|
!
|
|
|
|
!-----------------------------------------------------------------------
|
2011-05-03 21:47:30 +08:00
|
|
|
FUNCTION lr_dot(x,y)
|
2009-09-18 19:00:43 +08:00
|
|
|
!---------------------------------------------------------------------
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
|
|
|
! This subroutine calculates a dot product of the conjugate
|
|
|
|
! of a complex vector x and a complex vector y
|
|
|
|
! (sums over the bands and k-points).
|
|
|
|
!
|
2009-09-18 19:00:43 +08:00
|
|
|
! Brent Walker, ICTP, 2004
|
2015-03-23 21:31:01 +08:00
|
|
|
! Modified by Osman Baris Malcioglu, SISSA, 2009
|
|
|
|
! Modified by Iurii Timrov, SISSA, 2013 (extension to EELS)
|
2020-07-12 16:21:16 +08:00
|
|
|
! Modified by PG, 2020: replacement of zdotc with dot_product
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
USE kinds, ONLY : dp
|
2015-03-23 21:31:01 +08:00
|
|
|
USE io_global, ONLY : stdout
|
2016-02-09 22:31:51 +08:00
|
|
|
USE klist, ONLY : nks, xk, wk, ngk
|
2011-05-03 21:47:30 +08:00
|
|
|
USE lsda_mod, ONLY : nspin
|
2016-06-13 01:26:36 +08:00
|
|
|
USE wvfct, ONLY : npwx,nbnd,wg
|
2016-01-15 00:45:17 +08:00
|
|
|
USE gvecw, ONLY : gcutw
|
2011-05-03 21:47:30 +08:00
|
|
|
USE control_flags, ONLY : gamma_only
|
2015-03-23 21:31:01 +08:00
|
|
|
USE gvect, ONLY : gstart, ngm, g
|
2011-05-03 21:47:30 +08:00
|
|
|
USE mp, ONLY : mp_sum
|
2013-02-01 00:03:51 +08:00
|
|
|
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
|
2015-03-23 21:31:01 +08:00
|
|
|
USE noncollin_module, ONLY : noncolin, npol
|
2016-01-20 06:39:03 +08:00
|
|
|
USE control_lr, ONLY : nbnd_occ
|
2016-06-13 01:26:36 +08:00
|
|
|
USE qpoint, ONLY : nksq
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
IMPLICIT NONE
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
Some optimization of the TDDFPT code. Namely, the routine lr_apply_liouvillian(_eels) was giving sevc1_new on the output, but it was never used. So, it was removed. Also, some save of RAM due to the fact that there were sevc1_new(:,:,:,1) and sevc1_new(:,:,:,2), but only one of them was used (and computed) in lr_lanczos. Hence, I defined a new array sevc1_new(:,:,:), which replaces the former one and hence save RAM.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12227 c92efa57-630b-4861-b058-cf58834340f0
2016-03-20 20:12:38 +08:00
|
|
|
COMPLEX(kind=dp) :: x(npwx*npol,nbnd,nksq), &
|
|
|
|
y(npwx*npol,nbnd,nksq)
|
2011-05-03 21:47:30 +08:00
|
|
|
COMPLEX(kind=dp) :: lr_dot
|
2015-03-23 21:31:01 +08:00
|
|
|
REAL(kind=dp) :: temp_gamma, degspin
|
|
|
|
INTEGER :: ibnd, ik
|
|
|
|
REAL(kind=dp), EXTERNAL :: DDOT
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2015-03-23 21:31:01 +08:00
|
|
|
CALL start_clock ('lr_dot')
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2015-03-23 21:31:01 +08:00
|
|
|
lr_dot = (0.0d0,0.0d0)
|
|
|
|
temp_gamma = 0.0d0
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2015-03-23 21:31:01 +08:00
|
|
|
IF (nspin==2) THEN
|
|
|
|
degspin = 1.0d0
|
|
|
|
ELSE
|
|
|
|
degspin = 2.0d0
|
|
|
|
ENDIF
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2019-07-30 15:33:13 +08:00
|
|
|
IF (gamma_only) THEN
|
|
|
|
!
|
|
|
|
CALL lr_dot_gamma()
|
|
|
|
lr_dot = cmplx(temp_gamma,0.0d0,dp)
|
|
|
|
!
|
|
|
|
ELSEIF (noncolin) THEN
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
2019-07-30 15:33:13 +08:00
|
|
|
degspin = 1.0d0
|
|
|
|
CALL lr_dot_k_nc()
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
ELSE
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
2019-07-30 15:33:13 +08:00
|
|
|
CALL lr_dot_k()
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
ENDIF
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2015-03-23 21:31:01 +08:00
|
|
|
lr_dot = lr_dot/degspin
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
CALL stop_clock ('lr_dot')
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
RETURN
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
CONTAINS
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
SUBROUTINE lr_dot_gamma
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
|
|
|
! Optical case: gamma_only
|
|
|
|
! Noncollinear case is not implemented
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
DO ibnd=1,nbnd
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2016-02-09 22:31:51 +08:00
|
|
|
temp_gamma = temp_gamma + 2.D0*wg(ibnd,1)*DDOT(2*ngk(1),x(:,ibnd,1),1,y(:,ibnd,1),1)
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
|
|
|
! G=0 has been accounted twice, so we subtract one contribution.
|
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
IF (gstart==2) temp_gamma = temp_gamma - wg(ibnd,1)*dble(x(1,ibnd,1))*dble(y(1,ibnd,1))
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
ENDDO
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2016-09-18 22:57:34 +08:00
|
|
|
#if defined(__MPI)
|
2013-02-01 00:03:51 +08:00
|
|
|
CALL mp_sum(temp_gamma, intra_bgrp_comm)
|
2009-09-18 19:00:43 +08:00
|
|
|
#endif
|
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
RETURN
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
END SUBROUTINE lr_dot_gamma
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2019-07-30 15:33:13 +08:00
|
|
|
SUBROUTINE lr_dot_k_nc
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2019-07-30 15:33:13 +08:00
|
|
|
! Noncollinear case
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
2019-07-30 15:33:13 +08:00
|
|
|
USE qpoint, ONLY : ikks, ikqs
|
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
INTEGER :: ios
|
|
|
|
INTEGER :: ik, &
|
|
|
|
ikk, & ! index of the point k
|
|
|
|
ikq, & ! index of the point k+q
|
|
|
|
npwq ! number of the plane-waves at point k+q
|
|
|
|
!
|
|
|
|
DO ik = 1, nksq
|
|
|
|
!
|
|
|
|
ikk = ikks(ik)
|
|
|
|
ikq = ikqs(ik)
|
|
|
|
npwq = ngk(ikq)
|
|
|
|
!
|
|
|
|
DO ibnd = 1, nbnd_occ(ikk)
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2020-07-12 16:16:22 +08:00
|
|
|
lr_dot = lr_dot + wk(ikk) * dot_product(x(:,ibnd,ik),y(:,ibnd,ik))
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
ENDDO
|
2019-07-30 15:33:13 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
ENDDO
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
2016-09-18 22:57:34 +08:00
|
|
|
#if defined(__MPI)
|
2019-07-30 15:33:13 +08:00
|
|
|
CALL mp_sum(lr_dot, inter_pool_comm)
|
|
|
|
CALL mp_sum(lr_dot, intra_bgrp_comm)
|
2009-09-18 19:00:43 +08:00
|
|
|
#endif
|
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
RETURN
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
2019-07-30 15:33:13 +08:00
|
|
|
END SUBROUTINE lr_dot_k_nc
|
2009-09-18 19:00:43 +08:00
|
|
|
!
|
2019-07-30 15:33:13 +08:00
|
|
|
SUBROUTINE lr_dot_k
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
2019-07-30 15:33:13 +08:00
|
|
|
! collinear k point case
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
2016-06-13 01:26:36 +08:00
|
|
|
USE qpoint, ONLY : ikks, ikqs
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
2016-06-13 01:26:36 +08:00
|
|
|
IMPLICIT NONE
|
|
|
|
INTEGER :: ios
|
|
|
|
INTEGER :: ik, &
|
|
|
|
ikk, & ! index of the point k
|
|
|
|
ikq, & ! index of the point k+q
|
|
|
|
npwq ! number of the plane-waves at point k+q
|
|
|
|
!
|
2015-03-23 21:31:01 +08:00
|
|
|
DO ik = 1, nksq
|
|
|
|
!
|
2016-06-13 01:26:36 +08:00
|
|
|
ikk = ikks(ik)
|
|
|
|
ikq = ikqs(ik)
|
|
|
|
npwq = ngk(ikq)
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
|
|
|
DO ibnd = 1, nbnd_occ(ikk)
|
|
|
|
!
|
2020-07-12 16:16:22 +08:00
|
|
|
lr_dot = lr_dot + wk(ikk) * &
|
|
|
|
dot_product( x(1:npwq,ibnd,ik), y(1:npwq,ibnd,ik) )
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
|
|
|
ENDDO
|
|
|
|
!
|
|
|
|
ENDDO
|
|
|
|
!
|
2016-09-18 22:57:34 +08:00
|
|
|
#if defined(__MPI)
|
2015-03-23 21:31:01 +08:00
|
|
|
CALL mp_sum(lr_dot, inter_pool_comm)
|
|
|
|
CALL mp_sum(lr_dot, intra_bgrp_comm)
|
|
|
|
#endif
|
|
|
|
!
|
|
|
|
RETURN
|
|
|
|
!
|
2019-07-30 15:33:13 +08:00
|
|
|
END SUBROUTINE lr_dot_k
|
2015-03-23 21:31:01 +08:00
|
|
|
!
|
2011-05-03 21:47:30 +08:00
|
|
|
END FUNCTION lr_dot
|
2009-09-18 19:00:43 +08:00
|
|
|
!-----------------------------------------------------------------------
|
2016-02-07 23:10:04 +08:00
|
|
|
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
!! Debugging subroutines
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
|
|
|
|
SUBROUTINE check_vector_gamma (x)
|
|
|
|
!----------------------------------------------------------------------------
|
|
|
|
! Checks the inner product for a given vector, and its imaginary and real component
|
|
|
|
! input: evc
|
|
|
|
! output : screen output
|
|
|
|
!
|
|
|
|
USE kinds, ONLY : dp
|
|
|
|
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
|
|
|
|
USE mp, ONLY : mp_sum
|
2016-02-09 22:31:51 +08:00
|
|
|
USE klist , ONLY : ngk
|
2016-02-07 23:10:04 +08:00
|
|
|
USE gvect, ONLY : gstart
|
|
|
|
USE io_global, ONLY : stdout
|
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
!input/output
|
|
|
|
COMPLEX(kind=dp),INTENT(in) :: x(:)
|
|
|
|
!
|
|
|
|
! local variables
|
|
|
|
!
|
|
|
|
REAL(kind=dp) :: temp_gamma
|
|
|
|
REAL(kind=dp), EXTERNAL :: DDOT
|
|
|
|
!
|
2016-02-09 22:31:51 +08:00
|
|
|
temp_gamma = 2.D0*DDOT(2*ngk(1),x(:),1,x(:),1)
|
2016-02-07 23:10:04 +08:00
|
|
|
!
|
|
|
|
IF (gstart==2) temp_gamma = temp_gamma - dble(x(1))*dble(x(1))
|
|
|
|
!
|
2016-09-18 22:57:34 +08:00
|
|
|
#if defined(__MPI)
|
2016-02-07 23:10:04 +08:00
|
|
|
CALL mp_sum(temp_gamma, intra_bgrp_comm)
|
|
|
|
#endif
|
|
|
|
!
|
|
|
|
WRITE(stdout,'("<x> = ",E15.8)') temp_gamma
|
|
|
|
!
|
|
|
|
RETURN
|
|
|
|
!
|
|
|
|
END SUBROUTINE check_vector_gamma
|
|
|
|
|
|
|
|
SUBROUTINE check_vector_f (x)
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
! Checks the inner product for a given vector, and its imaginary and real component
|
|
|
|
! input: evc
|
|
|
|
! output: screen output
|
|
|
|
!
|
|
|
|
USE kinds, ONLY : dp
|
|
|
|
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
|
|
|
|
USE mp, ONLY : mp_sum
|
2016-02-09 22:31:51 +08:00
|
|
|
USE klist , ONLY : ngk
|
2016-02-07 23:10:04 +08:00
|
|
|
USE gvect, ONLY : gstart
|
|
|
|
USE io_global, ONLY : stdout
|
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
!input/output
|
|
|
|
COMPLEX(kind=dp),INTENT(in) :: x(:)
|
|
|
|
!
|
|
|
|
! local variables
|
|
|
|
!
|
|
|
|
COMPLEX(kind=dp) :: temp_f
|
|
|
|
!
|
2020-07-12 16:21:16 +08:00
|
|
|
temp_f = dot_product( x(1:ngk(1)), x(1:ngk(1)) )
|
2016-02-07 23:10:04 +08:00
|
|
|
!
|
2016-09-18 22:57:34 +08:00
|
|
|
#if defined(__MPI)
|
2016-02-07 23:10:04 +08:00
|
|
|
CALL mp_sum(temp_f, intra_bgrp_comm)
|
|
|
|
#endif
|
|
|
|
!
|
|
|
|
WRITE(stdout,'("<x> = ",2E15.8,1X)') temp_f
|
|
|
|
!
|
|
|
|
RETURN
|
|
|
|
!
|
|
|
|
END SUBROUTINE check_vector_f
|
|
|
|
|
|
|
|
SUBROUTINE check_all_bands_gamma (x,sx,nbnd1,nbnd2)
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
!
|
2017-10-26 04:08:57 +08:00
|
|
|
! Checks all bands of given KS states for orthogonality
|
2016-02-07 23:10:04 +08:00
|
|
|
! input: evc and sevc
|
|
|
|
! output : screen output
|
|
|
|
!
|
|
|
|
USE kinds, ONLY : dp
|
|
|
|
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
|
|
|
|
USE mp, ONLY : mp_sum
|
2016-02-09 22:31:51 +08:00
|
|
|
USE klist , ONLY : ngk
|
2016-02-07 23:10:04 +08:00
|
|
|
USE io_global, ONLY : stdout
|
|
|
|
USE gvect, ONLY : gstart
|
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
!input/output
|
|
|
|
INTEGER, INTENT(in) :: nbnd1,nbnd2 !Total number of bands for x and sx
|
|
|
|
COMPLEX(kind=dp),INTENT(in) :: x(:,:), sx(:,:)
|
|
|
|
!
|
|
|
|
! local variables
|
|
|
|
!
|
|
|
|
INTEGER :: ibnd, jbnd
|
|
|
|
REAL(kind=dp) :: temp_gamma
|
|
|
|
REAL(kind=dp), EXTERNAL :: DDOT
|
|
|
|
!
|
|
|
|
DO ibnd=1,nbnd1
|
|
|
|
DO jbnd=ibnd,nbnd2
|
|
|
|
!
|
2016-02-09 22:31:51 +08:00
|
|
|
temp_gamma = 2.D0*DDOT(2*ngk(1),x(:,ibnd),1,sx(:,jbnd),1)
|
2016-02-07 23:10:04 +08:00
|
|
|
!
|
|
|
|
IF (gstart==2) temp_gamma = temp_gamma - dble(x(1,ibnd))*dble(sx(1,jbnd))
|
|
|
|
!
|
2016-09-18 22:57:34 +08:00
|
|
|
#if defined(__MPI)
|
2016-02-07 23:10:04 +08:00
|
|
|
CALL mp_sum(temp_gamma, intra_bgrp_comm)
|
|
|
|
#endif
|
|
|
|
!
|
|
|
|
WRITE(stdout,'("<x,",I02,"|S|x,",I02,"> =",E15.8)') ibnd,jbnd,temp_gamma
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
|
|
|
!
|
|
|
|
RETURN
|
|
|
|
!
|
|
|
|
END SUBROUTINE check_all_bands_gamma
|
|
|
|
|
|
|
|
SUBROUTINE check_density_gamma (rx,nbnd)
|
|
|
|
!---------------------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
! Checks the contirbution of a given function transformed into real space
|
|
|
|
! input: revc
|
|
|
|
! output : screen output
|
|
|
|
!
|
|
|
|
USE kinds, ONLY : dp
|
|
|
|
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
|
|
|
|
USE mp, ONLY : mp_sum
|
|
|
|
USE wvfct, ONLY : wg
|
|
|
|
USE fft_base, ONLY : dfftp
|
|
|
|
USE io_global, ONLY : stdout
|
|
|
|
USE cell_base, ONLY : omega
|
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
!input/output
|
|
|
|
INTEGER, INTENT(in) :: nbnd !Total number of bands for x and sx
|
|
|
|
COMPLEX(kind=dp),INTENT(in) :: rx(:,:)
|
|
|
|
!
|
|
|
|
! local variables
|
|
|
|
!
|
|
|
|
INTEGER :: ibnd
|
|
|
|
REAL(kind=dp) :: temp_gamma,w1,w2
|
|
|
|
!
|
|
|
|
DO ibnd=1,nbnd,2
|
|
|
|
w1 = wg(ibnd,1)/omega
|
|
|
|
!
|
|
|
|
IF (ibnd<nbnd) THEN
|
|
|
|
w2 = wg(ibnd+1,1)/omega
|
|
|
|
ELSE
|
|
|
|
w2 = w1
|
|
|
|
ENDIF
|
|
|
|
temp_gamma = sum(w1*dble(rx(1:dfftp%nnr,ibnd))*dble(rx(1:dfftp%nnr,ibnd))&
|
|
|
|
+ w2*aimag(rx(1:dfftp%nnr,ibnd))*aimag(rx(1:dfftp%nnr,ibnd)))
|
2016-09-18 22:57:34 +08:00
|
|
|
#if defined(__MPI)
|
2016-02-07 23:10:04 +08:00
|
|
|
CALL mp_sum(temp_gamma, intra_bgrp_comm)
|
|
|
|
#endif
|
|
|
|
WRITE(stdout,'("Contribution of bands ",I02," and ",I02," to total density",E15.8)') ibnd,ibnd+1,temp_gamma
|
|
|
|
!
|
|
|
|
ENDDO
|
|
|
|
!
|
|
|
|
RETURN
|
|
|
|
!
|
|
|
|
END SUBROUTINE check_density_gamma
|