576 lines
26 KiB
Fortran
576 lines
26 KiB
Fortran
! Module contains the spherical harmonics up to l=5 m=-l,..,0,..,l listed on https://en.wikipedia.org/wiki/Table_of_spherical_harmonics from 19.07.2022
|
|
! the functions are implementde by calling switch case function for given m or l value and return the corresdpondig value for given theta and phi
|
|
! the functions are split for diffrent l values and are named by P_lm.
|
|
! example for l=1 and m=-1 the realpart of the spherical harmonic for given theta and phi
|
|
! is returned by calling Re_Y_lm(1,-1,theta,phi) which itself calls the corresponding function P_1m(m,theta) and multilpies it by cos(m*phi) to account for the real part of exp(m*phi*i)
|
|
! Attention the legendre polynoms are shifted to account for the missing zero order term in spherical harmonic expansions
|
|
module sphericalharmonics_mod
|
|
use accuracy_constants, only: dp, idp
|
|
implicit none
|
|
real(kind=dp), parameter :: PI = 4.0_dp * atan( 1.0_dp )
|
|
contains
|
|
!----------------------------------------------------------------------------------------------------
|
|
function Y_lm( l , m , theta , phi ) result( y )
|
|
integer(kind=idp), intent( in ) :: l , m
|
|
real(kind=dp), intent( in ) :: theta , phi
|
|
real(kind=dp) y
|
|
character(len=70) :: errmesg
|
|
select case ( l )
|
|
case (1)
|
|
y = Y_1m( m , theta , phi )
|
|
case (2)
|
|
y = Y_2m( m , theta , phi )
|
|
case (3)
|
|
y = Y_3m( m , theta , phi )
|
|
case (4)
|
|
y = Y_4m( m , theta , phi )
|
|
case (5)
|
|
y = Y_5m( m , theta , phi )
|
|
case default
|
|
write(errmesg,'(A,i0)')&
|
|
&'order of spherical harmonics not implemented', l
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
end select
|
|
end function Y_lm
|
|
!----------------------------------------------------------------------------------------------------
|
|
function Re_Y_lm( l , m , theta , phi ) result( y )
|
|
integer(kind=idp), intent( in ) :: l , m
|
|
real(kind=dp), intent( in ) :: theta , phi
|
|
real(kind=dp) y
|
|
character(len=70) :: errmesg
|
|
select case ( l )
|
|
case (1)
|
|
y = P_1m( m , theta ) * cos(m*phi)
|
|
case (2)
|
|
y = P_2m( m , theta ) * cos(m*phi)
|
|
case (3)
|
|
y = P_3m( m , theta ) * cos(m*phi)
|
|
case (4)
|
|
y = P_4m( m , theta ) * cos(m*phi)
|
|
case (5)
|
|
y = P_5m( m , theta ) * cos(m*phi)
|
|
case (6)
|
|
y = P_6m( m , theta ) * cos(m*phi)
|
|
case default
|
|
write(errmesg,'(A,i0)')&
|
|
&'order of spherical harmonics not implemented', l
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
end select
|
|
end function Re_Y_lm
|
|
!----------------------------------------------------------------------------------------------------
|
|
function Im_Y_lm( l , m , theta , phi ) result( y )
|
|
integer(kind=idp), intent( in ) :: l , m
|
|
real(kind=dp), intent( in ) :: theta , phi
|
|
real(kind=dp) y
|
|
character(len=70) :: errmesg
|
|
select case ( l )
|
|
case (1)
|
|
y = P_1m( m , theta ) * sin(m*phi)
|
|
case (2)
|
|
y = P_2m( m , theta ) * sin(m*phi)
|
|
case (3)
|
|
y = P_3m( m , theta ) * sin(m*phi)
|
|
case (4)
|
|
y = P_4m( m , theta ) * sin(m*phi)
|
|
case (5)
|
|
y = P_5m( m , theta ) * sin(m*phi)
|
|
case (6)
|
|
y = P_6m( m , theta ) * sin(m*phi)
|
|
case default
|
|
write(errmesg,'(a,i0)')&
|
|
&'order of spherical harmonics not implemented',l
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
end select
|
|
end function Im_Y_lm
|
|
|
|
!----------------------------------------------------------------------------------------------------
|
|
!----------------------------------------------------------------------------------------------------
|
|
function Y_1m( m , theta , phi ) result( y )
|
|
integer(kind=idp),intent( in ):: m
|
|
real(kind=dp),intent( in ):: theta , phi
|
|
real(kind=dp) y
|
|
character(len=70) :: errmesg
|
|
select case ( m )
|
|
case (-1)
|
|
y = 0.5_dp*sqrt(3.0_dp/(PI*2.0_dp))*sin(theta)*cos(phi)
|
|
|
|
case (0)
|
|
y = 0.5_dp*sqrt(3.0_dp/PI)*cos(theta)
|
|
|
|
case (1)
|
|
y = -0.5_dp*sqrt(3.0_dp/(PI*2.0_dp))*sin(theta)*cos(phi)
|
|
|
|
case default
|
|
write(errmesg,'(a,i0)') 'in y_1m given m not logic, ', m
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
end select
|
|
end function Y_1m
|
|
!----------------------------------------------------------------------------------------------------
|
|
function Y_2m(m,theta,phi) result(y)
|
|
integer(kind=idp),intent(in):: m
|
|
real(kind=dp),intent(in):: theta,phi
|
|
real(kind=dp) y
|
|
character(len=70) :: errmesg
|
|
select case (m)
|
|
case (-2)
|
|
y=0.25_dp*sqrt(15.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2*cos(2.0_dp*phi)
|
|
|
|
case (-1)
|
|
y=0.5_dp*sqrt(15.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)*cos(theta)*cos(phi)
|
|
|
|
case (0)
|
|
y=0.25_dp*sqrt(5.0_dp/PI)&
|
|
&*(3.0_dp*cos(theta)**2-1.0_dp)
|
|
|
|
case (1)
|
|
y=-0.5_dp*sqrt(15.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)*cos(theta)*cos(phi)
|
|
|
|
case (2)
|
|
y=0.25_dp*sqrt(15.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2*cos(2.0_dp*phi)
|
|
|
|
case default
|
|
write(errmesg,'(A,i0)')'in y_2m given m not logic, ', m
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
|
|
end select
|
|
end function Y_2m
|
|
!----------------------------------------------------------------------------------------------------
|
|
function Y_3m(m,theta,phi) result(y)
|
|
integer(kind=idp), intent(in) :: m
|
|
real(kind=dp), intent(in) :: theta,phi
|
|
real(kind=dp) y
|
|
character(len=70) :: errmesg
|
|
select case (m)
|
|
case (-3)
|
|
y=0.125_dp*sqrt(35.0_dp/PI)&
|
|
&*sin(theta)**3*cos(3.0_dp*phi)
|
|
|
|
case (-2)
|
|
y=0.25_dp*sqrt(105.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2*cos(theta)*cos(2.0_dp*phi)
|
|
|
|
case (-1)
|
|
y=0.125_dp*sqrt(21.0_dp/(PI))&
|
|
&*sin(theta)*(5.0_dp*cos(theta)**2-1.0_dp)*cos(phi)
|
|
|
|
case (0)
|
|
y=0.25_dp*sqrt(7.0_dp/PI)&
|
|
&*(5.0_dp*cos(theta)**3-3.0_dp*cos(theta))
|
|
|
|
case (1)
|
|
y=-0.125_dp*sqrt(21.0_dp/(PI))&
|
|
&*sin(theta)*(5.0_dp*cos(theta)**2-1.0_dp)*cos(phi)
|
|
|
|
case (2)
|
|
y=0.25_dp*sqrt(105.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2*cos(theta)*cos(2.0_dp*phi)
|
|
|
|
case (3)
|
|
y=-0.125_dp*sqrt(35.0_dp/PI)&
|
|
&*sin(theta)**3*cos(3.0_dp*phi)
|
|
|
|
case default
|
|
write(errmesg,'(A,i0)')'in y_3m given m not logic, ', m
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
|
|
end select
|
|
end function Y_3m
|
|
!----------------------------------------------------------------------------------------------------
|
|
function Y_4m(m,theta,phi) result(y)
|
|
integer(kind=idp), intent(in) :: m
|
|
real(kind=dp), intent(in) :: theta,phi
|
|
real(kind=dp) y
|
|
character(len=70) :: errmesg
|
|
select case (m)
|
|
case (-4)
|
|
y=(3.0_dp/16.0_dp)*sqrt(35.0_dp/2.0_dp*PI)&
|
|
&*sin(theta)**4*cos(4.0_dp*phi)
|
|
|
|
case (-3)
|
|
y=0.375_dp*sqrt(35.0_dp/PI)&
|
|
&*sin(theta)**3*cos(theta)*cos(3.0_dp*phi)
|
|
|
|
case (-2)
|
|
y=0.375_dp*sqrt(5.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2&
|
|
&*(7.0_dp*cos(theta)**2-1)*cos(2.0_dp*phi)
|
|
|
|
case (-1)
|
|
y=0.375_dp*sqrt(5.0_dp/(PI))&
|
|
&*sin(theta)*(7.0_dp*cos(theta)**3&
|
|
&-3.0_dp*cos(theta))*cos(phi)
|
|
|
|
case (0)
|
|
y=(3.0_dp/16.0_dp)/sqrt(PI)&
|
|
&*(35.0_dp*cos(theta)**4&
|
|
&-30.0_dp*cos(theta)**2+3.0_dp)
|
|
|
|
case (1)
|
|
y=-0.375_dp*sqrt(5.0_dp/(PI))&
|
|
&*sin(theta)*(7.0_dp*cos(theta)**3&
|
|
&-3.0_dp*cos(theta))*cos(phi)
|
|
|
|
case (2)
|
|
y=0.375_dp*sqrt(5.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2*(7.0_dp*cos(theta)**2-1.0_dp)&
|
|
&*cos(2*phi)
|
|
|
|
case (3)
|
|
y=-0.375_dp*sqrt(35.0_dp/PI)&
|
|
&*sin(theta)**3*cos(theta)*cos(3.0_dp*phi)
|
|
|
|
case (4)
|
|
y=(3.0_dp/16.0_dp)*sqrt(35.0_dp/2.0_dp*PI)&
|
|
&*sin(theta)**4*cos(4.0_dp*phi)
|
|
|
|
case default
|
|
write(errmesg,'(a,i0)')'in y_4m given m not logic, ', m
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
|
|
end select
|
|
end function Y_4m
|
|
!----------------------------------------------------------------------------------------------------
|
|
function Y_5m(m,theta,phi) result(y)
|
|
integer(kind=idp), intent(in) :: m
|
|
real(kind=dp), intent(in) :: theta,phi
|
|
real(kind=dp) y
|
|
character(len=70) :: errmesg
|
|
select case (m)
|
|
case (-5)
|
|
y=(3.0_dp/32.0_dp)*sqrt(77.0_dp/PI)&
|
|
&*sin(theta)**5*cos(5*phi)
|
|
|
|
case (-4)
|
|
y=(3.0_dp/16.0_dp)*sqrt(385.0_dp/2.0_dp*PI)&
|
|
&*sin(theta)**4*cos(theta)*cos(4*phi)
|
|
|
|
case (-3)
|
|
y=(1.0_dp/32.0_dp)*sqrt(385.0_dp/PI)&
|
|
&*sin(theta)**3*(9*cos(theta)**2-1.0_dp)*cos(3*phi)
|
|
|
|
case (-2)
|
|
y=0.125*sqrt(1155.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2*(3*cos(theta)**3-cos(theta))*cos(2*phi)
|
|
|
|
case (-1)
|
|
y=(1.0_dp/16.0_dp)*sqrt(165.0_dp/(2.0_dp*PI))&
|
|
&*sin(theta)*(21.0_dp*cos(theta)**4&
|
|
&-14.0_dp*cos(theta)**2+1.0_dp)*cos(phi)
|
|
|
|
case (0)
|
|
y=(1.0_dp/16.0_dp)/sqrt(11.0_dp/PI)&
|
|
&*(63.0_dp*cos(theta)**5-70.0_dp*cos(theta)**3&
|
|
&+15.0_dp*cos(theta))
|
|
|
|
case (1)
|
|
y=(-1.0_dp/16.0_dp)*sqrt(165.0_dp/(2.0_dp*PI))&
|
|
&*sin(theta)*(21.0_dp*cos(theta)**4&
|
|
&-14.0_dp*cos(theta)**2+1.0_dp)*cos(phi)
|
|
|
|
case (2)
|
|
y=0.125*sqrt(1155.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2*(3*cos(theta)**3-cos(theta))*cos(2*phi)
|
|
|
|
case (3)
|
|
y=(-1.0_dp/32.0_dp)*sqrt(385.0_dp/PI)&
|
|
&*sin(theta)**3*(9.0_dp*cos(theta)**2-1.0_dp)&
|
|
&*cos(3.0_dp*phi)
|
|
|
|
case (4)
|
|
y=(3.0_dp/16.0_dp)*sqrt(385.0_dp/2.0_dp*PI)&
|
|
&*sin(theta)**4*cos(theta)*cos(4.0_dp*phi)
|
|
|
|
case (5)
|
|
y=(-3.0_dp/32.0_dp)*sqrt(77.0_dp/PI)&
|
|
&*sin(theta)**5*cos(5.0_dp*phi)
|
|
|
|
case default
|
|
write(errmesg,'(A,i0)')'in y_5m given m not logic, ', m
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
|
|
end select
|
|
end function Y_5m
|
|
!----------------------------------------------------------------------------------------------------
|
|
function P_1m( m , theta ) result( y )
|
|
! >Function returns the value of the corresponding normalized Associated legendre polynom for l=1 and given m and theta
|
|
integer(kind=idp),intent( in ):: m
|
|
real(kind=dp),intent( in ):: theta
|
|
real(kind=dp) y
|
|
character(len=70) :: errmesg
|
|
select case ( m )
|
|
case (-1)
|
|
y = 0.5_dp*sqrt(3.0_dp/(PI*2.0_dp))*sin(theta)
|
|
|
|
case (0)
|
|
y = 0.5_dp*sqrt(3.0_dp/PI)*(cos(theta)-1.0_dp) ! -1 is subtracted to shift so that for theta=0 y=0
|
|
|
|
case (1)
|
|
y = -0.5_dp*sqrt(3.0_dp/(PI*2.0_dp))*sin(theta)
|
|
|
|
case default
|
|
write(errmesg,'(A,i0)')'in p_1m given m not logic, ', m
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
|
|
end select
|
|
end function P_1m
|
|
!----------------------------------------------------------------------------------------------------
|
|
function P_2m( m , theta ) result( y )
|
|
! >Function returns the value of the corresponding normalized Associated legendre polynom for l=2 and given m and theta
|
|
integer(kind=idp),intent(in):: m
|
|
real(kind=dp),intent(in):: theta
|
|
real(kind=dp) y
|
|
character(len=70) :: errmesg
|
|
select case ( m )
|
|
case (-2)
|
|
y=0.25_dp*sqrt(15.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2
|
|
|
|
case (-1)
|
|
y=0.5_dp*sqrt(15.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)*cos(theta)
|
|
|
|
case (0)
|
|
y = (3.0_dp*cos(theta)**2-1.0_dp)
|
|
y = y - 2.0_dp !2.0 is subtracted to shift so that for theta=0 y=0
|
|
y = y * 0.25_dp*sqrt(5.0_dp/PI) ! normalize
|
|
|
|
case (1)
|
|
y = -0.5_dp*sqrt(15.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)*cos(theta)
|
|
|
|
case (2)
|
|
y = 0.25_dp*sqrt(15.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2
|
|
|
|
case default
|
|
write(errmesg,'(A,i0)')'in p_2m given m not logic, ', m
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
|
|
end select
|
|
end function P_2m
|
|
!----------------------------------------------------------------------------------------------------
|
|
function P_3m( m , theta ) result( y )
|
|
! >Function returns the value of the corresponding normalized Associated legendre polynom for l=3 and given m and theta
|
|
integer(kind=idp), intent(in) :: m
|
|
real(kind=dp), intent(in) :: theta
|
|
real(kind=dp) y
|
|
character(len=70) :: errmesg
|
|
select case ( m )
|
|
case (-3)
|
|
y=0.125_dp*sqrt(35.0_dp/PI)&
|
|
&*sin(theta)**3
|
|
|
|
case (-2)
|
|
y=0.25_dp*sqrt(105.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2*cos(theta)
|
|
|
|
case (-1)
|
|
y=0.125_dp*sqrt(21.0_dp/(PI))&
|
|
&*sin(theta)*(5*cos(theta)**2-1.0_dp)
|
|
|
|
case (0)
|
|
y=(5.0_dp*cos(theta)**3-3*cos(theta))
|
|
y=y-2.0_dp ! 2.0 is subtracted to shift so that for theta=0 y=0
|
|
y=y*0.25_dp*sqrt(7.0_dp/PI) ! normalize
|
|
|
|
case (1)
|
|
y=-0.125_dp*sqrt(21.0_dp/(PI))&
|
|
&*sin(theta)*(5.0_dp*cos(theta)**2-1.0_dp)
|
|
|
|
case (2)
|
|
y=0.25*sqrt(105.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2*cos(theta)
|
|
|
|
case (3)
|
|
y=-0.125*sqrt(35.0_dp/PI)&
|
|
&*sin(theta)**3
|
|
|
|
case default
|
|
write(errmesg,'(A,i0)')'in p_3m given m not logic, ', m
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
|
|
end select
|
|
end function P_3m
|
|
!----------------------------------------------------------------------------------------------------
|
|
function P_4m(m,theta) result(y)
|
|
! >Function returns the value of the corresponding normalized Associated legendre polynom for l=4 and given m and theta
|
|
integer(kind=idp), intent(in) :: m
|
|
real(kind=dp), intent(in) :: theta
|
|
real(kind=dp) y
|
|
character(len=70) :: errmesg
|
|
select case ( m )
|
|
case (-4)
|
|
y=(3.0_dp/16.0_dp)*sqrt(35.0_dp/2.0_dp*PI)&
|
|
&*sin(theta)**4
|
|
|
|
case (-3)
|
|
y=0.375*sqrt(35.0_dp/PI)&
|
|
&*sin(theta)**3*cos(theta)
|
|
|
|
case (-2)
|
|
y=0.375*sqrt(5.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2*(7*cos(theta)**2-1)
|
|
|
|
case (-1)
|
|
y=0.375*sqrt(5.0_dp/(PI))&
|
|
&*sin(theta)*(7*cos(theta)**3-3*cos(theta))
|
|
|
|
|
|
case (0)
|
|
y=(35*cos(theta)**4-30*cos(theta)**2+3)
|
|
y = y - 8.0_dp !8.0 is subtracted to shift so that for theta=0 y=0
|
|
y = y * (3.0_dp/16.0_dp)/sqrt(PI)
|
|
|
|
case (1)
|
|
y=-0.375*sqrt(5.0_dp/(PI))&
|
|
&*sin(theta)*(7*cos(theta)**3-3*cos(theta))
|
|
|
|
case (2)
|
|
y=0.375*sqrt(5.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2*(7*cos(theta)**2-1)
|
|
|
|
case (3)
|
|
y=-0.375*sqrt(35.0_dp/PI)&
|
|
&*sin(theta)**3*cos(theta)
|
|
|
|
case (4)
|
|
y=(3.0_dp/16.0_dp)*sqrt(35.0_dp/2.0_dp*PI)&
|
|
&*sin(theta)**4
|
|
|
|
case default
|
|
write(errmesg,'(A,i0)')'in p_4m given m not logic, ', m
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
|
|
end select
|
|
end function P_4m
|
|
!----------------------------------------------------------------------------------------------------
|
|
function P_5m(m,theta) result(y)
|
|
! >Function returns the value of the corresponding normalized Associated legendre polynom for l=5 and given m and theta
|
|
integer(kind=idp), intent(in) :: m
|
|
real(kind=dp), intent(in) :: theta
|
|
real(kind=dp) y
|
|
character(len=70) :: errmesg
|
|
select case ( m )
|
|
case (-5)
|
|
y=(3.0_dp/32.0_dp)*sqrt(77.0_dp/PI)&
|
|
&*sin(theta)**5
|
|
|
|
case (-4)
|
|
y=(3.0_dp/16.0_dp)*sqrt(385.0_dp/2.0_dp*PI)&
|
|
&*sin(theta)**4*cos(theta)
|
|
|
|
case (-3)
|
|
y=(1.0_dp/32.0_dp)*sqrt(385.0_dp/PI)&
|
|
&*sin(theta)**3*(9*cos(theta)**2-1.0_dp)
|
|
|
|
case (-2)
|
|
y=0.125*sqrt(1155.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2*(3*cos(theta)**3-cos(theta))
|
|
|
|
case (-1)
|
|
y=(1.0_dp/16.0_dp)*sqrt(165.0_dp/(2.0_dp*PI))&
|
|
&*sin(theta)*(21*cos(theta)**4-14*cos(theta)**2+1)
|
|
|
|
|
|
case (0)
|
|
y = (63*cos(theta)**5-70*cos(theta)**3+15*cos(theta))
|
|
y = y - 8.0_dp !8.0 is subtracted to shift so that for theta=0 y=0
|
|
y = y * (1.0_dp/16.0_dp)/sqrt(11.0_dp/PI)
|
|
|
|
case (1)
|
|
y=(-1.0_dp/16.0_dp)*sqrt(165.0_dp/(2.0_dp*PI))&
|
|
&*sin(theta)*(21*cos(theta)**4-14*cos(theta)**2+1)
|
|
|
|
case (2)
|
|
y=0.125*sqrt(1155.0_dp/(PI*2.0_dp))&
|
|
&*sin(theta)**2*(3*cos(theta)**3-cos(theta))
|
|
|
|
case (3)
|
|
y=(-1.0_dp/32.0_dp)*sqrt(385.0_dp/PI)&
|
|
&*sin(theta)**3*(9*cos(theta)**2-1.0_dp)
|
|
|
|
case (4)
|
|
y=(3.0_dp/16.0_dp)*sqrt(385.0_dp/2.0_dp*PI)&
|
|
&*sin(theta)**4*cos(theta)
|
|
|
|
case (5)
|
|
y=(-3.0_dp/32.0_dp)*sqrt(77.0_dp/PI)&
|
|
&*sin(theta)**5
|
|
|
|
case default
|
|
write(errmesg,'(A,i0)')'in p_5m given m not logic, ', m
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
|
|
end select
|
|
end function P_5m
|
|
!----------------------------------------------------------------------------------------------------
|
|
function P_6m(m,theta) result(y)
|
|
! >Function returns the value of the corresponding normalized Associated legendre polynom for l=6 and given m and theta
|
|
integer(kind=idp), intent(in) :: m
|
|
real(kind=dp), intent(in) :: theta
|
|
real(kind=dp):: y
|
|
character(len=70) :: errmesg
|
|
select case ( m )
|
|
case (-6)
|
|
y = (1.0_dp/64.0_dp)*sqrt(3003.0_dp/PI)&
|
|
&* sin(theta)**6
|
|
case (-5)
|
|
y = (3.0_dp/32.0_dp)*sqrt(1001.0_dp/PI)&
|
|
&* sin(theta)**5&
|
|
&* cos(theta)
|
|
case (-4)
|
|
y= (3.0_dp/32.0_dp)*sqrt(91.0_dp/(2.0_dp*PI))&
|
|
&* sin(theta)**4&
|
|
&* (11*cos(theta)**2 - 1 )
|
|
case (-3)
|
|
y= (1.0_dp/32.0_dp)*sqrt(1365.0_dp/PI)&
|
|
&* sin(theta)**3&
|
|
&* (11*cos(theta)**3 - 3*cos(theta) )
|
|
case (-2)
|
|
y= (1.0_dp/64.0_dp)*sqrt(1365.0_dp/PI)&
|
|
&* sin(theta)**2&
|
|
&* (33*cos(theta)**4 - 18*cos(theta)**2 + 1 )
|
|
case (-1)
|
|
y= (1.0_dp/16.0_dp)*sqrt(273.0_dp/(2.0_dp*PI))&
|
|
&* sin(theta)&
|
|
&* (33*cos(theta)**5 - 30*cos(theta)**3 + 5*cos(theta) )
|
|
case (0)
|
|
y = 231*cos(theta)**6 - 315*cos(theta)**4 + 105*cos(theta)**2-5
|
|
y = y - 16.0_dp !16.0 is subtracted to shift so that for theta=0 y=0
|
|
y = y * (1.0_dp/32.0_dp)*sqrt(13.0_dp/PI)
|
|
case (1)
|
|
y= -(1.0_dp/16.0_dp)*sqrt(273.0_dp/(2.0_dp*PI))&
|
|
&* sin(theta)&
|
|
&* (33*cos(theta)**5 - 30*cos(theta)**3 + 5*cos(theta) )
|
|
case (2)
|
|
y= (1.0_dp/64.0_dp)*sqrt(1365.0_dp/PI)&
|
|
&* sin(theta)**2&
|
|
&* (33*cos(theta)**4 - 18*cos(theta)**2 + 1 )
|
|
case (3)
|
|
y= -(1.0_dp/32.0_dp)*sqrt(1365.0_dp/PI)&
|
|
&* sin(theta)**3&
|
|
&* (11*cos(theta)**3 - 3*cos(theta) )
|
|
case (4)
|
|
y= (3.0_dp/32.0_dp)*sqrt(91.0_dp/(2.0_dp*PI))&
|
|
&* sin(theta)**4&
|
|
&* (11*cos(theta)**2 - 1 )
|
|
case (5)
|
|
y= -(3.0_dp/32.0_dp)*sqrt(1001.0_dp/PI)&
|
|
&* sin(theta)**5 * cos(theta)
|
|
case (6)
|
|
y = (1.0_dp/64.0_dp)*sqrt(3003.0_dp/PI)&
|
|
&* sin(theta)**6
|
|
case default
|
|
write(errmesg,'(A,i0)')'in p_6m given m not logic, ', m
|
|
error stop 'error in spherical harmonics' !error stop errmesg
|
|
|
|
end select
|
|
end function P_6m
|
|
!----------------------------------------------------------------------------------------------------
|
|
|
|
end module
|