(*The foundation and development of this code can be found in Manuel Forner's book:<<Desarrollos en serie de los productos de algunas funciones especiales>>paper support:http://www.tenda.uji.es/pls/iglu/!GCPPA00.GCPPR0002?lg=CA&id_art=1110 e-Book-PDF:http://www.tenda.uji.es/pls/iglu/!GCPPA00.GCPPR0002?lg=CA&id_art=1171*)

(* CALCULATION AND DEVELOPMENT IN SPHERICAL HARMONICS SERIES IN COMPLEX FORM OF THE FOLLOWING INTEGRALS: *)

(* 1) (∫_(λ1=0)^(2π))(∫_(θ1=-(π/2))^(π/2))(Subscript[P, k])(Cos[θ1]Cos[λ1]) (Subscript[P, r])(Sin[θ1]) (Subscript[P, n])(Cos[γ])Cos[θ1]\[DifferentialD]θ1\[DifferentialD]λ1*)

(* 2) (∫_(λ1=0)^(2π))(∫_(θ1=-(π/2))^(π/2))(Subscript[P, k])(Cos[θ1]Cos[λ1]) (Subscript[Y, r,s])(θ1,λ1) (Subscript[P, n])(Cos[γ])Cos[θ1]\[DifferentialD]θ1\[DifferentialD]λ1*)

(* 3) (∫_(λ1=0)^(2π))(∫_(θ1=-(π/2))^(π/2))(Subscript[P, k])(Cos[θ1]Cos[λ1]) (Subscript[P, r,s])(Sin[θ1]) (Subscript[P, n])(Cos[γ])Cos[θ1]\[DifferentialD]θ1\[DifferentialD]λ1*)

(* (Overscript[OM, ->])=(r Cos[θ] Cos[λ], r Cos[θ] Sin[λ], r Sin[θ]); (Overscript[OM, ->])1=(r1 Cos[θ1] Cos[λ1], r1 Cos[θ1] Sin[λ1], r1 Sin[θ1])*)

(* Cos[γ]=(((Overscript[OM, ->]).(Overscript[OM, ->])1)/(||(Overscript[OM, ->])||.||(Overscript[OM, ->])1||))=Sin[θ]Sin[θ1]+Cos[θ]Cos[θ1]Cos[λ-λ1]*)

(* If λ=0, Cos[θ]=1 -> Sin[θ]=0, θ=0 -> Cos[γ]=Cos[θ] Cos[λ]*)

(* If λ1=0, Cos[θ1]=1 -> Sin[θ1]=0, θ1=0 -> Cos[γ]=Cos[θ1] Cos[λ1]*)

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

γ=Sin[θ]Sin[θ1]+Cos[θ]Cos[θ1]Cos[λ-λ1];

γ0=Cos[θ] Cos[λ];

γ10=Cos[θ1] Cos[λ1];

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

(*Definitions of associated Legendre functions and spherical harmonics in complex form.*)

funAsLe[n_,m_,θ_]:=(((-1))^m)LegendreP[n,m,Sin[θ]]

YFC[n_,m_,θ_,λ_]:=Which[Abs[m]≤n,(Sqrt[(((2n+1)(n-m)!)/(4π(n+m)!))])(E^(I m λ)) (funAsLe[n,m,θ]/.{Sqrt[1-Cos[x_]^2]->Sin[x],Sqrt[1-Sin[x_]^2]->Cos[x]}),Abs[m]>n,0]

(* The addition theorem for spherical harmonics in complex form *)

pnγC[n_]:=((4π)/(2n+1))Sum[(((-1))^m)YFC[n,m,θ,λ]YFC[n,-m,θ1,λ1],{m,-n,n}]

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

(*  (Subscript[P, n,m])(0)=(((n+m)!n!)/(2^n))(∑_(j=0)^(n-m))((((-1))^j)/(j!(n-m-j)!(m+j)!(n-j)!)), if "n+m" is even and "n≠m"; (Subscript[P, n,n])(0)=(2n-1)!!; (Subscript[P, n,m])(0)=0, if "n+m" is odd *)

funAsLeF0[n_,m_]:=If[Mod[n+m,2]==0,If[n==m,(2n-1)!!,(((n+m)! n!)/(2^n))Sum[((((-1))^j)/(j!(n-m-j)!(m+j)!(n-j)!)),{j,0,n-m}]],0]

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

(* intFornerC[p,q,n,m,r,s]=(∫_(λ1=0)^(2π))(∫_(θ1=-(π/2))^(π/2)) (Subscript[Y, n,m])(θ1,λ1) (Subscript[Y, r,s])(θ1,λ1) (Subscript[Y, p,q])(θ1,λ1) Cos[θ1] \[DifferentialD]θ1\[DifferentialD]λ1*)

solInt[α_,z_]:=If[Mod[z,2]==0,((1+(((-1))^α))/2)(((α-1)!! ((z/2))! (2^((z/2)+1)))/((α+z+1)!!)),((1+(((-1))^α))/2)(((α-1)!! z!! π)/((α+z+1)!!))]

η[m_]:=If[m<0,(((-1))^(Abs[m])),1]

suma1[α_,n_,m_,j_]:=Module[{t,β,γ},γ=j;β=If[j-α<0,0,j-α];Sum[(((-1))^t)((j!)/(t!(j-t)!))(((n-m-j)!)/((n-m-α-t)!(α+t-j)!)),{t,β,γ}]]

suma2[α_,n_,m_]:=Expand[Sum[((suma1[α,n,m,j])/(j!(n-m-j)!(m+j)!(n-j)!)),{j,0,n-m}]]

χ[ξ_,n_,m_,r_,s_]:=Module[{u,δ,l},δ=If[r-s-ξ<0,Abs[r-s-ξ],0];l=If[ξ>n-m,n-m,ξ];Sum[suma2[u,n,m] suma2[ξ-u,r,s],{u,δ,l}]]

χχ[ζ_,n_,m_,r_,s_,i_,z_]:=Module[{uu,δδ,ll},δδ=If[i-z-ζ<0,Abs[i-z-ζ],0];ll=If[ζ>n+r-m-s,n+r-m-s,ζ];Sum[χ[uu,n,m,r,s] suma2[ζ-uu,i,z],{uu,δδ,ll}]]

cC[n_,m_]:=(Sqrt[(((2n+1)(n-m)!)/(4π(n+m)!))])

coef[m_,s_,z_]:=If[m+s+z==0,2π,0]

intFornerC[j_Integer,zz_Integer,n_Integer,m_Integer,r_Integer,s_Integer]:=If[Abs[zz]≤j &&Abs[m]≤n &&Abs[s]≤r,coef[m,s,zz](((n+Abs[m])!n!(r+Abs[s])!r!(j+Abs[zz])!j!)/(2^(n+r+j)))cC[n,Abs[m]] cC[r,Abs[s]] cC[j,Abs[zz]] η[m]η[s]η[zz]Sum[χχ[ζ,n,Abs[m],r,Abs[s],j,Abs[zz]]solInt[ζ,Abs[m]+Abs[s]+Abs[zz]] ,{ζ,0,n+r+j-(Abs[m]+Abs[s]+Abs[zz])}],0]

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

(* 1) (∫_(λ1=0)^(2π))(∫_(θ1=-(π/2))^(π/2))(Subscript[P, k])(Cos[θ1]Cos[λ1]) (Subscript[P, r])(Sin[θ1]) (Subscript[P, n])(Cos[γ])Cos[θ1]\[DifferentialD]θ1\[DifferentialD]λ1*)

intPoLeKopal[n_,k_,r_]:=Integrate[Integrate[LegendreP[k,γ10] LegendreP[r,Sin[θ1]] LegendreP[n,γ] Cos[θ1],{θ1,-(π/2),(π/2)}],{λ1,0,2π}]

integralGenPoLeFC[n_,k_,r_]:=((16(π^2))/((2n+1)(Sqrt[(2k+1)(2r+1)])))Sum[(Sqrt[(((k-m)!)/((k+m)!))])funAsLeF0[k,m]intFornerC[n,m,k,-m,r,0] YFC[n,-m,θ,λ],{m,-k,k}]

intDesGenPoleFC[n_,k_,r_]:=((16(π^2))/((2n+1)(Sqrt[(2k+1)(2r+1)])))Sum[(Sqrt[(((k-m)!)/((k+m)!))])funAsLeF0[k,m]intFornerC[n,m,k,-m,r,0] yFC[n,-m],{m,-k,k}]

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

(* 2) (∫_(λ1=0)^(2π))(∫_(θ1=-(π/2))^(π/2))(Subscript[P, k])(Cos[θ1]Cos[λ1]) (Subscript[Y, r,s])(θ1,λ1) (Subscript[P, n])(Cos[γ])Cos[θ1]\[DifferentialD]θ1\[DifferentialD]λ1*)

intHaEsKopalC[n_,k_,r_,s_]:=Integrate[Integrate[LegendreP[k,γ10] YFC[r,s,θ1,λ1] LegendreP[n,γ] Cos[θ1],{θ1,-(π/2),(π/2)}],{λ1,0,2π}]

integralGenHArEsFC[n_,k_,r_,s_]:=((8(π^(3/2)))/(2n+1))(Sqrt[(1/(2k+1))])Sum[(((-1))^s) (Sqrt[(((k-m)!)/((k+m)!))]) funAsLeF0[k,m]intFornerC[n,m-s,k,-m,r,s] YFC[n,-m+s,θ,λ],{m,-k,k}]

intDesGenHarEsFC[n_,k_,r_,s_]:=((8(π^(3/2)))/(2n+1))(Sqrt[(1/(2k+1))])Sum[(((-1))^s) (Sqrt[(((k-m)!)/((k+m)!))]) funAsLeF0[k,m]intFornerC[n,m-s,k,-m,r,s] yFC[n,-m+s],{m,-k,k}]

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

(* intprodFunAsLegF[n,m,r,s,p,q]=(∫_(-1)^1)(Subscript[P, n,m])(x) (Subscript[P, r,s])(x) (Subscript[P, p,q])(x) \[DifferentialD]x*)

intprodFunAsLegF[n_Integer,m_Integer,r_Integer,s_Integer,p_Integer,q_Integer]:=Which[(n≥Abs[m])&&(r≥Abs[s])&&(p≥Abs[q]),(((n+m)!n!(r+s)!r!(p+q)!p!)/(2^(n+r+p)))η[m]η[s]η[q]Sum[χχ[α,n,Abs[m],r,Abs[s],p,Abs[q]]solInt[α,Abs[m]+Abs[s]+Abs[q]],{α,0,n+r+p-(Abs[m]+Abs[s]+Abs[q])}],n<0||r<0||p<0,Print["Neither n nor r nor p can be negative numbers"],n<Abs[m]||r<Abs[s]||p<Abs[q],0]

(* invnormafunAsLe[n,m]=(1/(||(Subscript[P, n,m])(x)((||)^2)))*)

invnormafunAsLe[n_,m_]:=(((2n+1)(n-m)!)/(2(n+m)!))

(* aF[n,m,r,s,p,q]=(((∫_(-1)^1)(Subscript[P, n,m])(x) (Subscript[P, r,s])(x) (Subscript[P, p,q])(x) \[DifferentialD]x)/(||(Subscript[P, n,m])(x)((||)^2)))*)

aF[n_,m_,r_,s_,p_,q_]:=intprodFunAsLegF[n,m,r,s,p,q]invnormafunAsLe[p,q]

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

(* 3) (∫_(λ1=0)^(2π))(∫_(θ1=-(π/2))^(π/2))(Subscript[P, k])(Cos[θ1]Cos[λ1]) (Subscript[P, r,s])(Sin[θ1]) (Subscript[P, n])(Cos[γ])Cos[θ1]\[DifferentialD]θ1\[DifferentialD]λ1*)

intFuAsKopal[n_,k_,r_,s_]:=Integrate[Integrate[LegendreP[k,γ10] funAsLe[r,s,θ1] LegendreP[n,γ] Cos[θ1],{θ1,-(π/2),(π/2)}],{λ1,0,2π}]

sqn[n_,m_]:=If[n≥Abs[m],(Sqrt[(((n-m)!)/((n+m)!))]),0]

integralGenFuAsFC[n_,k_,r_,s_]:=4(π^(3/2))(Sqrt[(1/(2n+1))])Sum[sqn[n,m]funAsLeF0[k,m]Sum[aF[k,-m,r,s,j,-m+s]intprodFunAsLegF[n,m,j,-m+s,0,0],{j,Abs[-m+s],k+r}] YFC[n,-m,θ,λ],{m,-k,k}]

intDesGenFuAsFC[n_,k_,r_,s_]:=4(π^(3/2))(Sqrt[(1/(2n+1))])Sum[sqn[n,m]funAsLeF0[k,m]Sum[aF[k,-m,r,s,j,-m+s]intprodFunAsLegF[n,m,j,-m+s,0,0],{j,Abs[-m+s],k+r}] yFC[n,-m],{m,-k,k}]

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)