module specialfunction
! sikinote, http://slpr.sakura.ne.jp/qp
! author : sikino
! date : 2016/05/29
! : 2017/10/27
!
! Reference
! Abramowitz & Stegun (1965), ISBN 978-0486612720
! (Numerical Method, 22.18, Page 789)
!
! -----------------------------------------
! laguerre(n,a,x) L_n^a(x)
! ...valid below combinations
! (n,a,x) = (I,I,D)
! (n,a,x) = (I,D,D)
! (n,a,x) = (I,C,C)
! 1st derivative laguerre1(n,a,x)
! 2nd derivative laguerre2(n,a,x)
! -----------------------------------------
! legendre(l,m,x) P_l^m(x)
! ...valid below combinations
! (l,m,x) = (I,I,D)
! (l,m,x) = (I,I,Z)
! 1st derivative legendre1(l,m,x)
! 2nd derivative legendre2(l,m,x)
! -----------------------------------------
! hermite(n,x) H_n(x)
! ...valid below combinations
! (n,x) = (I,D)
! (n,x) = (I,Z)
! 1st derivative hermite1(n,x)
! 2nd derivative hermite2(n,x)
! -----------------------------------------
! jacobi(n,alpha,beta,x) P_n^(alpha,beta)(x)
! ...valid below combinations
! (n,alpha,beta,x) = (I,D,D,C)
! (n,alpha,beta,x) = (I,C,C,C)
!
! 1st derivative jacobi1(n,alpha,beta,x)
! 2nd derivative jacobi2(n,alpha,beta,x)
! -----------------------------------------
!
! I -> integer
! D -> double precision
! C -> complex(kind(0d0))
!
implicit none
interface laguerre
module procedure &
ilaguerre, &
dlaguerre, &
claguerre
end interface laguerre
interface legendre
module procedure &
dalegendre, &
calegendre
end interface legendre
interface hermite
module procedure &
dhermite, &
chermite
end interface hermite
interface jacobi
module procedure &
djacobi, &
cjacobi
end interface jacobi
interface laguerre1
module procedure &
ilaguerre1, &
dlaguerre1, &
claguerre1
end interface laguerre1
interface legendre1
module procedure &
dalegendre1 , &
calegendre1
end interface legendre1
interface hermite1
module procedure &
dhermite1, &
chermite1
end interface hermite1
interface jacobi1
module procedure &
djacobi1, &
cjacobi1
end interface jacobi1
interface laguerre2
module procedure &
ilaguerre2, &
dlaguerre2, &
claguerre2
end interface laguerre2
interface legendre2
module procedure &
dalegendre2 , &
calegendre2
end interface legendre2
interface hermite2
module procedure &
dhermite2, &
chermite2
end interface hermite2
interface jacobi2
module procedure &
djacobi2, &
cjacobi2
end interface jacobi2
contains
function ilaguerre(n,a,x)
!
! a
! L (x)
! n
! a is integer
! not only 0 <= x < infty, but also negative value.
integer,intent(in)::n,a
double precision,intent(in)::x
double precision::ilaguerre,fx
integer::m
double precision::da,dn,dm,bm,cm,dnx
if(n.le.-1)then
ilaguerre=0d0
return
endif
dn=dble(n); da=dble(a)
!dnx=exp(dlgamma(da+dn+1d0)-dlgamma(dn+1d0)-dlgamma(da+1d0))
dnx=exp(log(gamma(da+dn+1d0))-log(gamma(dn+1d0))-log(gamma(da+1d0)))
fx=x
ilaguerre=1d0
do m=n,1,-1
dm=dble(m); cm=dm*(da+dm); bm=dble(n-m+1)
ilaguerre=1d0-ilaguerre*fx*bm/cm
enddo
ilaguerre=ilaguerre*dnx
return
end function ilaguerre
function dlaguerre(n,a,x)
!
! (a)
! L (x)
! n
!
! not only 0 <= x < infty, but also negative value.
integer,intent(in)::n
double precision,intent(in)::a
double precision,intent(in)::x
double precision::dlaguerre,fx
integer::m
double precision::dn,dm,bm,cm,dnx
if(n.le.-1)then
dlaguerre=0d0
return
endif
dn=dble(n)
!dnx=exp(dlgamma(a+dn+1d0)-dlgamma(dn+1d0)-dlgamma(a+1d0))
dnx=exp(log(gamma(a+dn+1d0))-log(gamma(dn+1d0))-log(gamma(a+1d0)))
fx=x
dlaguerre=1d0
do m=n,1,-1
dm=dble(m); cm=dm*(a+dm); bm=dble(n-m+1)
dlaguerre=1d0-dlaguerre*fx*bm/cm
enddo
dlaguerre=dlaguerre*dnx
return
end function dlaguerre
function claguerre(n,a,x)
!
! (a)
! L (x)
! n
!
! not only 0 <= x < infty, but also negative value.
integer,intent(in)::n
complex(kind(0d0)),intent(in)::a,x
complex(kind(0d0))::claguerre,fx,dnx,cm,dn
integer::m
double precision::dm,bm
if(n.le.-1)then
claguerre=dcmplx(0d0,0d0)
return
endif
dn=dcmplx(dble(n),0d0)
dnx=exp(clgamma(a+dn+1d0)-clgamma(dn+1d0)-clgamma(a+1d0))
fx=x
claguerre=dcmplx(1d0,0d0)
do m=n,1,-1
dm=dble(m); cm=dm*(a+dm); bm=dble(n-m+1)
claguerre=1d0-claguerre*fx*bm/cm
enddo
claguerre=claguerre*dnx
return
end function claguerre
!======================================
function dalegendre(l,m,x)
implicit none
integer,intent(in)::m,l
double precision,intent(in)::x
double precision::dalegendre
! m
! P (x)
! l
!
! not only -1 <= x <= 1, but also more larger analytical continuum
integer::am,q,i
double precision::fm,dq,dam2,fl
double precision::t1,t2
dalegendre=0d0
if(abs(m).gt.l)then
dalegendre=0d0
return
endif
am=abs(m)
fm=1d0
do i=1,2*am-1,2
fm=fm*dble(i)
enddo
dam2=dble(2*am-1)
if(l-am.eq.0)then
dalegendre=dble((-1)**am)*fm*(1d0-x*x)**(0.5d0*dble(am))
elseif(l-am.eq.1)then
t1=dble((-1)**am)*fm*(1d0-x*x)**(0.5d0*dble(am))
dalegendre=dble(2*am+1)*x*t1
else
t1=dble((-1)**am)*fm*(1d0-x*x)**(0.5d0*dble(am))
t2=dble(2*am+1)*x*t1
do q=2,l-am
dq=1d0/dble(q)
dalegendre=(dam2*dq+2d0)*x*t2-(dam2*dq+1d0)*t1
t1=t2
t2=dalegendre
enddo
endif
if(m.lt.0)then
fl=1d0
do i=l-am+1,l+am
fl=fl*dble(i)
enddo
dalegendre=dalegendre*dble((-1)**am)/fl
endif
return
end function dalegendre
function calegendre(l,m,x)
! m
! P (x)
! l
!
! |m| <= l
! not only -1 <= x <= 1, but also more larger analytical continuum
implicit none
integer,intent(in)::m,l
complex(kind(0d0)),intent(in)::x
complex(kind(0d0))::calegendre
integer::am,q,i
double precision::fm,dq,dam2,fl
complex(kind(0d0))::t1,t2
calegendre=dcmplx(0d0,0d0)
if(abs(m).gt.l)then
calegendre=dcmplx(0d0,0d0)
return
endif
am=abs(m)
fm=1d0
do i=1,2*am-1,2
fm=fm*dble(i)
enddo
dam2=dble(2*am-1)
if(l-am.eq.0)then
calegendre=dble((-1)**am)*fm*(1d0-x*x)**(0.5d0*dble(am))
elseif(l-am.eq.1)then
t1=dble((-1)**am)*fm*(1d0-x*x)**(0.5d0*dble(am))
calegendre=dble(2*am+1)*x*t1
else
t1=dble((-1)**am)*fm*(1d0-x*x)**(0.5d0*dble(am))
t2=dble(2*am+1)*x*t1
do q=2,l-am
dq=1d0/dble(q)
calegendre=(dam2*dq+2d0)*x*t2-(dam2*dq+1d0)*t1
t1=t2
t2=calegendre
enddo
endif
if(m.lt.0)then
fl=1d0
do i=l-am+1,l+am
fl=fl*dble(i)
enddo
calegendre=calegendre*dble((-1)**am)/fl
endif
return
end function calegendre
!===============================
function djacobi(n,alpha,beta,x)
implicit none
double precision,intent(in)::alpha,beta
integer,intent(in)::n
complex(kind(0d0)),intent(in)::x
complex(kind(0d0))::djacobi
!
! (alpha,beta)
! P (x)
! n
!
! Orthogonality
! 1
! / a b (a,b) (a,b) 2^(a+b+1) Gamma(n+a+1)Gamma(n+b+1)
! | (1-x) (1+x) P (x) P (x) dx = ---------- ------------------------- delta_nm
! / m n 2n+a+b+1 Gamma(n+a+b+1)Gamma(n+1)
! -1
!
! Defferential equation
!
! (1-x^2)y'' + (b-a-(a+b+2)x)y' + n(n+a+b+1)y = 0
!
integer::m
double precision::dnx,dn,bm,cm
complex(kind(0d0))::fx
djacobi=dcmplx(0d0,0d0)
dn=dble(n)
dnx=exp(log(gamma(alpha+dn+1d0))-log(gamma(dn+1d0))-log(gamma(alpha+1d0)))
fx=1d0-x
djacobi=dcmplx(1d0,0d0)
do m=n,1,-1
bm=dble(n-m+1)*(alpha+beta+dble(n+m))
cm=dble(2*m)*(alpha+dble(m))
djacobi=1d0-djacobi*fx*bm/cm
enddo
djacobi=dnx*djacobi
return
end function djacobi
!===============================
function cjacobi(n,alpha,beta,x)
implicit none
integer,intent(in)::n
complex(kind(0d0)),intent(in)::alpha,beta,x
complex(kind(0d0))::cjacobi
!
! (alpha,beta)
! P (x)
! n
!
! Orthogonality
! 1
! / a b (a,b) (a,b) 2^(a+b+1) Gamma(n+a+1)Gamma(n+b+1)
! | (1-x) (1+x) P (x) P (x) dx = ---------- ------------------------- delta_nm
! / m n 2n+a+b+1 Gamma(n+a+b+1)Gamma(n+1)
! -1
!
! Defferential equation
!
! (1-x^2)y'' + (b-a-(a+b+2)x)y' + n(n+a+b+1)y = 0
!
integer::m
complex(kind(0d0))::cnx,bm,cm,dn,fx
cjacobi=dcmplx(0d0,0d0)
dn=dcmplx(dble(n),0d0)
cnx=exp(clgamma(alpha+dn+1d0)-clgamma(dn+1d0)-clgamma(alpha+1d0))
fx=1d0-x
cjacobi=dcmplx(1d0,0d0)
do m=n,1,-1
bm=dble(n-m+1)*(alpha+beta+dble(n+m))
cm=dble(2*m)*(alpha+dble(m))
cjacobi=1d0-cjacobi*fx*bm/cm
enddo
cjacobi=cnx*cjacobi
return
end function cjacobi
!=======================================
function ilaguerre1(n,a,x)
implicit none
integer,intent(in)::n,a
double precision,intent(in)::x
double precision::ilaguerre1
ilaguerre1=-laguerre(n-1,a+1,x)
return
end function ilaguerre1
function dlaguerre1(n,a,x)
implicit none
integer,intent(in)::n
double precision,intent(in)::a,x
double precision::dlaguerre1
dlaguerre1=-laguerre(n-1,a+1d0,x)
return
end function dlaguerre1
function claguerre1(n,a,x)
implicit none
integer,intent(in)::n
complex(kind(0d0)),intent(in)::a,x
complex(kind(0d0))::claguerre1
claguerre1=-laguerre(n-1,a+1d0,x)
return
end function claguerre1
function ilaguerre2(n,a,x)
implicit none
integer,intent(in)::n,a
double precision,intent(in)::x
double precision::ilaguerre2
ilaguerre2=laguerre(n-2,a+2,x)
return
end function ilaguerre2
function dlaguerre2(n,a,x)
implicit none
integer,intent(in)::n
double precision,intent(in)::a,x
double precision::dlaguerre2
dlaguerre2=laguerre(n-2,a+2d0,x)
return
end function dlaguerre2
function claguerre2(n,a,x)
implicit none
integer,intent(in)::n
complex(kind(0d0)),intent(in)::a,x
complex(kind(0d0))::claguerre2
claguerre2=laguerre(n-2,a+2d0,x)
return
end function claguerre2
function dalegendre1(l,m,x)
implicit none
integer,intent(in)::m,l
double precision,intent(in)::x
double precision::dalegendre1
double precision::c0,c1,c2
dalegendre1=0d0
if(abs(m).gt.l)then
dalegendre1=0d0
return
endif
if(abs(m).eq.1)then
dalegendre1=(dble(l)*x*legendre(l,m,x)-dble(l+m)*legendre(l-1,m,x))/(x*x-1)
else
c0=1d0/dble(4*m+4)
c1=0.5d0*dble(l+m)*(1d0+dble(l)/dble(1-m*m))
c2=-dble((l+m)*(l-m+1)*(l+m-2)*(l+m-1))/dble(4*m-4)
dalegendre1=c0*legendre(l-1,m+2,x)+c1*legendre(l-1,m,x)+c2*legendre(l-1,m-2,x)
endif
return
end function dalegendre1
function calegendre1(l,m,x)
implicit none
integer,intent(in)::m,l
complex(kind(0d0)),intent(in)::x
complex(kind(0d0))::calegendre1
double precision::c0,c1,c2
calegendre1=dcmplx(0d0,0d0)
if(abs(m).gt.l)then
calegendre1=dcmplx(0d0,0d0)
return
endif
if(abs(m).eq.1)then
calegendre1=(dble(l)*x*legendre(l,m,x)-dble(l+m)*legendre(l-1,m,x))/(x*x-1)
else
c0=1d0/dble(4*m+4)
c1=0.5d0*dble(l+m)*(1d0+dble(l)/dble(1-m*m))
c2=-dble((l+m)*(l-m+1)*(l+m-2)*(l+m-1))/dble(4*m-4)
calegendre1=c0*legendre(l-1,m+2,x)+c1*legendre(l-1,m,x)+c2*legendre(l-1,m-2,x)
endif
return
end function calegendre1
function dalegendre2(l,m,x)
implicit none
integer,intent(in)::m,l
double precision,intent(in)::x
double precision::dalegendre2
double precision::c0,c1,c2
dalegendre2=0d0
if(abs(m).gt.l)then
dalegendre2=0d0
return
endif
if(abs(m).eq.1.or.abs(m).eq.3)then
dalegendre2=(2d0*x*legendre1(l,m,x)&
+dble((l+1)*(l+m))/dble(2*l+1)*legendre1(l-1,m,x)&
-dble(l*(l-m+1))/dble(2*l+1)*legendre1(l+1,m,x))/(1-x*x)
else
c0=1d0/dble(4*m+4)
c1=0.5d0*dble(l+m)*(1d0+dble(l)/dble(1-m*m))
c2=-dble((l+m)*(l-m+1)*(l+m-2)*(l+m-1))/dble(4*m-4)
dalegendre2=c0*legendre1(l-1,m+2,x)&
+c1*legendre1(l-1,m,x)+c2*legendre1(l-1,m-2,x)
endif
return
end function dalegendre2
function calegendre2(l,m,x)
implicit none
integer,intent(in)::m,l
complex(kind(0d0)),intent(in)::x
complex(kind(0d0))::calegendre2
double precision::c0,c1,c2
calegendre2=dcmplx(0d0,0d0)
if(abs(m).gt.l)then
calegendre2=dcmplx(0d0,0d0)
return
endif
if(abs(m).eq.1.or.abs(m).eq.3)then
calegendre2=(dble(l)*x*legendre(l,m,x)-dble(l+m)*legendre(l-1,m,x))/(x*x-1)
else
c0=1d0/dble(4*m+4)
c1=0.5d0*dble(l+m)*(1d0+dble(l)/dble(1-m*m))
c2=-dble((l+m)*(l-m+1)*(l+m-2)*(l+m-1))/dble(4*m-4)
calegendre2=c0*legendre(l-1,m+2,x)+c1*legendre(l-1,m,x)+c2*legendre(l-1,m-2,x)
endif
return
end function calegendre2
!=========================
function djacobi1(n,alpha,beta,x)
implicit none
double precision,intent(in)::alpha,beta
integer,intent(in)::n
complex(kind(0d0)),intent(in)::x
complex(kind(0d0))::djacobi1
double precision::c0
c0=log(gamma(alpha+beta+dble(n+2))-log(gamma(alpha+beta+dble(n+1)))-log(2d0))
djacobi1=c0*jacobi(n-1,alpha+1d0,beta+1d0,x)
return
end function djacobi1
function cjacobi1(n,alpha,beta,x)
implicit none
integer,intent(in)::n
complex(kind(0d0)),intent(in)::alpha,beta,x
complex(kind(0d0))::cjacobi1,c0
c0=clgamma(alpha+beta+dble(n+2))-clgamma(alpha+beta+dble(n+1))-log(2d0)
cjacobi1=c0*jacobi(n-1,alpha+1d0,beta+1d0,x)
return
end function cjacobi1
function djacobi2(n,alpha,beta,x)
implicit none
double precision,intent(in)::alpha,beta
integer,intent(in)::n
complex(kind(0d0)),intent(in)::x
complex(kind(0d0))::djacobi2
double precision::c0
c0=log(gamma(alpha+beta+dble(n+3)))-log(gamma(alpha+beta+dble(n+1)))-2d0*log(2d0)
djacobi2=c0*jacobi(n-2,alpha+2d0,beta+2d0,x)
return
end function djacobi2
function cjacobi2(n,alpha,beta,x)
implicit none
integer,intent(in)::n
complex(kind(0d0)),intent(in)::alpha,beta,x
complex(kind(0d0))::cjacobi2,c0
c0=clgamma(alpha+beta+dble(n+3))-clgamma(alpha+beta+dble(n+1))-2d0*log(2d0)
cjacobi2=c0*jacobi(n-2,alpha+2d0,beta+2d0,x)
return
end function cjacobi2
function dhermite(n,x)
implicit none
integer,intent(in)::n
double precision,intent(in)::x
double precision::dhermite
integer::m,k
double precision::dn,dm,bm,cm,dnx,fx
if(n.le.-1)then
dhermite=0d0
return
endif
fx=x*x
dhermite=1d0
if(mod(n,2).eq.0)then
k=n/2
dn=dble(k)
dnx=exp(log(gamma(2d0*dn+1d0))-log(gamma(dn+1d0)))
do m=k,1,-1
dm=dble(m); cm=dm*(2d0*dm-1d0); bm=2d0*dble(k-m+1)
dhermite=1d0-dhermite*fx*bm/cm
enddo
else
k=(n-1)/2
dn=dble(k)
dnx=2d0*x*exp(log(gamma(2d0*dn+2d0))-log(gamma(dn+1d0)))
do m=k,1,-1
dm=dble(m); cm=dm*(2d0*dm+1d0); bm=2d0*dble(k-m+1)
dhermite=1d0-dhermite*fx*bm/cm
enddo
endif
dhermite=dhermite*dnx
if(mod(k,2).eq.1)dhermite=-dhermite
return
end function dhermite
function dhermite1(n,x)
implicit none
integer,intent(in)::n
double precision,intent(in)::x
double precision::dhermite1
dhermite1=2*n*dhermite(n-1,x)
return
end function dhermite1
function dhermite2(n,x)
implicit none
integer,intent(in)::n
double precision,intent(in)::x
double precision::dhermite2
dhermite2=dble(4*n)*dble(n-1)*dhermite(n-2,x)
return
end function dhermite2
function chermite(n,z)
implicit none
integer,intent(in)::n
complex(kind(0d0)),intent(in)::z
complex(kind(0d0))::chermite
integer::m,k
double precision::dn,dm,bm,cm
complex(kind(0d0))::fx,dnx
if(n.le.-1)then
chermite=dcmplx(1d0,0d0)
return
endif
fx=z*z
chermite=dcmplx(1d0,0d0)
if(mod(n,2).eq.0)then
k=n/2
dn=dble(k)
dnx=exp(log(gamma(2d0*dn+1d0))-log(gamma(dn+1d0)))
do m=k,1,-1
dm=dble(m); cm=dm*(2d0*dm-1d0); bm=2d0*dble(k-m+1)
chermite=1d0-chermite*fx*bm/cm
enddo
else
k=(n-1)/2
dn=dble(k)
dnx=2d0*z*exp(log(gamma(2d0*dn+2d0))-log(gamma(dn+1d0)))
do m=k,1,-1
dm=dble(m); cm=dm*(2d0*dm+1d0); bm=2d0*dble(k-m+1)
chermite=1d0-chermite*fx*bm/cm
enddo
endif
chermite=chermite*dnx
if(mod(k,2).eq.1)chermite=-chermite
return
end function chermite
function chermite1(n,z)
implicit none
integer,intent(in)::n
complex(kind(0d0)),intent(in)::z
complex(kind(0d0))::chermite1
chermite1=2*n*chermite(n-1,z)
return
end function chermite1
function chermite2(n,z)
implicit none
integer,intent(in)::n
complex(kind(0d0)),intent(in)::z
complex(kind(0d0))::chermite2
chermite2=dble(4*n)*dble(n-1)*chermite(n-2,z)
return
end function chermite2
function clgamma(z)
implicit none
complex(kind(0d0)),intent(in)::z
complex(kind(0d0))::clgamma
clgamma=log(cgamma(z))
return
end function clgamma
function cgamma(z)
implicit none
complex(kind(0d0)),intent(in)::z
complex(kind(0d0))::cgamma
!
! sikinote (http://slpr.sakura.ne.jp/qp)
! author : sikino
! date : 2017/01/09
! 2017/01/10 optimize the number of a(M)
!
integer::i,n,M
double precision,parameter::pi=3.14159265358979324d0
double precision,parameter::e1=0.3678794411714423216d0
double precision,parameter::ln2pi2=0.91893853320467274d0
double precision,parameter::sq2pi=2.5066282746310005d0
double precision::a(1:30),AB(1:14),dz,iz
complex(kind(0d0))::q,s,w,r,q1,q2
dz=dble(z)
iz=imag(z)
if(dz.eq.nint(dz).and.iz.eq.0d0)then
if(dz.gt.0d0)then
s=dcmplx(1d0,0d0)
n=nint(dz)
do i=2,n-1
s=s*i
enddo
else
s=1d+300
endif
cgamma=s
else
q=z
if(dz.lt.0d0)q=1d0-z
if(abs(iz).lt.1.45d0)then
! For x=arb, |y|\lt 1.45
n=int(dble(q))
s=1d0
do i=1,n
s=s*(q-i)
enddo
w=q-dble(n)
a(1) = 1d0
a(2) = 0.57721566490153286d0
a(3) =-0.65587807152025388d0
a(4) =-0.42002635034095236d-1
a(5) = 0.16653861138229149d0
a(6) =-0.42197734555544337d-1
a(7) =-0.96219715278769736d-2
a(8) = 0.72189432466630995d-2
a(9) =-0.11651675918590651d-2
a(10)=-0.21524167411495097d-3
a(11)= 0.12805028238811619d-3
a(12)=-0.20134854780788239d-4
a(13)=-0.12504934821426707d-5
a(14)= 0.11330272319816959d-5
a(15)=-0.20563384169776071d-6
a(16)= 0.61160951044814158d-8
a(17)= 0.50020076444692229d-8
a(18)=-0.11812745704870201d-8
a(19)= 0.10434267116911005d-9
a(20)= 0.77822634399050713d-11
a(21)=-0.36968056186422057d-11
a(22)= 0.51003702874544760d-12
a(23)=-0.20583260535665068d-13
a(24)=-0.53481225394230180d-14
a(25)= 0.12267786282382608d-14
a(26)=-0.11812593016974588d-15
a(27)= 0.11866922547516003d-17
a(28)= 0.14123806553180318d-17
a(29)=-0.22987456844353702d-18
a(30)= 0.17144063219273374d-19
M=int(11.3*abs(w)+13)
if(M.gt.30)M=30
r=a(M)
do i=M-1,1,-1
r=r*w+a(i)
enddo
cgamma=s/(r*w)
else
! For x=arb, |y|\gt 1.45
s=1d0
if(abs(q).lt.9d0)then
do i=0,7
s=s*(q+i)
enddo
s=1d0/s
q=q+8d0
endif
AB(1) = 0.83333333333333333d-1
AB(2) =-0.27777777777777778d-2
AB(3) = 0.79365079365079365d-3
AB(4) =-0.59523809523809524d-3
AB(5) = 0.84175084175084175d-3
AB(6) =-0.19175269175269175d-2
AB(7) = 0.64102564102564103d-2
AB(8) =-0.29550653594771242d-1
q1=1d0/q
q2=q1*q1
r=AB(8)
do i=7,1,-1
r=r*q2+AB(i)
enddo
cgamma=s*exp((q-0.5d0)*log(q)-q+ln2pi2+r*q1)
endif
if(dz.lt.0d0)cgamma=pi/(cgamma*sin(pi*z))
endif
return
end function cgamma
end module specialfunction
大変助かります。
”ifort gamerf2a.f spfunc.f90 temp.f90” によって実行形式が出力されるということですが、
以下の理解でよろしいでしょうか。
temp.f90がメイン 呼び出しを行うところで、ページに示されているトータル12行
spfunc.f90が特殊関数(ラゲールとか)の部分(クリックで展開するところ)
gamerf2a.fはガンマ関数の呼び出しだろうと思いますが、サイト内に含まれているでしょうか。
ガンマ関数を紹介されているページもありますが、あの中にあるでしょうか。
ソース名を明示していただければ助かります。
よろしくお願いします。
すみません。
ifort gamerf2a.f spfunc.f90 temp.f90
のこれらのソースファイルとページ内に示されたのファイルの関係はどうなっているでしょうか。3つのソースですが、ページには2つしか示されていないようです。
想像はできますが、明示していただけたらと思います。また、1つ足りないのはガンマ関数を呼び出すソースなのだろうと思いますが。
私が使ってたコマンドとファイル名をそのままコピペしてたみたいですね。
>spfunc.f90が特殊関数(ラゲールとか)の部分(クリックで展開するところ)
これは正しいです。
>temp.f90がメイン 呼び出しを行うところで、ページに示されているトータル12行
これも正しいです。
gamerf2a.fは使っていないので無くて構いません。
なので、入力すべきコマンドは
です。
ちなみに、gamer2a.fとは、
http://www.kurims.kyoto-u.ac.jp/~ooura/gamerf-j.html
で公開されているガンマ関数のコードです。
このページは一度更新されていて、更新前はこちらのコードの一部を利用していたのです。