quantum-espresso/Modules/sph_dbes.f90

!
! Copyright (C) 2001-2004 PWSCF-FPMD-CP90 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 sph_dbes( MMAX, R, XG, L, DJL )
  !----------------------------------------------------------------------------
  !
  ! ... calculates derivatives of spherical bessel functions  j_l(Gr)
  ! ... with respect to h_alpha,beta (without the factor GAGK(KK,IG)*HTM1)
  ! ... i.e. -x * D(jl(x))/dx
  !
  USE kinds,     ONLY : DP
  USE constants, ONLY : eps8
  !
  IMPLICIT NONE
  !
  INTEGER       :: MMAX, L
  REAL(DP) :: XG
  REAL(DP) :: DJL(MMAX), R(MMAX)
  !
  INTEGER       :: IR
  REAL(DP) :: XRG, XRG2
  !
  !
  IF ( L == 1 ) THEN                      !   S  PART
     IF( XG < eps8 ) THEN
        DO IR=1,MMAX
           DJL(IR) = 0.D0
        END DO
     ELSE
        DJL(1) = 0.D0
        DO IR=2,MMAX
           XRG=R(IR)*XG
           DJL(IR) = SIN(XRG)/XRG-COS(XRG)
        END DO
     ENDIF
  ENDIF
  !
  IF ( L == 2 ) THEN                      !   P  PART
     IF( XG < eps8 ) THEN
        DO IR=1,MMAX
           DJL(IR) = 0.D0
        END DO
     ELSE
        DJL(1) = 0.D0
        DO IR=2,MMAX
           XRG=R(IR)*XG
           DJL(IR) = 2.D0*(SIN(XRG)/XRG-COS(XRG))/XRG - SIN(XRG)
        END DO
     ENDIF
  ENDIF
  !
  IF ( L == 3 ) THEN                      !   D  PART
     IF ( XG < eps8 ) THEN
        DO IR=1,MMAX
           DJL(IR) = 0.D0
        END DO
     ELSE
        DJL(1) = 0.D0
        DO IR=2,MMAX
           XRG=R(IR)*XG
           DJL(IR) = ( SIN(XRG)*(9.D0/(XRG*XRG)-4.D0) - &
                       9.D0*COS(XRG)/XRG ) /XRG + COS(XRG)
        END DO
     END IF
  END IF
  !
  IF ( L == 4 ) THEN                      !   F  PART
     IF ( XG < eps8 ) THEN
        DO IR=1,MMAX
           DJL(IR) = 0.D0
        END DO
     ELSE
        DJL(1) = 0.D0
        DO IR=2,MMAX
           XRG=R(IR)*XG
           XRG2=XRG*XRG
           DJL(IR) = SIN(XRG)*(60.D0/(XRG2*XRG2)-27.D0/XRG2+1.d0) - &
                     COS(XRG)*(60.D0/XRG2-7.D0)/XRG
        END DO
     END IF
  END IF
  !
  IF ( L == 5 ) THEN                      !   G  PART
     IF ( XG < eps8 ) THEN
        DO IR=1,MMAX
           DJL(IR) = 0.D0
        END DO
     ELSE
        DJL(1) = 0.D0
        DO IR=2,MMAX
           XRG=R(IR)*XG
           XRG2=XRG*XRG
           DJL(IR) = SIN(XRG)*(525.D0/(XRG2*XRG2)-240.D0/XRG2+11.D0)/XRG - &
                     COS(XRG)*(525.D0/(XRG2*XRG2)-65.D0/XRG2+1.D0)
        END DO
     END IF
  END IF
  !
  IF ( L <= 0 .OR. L >= 6 ) &
     CALL errore( 'sph_dbes', ' L NOT PROGRAMMED, L= ',L )
  !
  RETURN
  !
END SUBROUTINE sph_dbes

!
SUBROUTINE sph_dbes1 ( nr, r, xg, l, jl, djl )
  !
  ! calculates x*dj_l(x)/dx using the recursion formula
  !    dj_l(x)/dx = l/x*j_l(x) -  j_(l+1)(x)
  ! for l=0, and for l>0 :
  !    dj_l(x)/dx = j_(l-1)(x) - (l+1)/x *  j_l(x)
  ! requires j_l(r) in input
  !
  USE kinds,     ONLY : DP
  USE constants, ONLY : eps8
  !
  IMPLICIT NONE
  INTEGER, INTENT(IN) :: l, nr
  REAL (DP), INTENT(IN) :: xg, jl(nr), r(nr)
  REAL (DP), INTENT(OUT):: djl(nr)
  !
  if ( xg < eps8 ) then
     !
     ! special case q=0
     ! note that x*dj_l(x)/dx = 0 for x = 0
     !
     djl(:) = 0.0d0
  else
     !
     if ( l > 0 ) then
        call sph_bes ( nr, r, xg, l-1, djl )
        djl(:) = djl(:) * (xg * r(:) ) - (l+1) * jl(:)
     else if ( l == 0 ) then
        call sph_bes ( nr, r, xg, l+1, djl )
        djl(:) = - djl(:) * (xg * r(:) )
     else
        call errore('sph_dbes','l < 0 not implemented', abs(l) )
     end if
  end if
  !
end SUBROUTINE sph_dbes1