mirror of https://gitlab.com/QEF/q-e.git
92 lines
3.1 KiB
Fortran
92 lines
3.1 KiB
Fortran
!
|
|
! Copyright (C) 2004 Vanderbilt's group at Rutgers University, NJ
|
|
! 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 calc_btq(ql,qr_k,idbes)
|
|
!----------------------------------------------------------------------
|
|
!
|
|
! Calculates the Bessel-transform (or its derivative if idbes=1)
|
|
! of the augmented qrad charges at a given ql point.
|
|
! Rydberg atomic units are used.
|
|
!
|
|
USE kinds, ONLY: DP
|
|
USE atom, ONLY: rgrid
|
|
USE ions_base, ONLY : ntyp => nsp
|
|
USE cell_base, ONLY: omega
|
|
USE constants, ONLY: fpi
|
|
USE uspp_param, ONLY: upf, nbetam, lmaxq
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
REAL(DP) :: ql, qr_k(nbetam,nbetam,lmaxq,ntyp)
|
|
INTEGER :: idbes
|
|
!
|
|
INTEGER :: i, np, l, ilmin, ilmax, iv, jv, ijv, ilast
|
|
REAL(DP) :: qrk
|
|
REAL(DP), ALLOCATABLE :: jl(:), aux(:)
|
|
!
|
|
DO np=1,ntyp
|
|
!
|
|
IF ( upf(np)%tvanp ) THEN
|
|
!
|
|
ALLOCATE ( jl(upf(np)%kkbeta), aux(upf(np)%kkbeta) )
|
|
DO iv =1, upf(np)%nbeta
|
|
DO jv =iv, upf(np)%nbeta
|
|
ijv = jv * (jv-1) / 2 + iv
|
|
ilmin = abs ( upf(np)%lll(iv) - upf(np)%lll(jv) )
|
|
ilmax = upf(np)%lll(iv) + upf(np)%lll(jv)
|
|
! only need to calculate for l=lmin,lmin+2 ...lmax-2,lmax
|
|
DO l = ilmin,ilmax,2
|
|
aux(:) = 0.0_DP
|
|
IF (upf(np)%q_with_l .or. upf(np)%tpawp) then
|
|
aux(1:upf(np)%kkbeta) = &
|
|
upf(np)%qfuncl(1:upf(np)%kkbeta,ijv,l)
|
|
ELSE
|
|
DO i = 1, upf(np)%kkbeta
|
|
IF (rgrid(np)%r(i) >=upf(np)%rinner (l+1) ) THEN
|
|
aux (i) = upf(np)%qfunc(i,ijv)
|
|
ELSE
|
|
ilast = i
|
|
ENDIF
|
|
ENDDO
|
|
IF ( upf(np)%rinner (l+1) > 0.0_dp) &
|
|
CALL setqf ( upf(np)%qfcoef(1,l+1,iv,jv), aux(1), &
|
|
rgrid(np)%r, upf(np)%nqf, l, ilast )
|
|
|
|
ENDIF
|
|
IF (idbes == 1) THEN
|
|
!
|
|
CALL sph_dbes( upf(np)%kkbeta, rgrid(np)%r, ql, l, jl )
|
|
!
|
|
ELSE
|
|
!
|
|
CALL sph_bes( upf(np)%kkbeta, rgrid(np)%r, ql, l, jl )
|
|
!
|
|
ENDIF
|
|
|
|
! jl is the Bessel function (or its derivative) calculated at ql
|
|
! now integrate qfunc*jl*r^2 = Bessel transform of qfunc
|
|
|
|
DO i=1, upf(np)%kkbeta
|
|
aux(i) = jl(i)*aux(i)
|
|
ENDDO
|
|
! if (tlog(np)) then
|
|
CALL simpson(upf(np)%kkbeta,aux,rgrid(np)%rab,qrk)
|
|
|
|
qr_k(iv,jv,l+1,np) = qrk*fpi/omega
|
|
qr_k(jv,iv,l+1,np) = qr_k(iv,jv,l+1,np)
|
|
|
|
END DO
|
|
END DO
|
|
ENDDO
|
|
DEALLOCATE ( aux, jl )
|
|
ENDIF
|
|
ENDDO
|
|
!
|
|
RETURN
|
|
END SUBROUTINE calc_btq
|