double precision function Full_Ellip1_Func_d(k)  ! 第 1 種完全楕円関数計算
  implicit none
  double precision, intent(in) :: k  ! 関数の引数
  double precision :: pi, m, dt, t, tmin, tmax
  integer :: i
  integer, parameter :: nmax=1000
  double precision :: f, x

  f(m,x) = 1.0d0/dsqrt(1.0d0-(m*dsin(x))**2)

  if(k.ge.1.0d0)then
     write(*,*) "(error ! : k must 0=<k<1.)"
     return
  end if

  pi = 3.1415926535898d0

  tmin = 0.0d0
  tmax = pi/2.0d0
  dt = (tmax-tmin)/dble(nmax-1)

  Full_Ellip1_Func_d = 0.5d0*dt*(f(k,tmin)+f(k,tmax))
  do i=1,nmax-2
     t = tmin+dt*dble(i)
     Full_Ellip1_Func_d = Full_Ellip1_Func_d+dt*f(k,t)
  end do

  return
end function

real function Full_Ellip1_Func_f(k)  ! 第 1 種完全楕円関数計算
  implicit none
  real, intent(in) :: k  ! 関数の引数
  real :: pi, m, dt, t, tmin, tmax
  integer :: i
  integer, parameter :: nmax=1000
  real :: f, x

  f(m,x) = 1.0/sqrt(1.0-(m*sin(x))**2)

  if(k.ge.1.0)then
     write(*,*) "(error ! : k must 0=<k<1.)"
     return
  end if

  pi = 3.14159265

  tmin = 0.0
  tmax = pi/2.0
  dt = (tmax-tmin)/(nmax-1)

  Full_Ellip1_Func_f = 0.5*dt*(f(k,tmin)+f(k,tmax))
  do i=1,nmax-2
     t = tmin+dt*i
     Full_Ellip1_Func_f = Full_Ellip1_Func_f+dt*f(k,t)
  end do

  return
end function

double precision function Full_Ellip2_Func_d(k)  ! 第二種完全楕円関数
  implicit none
  double precision, intent(in) :: k  ! 関数の引数
  double precision :: pi, m, dt, t, tmin, tmax
  integer :: i
  integer, parameter :: nmax=1000
  double precision :: f, x

  f(m,x) = dsqrt(1.0d0-(m*dsin(x))**2)

  pi = 3.1415926535898d0

  if(k.gt.1.0d0)then
     write(*,*) "(error) ! : k must 0=<k=<1."
     return
  end if

  tmin = 0.0d0
  tmax = pi/2.0d0
  dt = (tmax-tmin)/dble(nmax-1)

  Full_Ellip2_Func_d = 0.5d0*dt*(f(k,tmin)+f(k,tmax))
  do i=1,nmax-2
     t = tmin+dt*dble(i)
     Full_Ellip2_Func_d = Full_Ellip2_Func_d+dt*f(k,t)
  end do

  return
end function

real function Full_Ellip2_Func_f(k)  ! 第二種完全楕円関数
  implicit none
  real, intent(in) :: k  ! 関数の引数
  real :: pi, m, dt, t, tmin, tmax
  integer :: i
  integer, parameter :: nmax=1000
  real :: f, x

  f(m,x) = sqrt(1.0-(m*sin(x))**2)

  pi = 3.14159265

  if(k.gt.1.0)then
     write(*,*) "(error) ! : k must 0=<k=<1."
     return
  end if

  tmin = 0.0
  tmax = pi/2.0
  dt = (tmax-tmin)/(nmax-1)

  Full_Ellip2_Func_f = 0.5*dt*(f(k,tmin)+f(k,tmax))
  do i=1,nmax-2
     t = tmin+dt*i
     Full_Ellip2_Func_f = Full_Ellip2_Func_f+dt*f(k,t)
  end do

  return
end function

subroutine besdzero(nmax,mmax,k)
!**********************************
!  ベッセル関数のゼロ点を計算する *
!**********************************
  implicit none
  integer, intent(in) :: nmax          ! ベッセル関数のゼロ点の最大個数
  integer, intent(in) :: mmax          ! ベッセル関数の最大次数
  double precision, intent(inout) :: k(0:nmax,mmax)  ! mmax 次までの nmax+1 個のゼロ点を格納する
  double precision :: a, b, c, d, e, f, g, lim, dx
  integer :: i, j, n

!-- 二分法の解と近似する条件 ---
  lim=1.0d-6    ! 収束条件

!-- 二分法の二点を決定するための, 刻み幅 ---
!-- ベッセル関数のゼロ点の間隔はおよそ 3 ごとであるので,
!-- 0.5 ずつ刻めば, まあいいか
  dx=0.5d0
!-- 配列の初期化 ---
  do i=0,nmax
     do j=1,mmax
        k(i,j)=0.0d0
     end do
  end do

!-- 0 次計算 ---
  k(0,1)=0.0d0
  d=k(0,1)

  do 10 i=1,mmax

     if(i.gt.1)then
        d=k(0,i-1)+dx
     end if

     do while (k(0,mmax).eq.0.0d0)
        a=d
        e=bessj_d(0,a)
        b=a+dx
        f=bessj_d(0,b)
        d=d+dx

        do while (e*f.lt.0.0d0)
           c=0.5d0*(a+b)
           g=bessj_d(0,c)
           if(e*g.lt.0.0d0)then
              b=c
           else
              a=c
           end if

           if(abs(g).lt.lim)then
              k(0,i)=c
              go to 10
           end if

        end do
     end do 
  10 continue

  if(nmax > 0)then
!-- 1 次以上計算 ---
     do n=1,nmax
     do 21 i=1,mmax
        d=k(n-1,i)+dx
        do while (k(n,mmax).eq.0.0d0)
           a=d
           e=bessj_d(n,a)
           b=a+dx
           f=bessj_d(n,b)
           d=d+dx
           do while (e*f.lt.0.0d0)
              c=0.5d0*(a+b)
              g=bessj_d(n,c)
              if(e*g.lt.0.0d0)then
                 b=c
              else
                 a=c
              end if
              if(abs(g).lt.lim)then
                 k(n,i)=c
                 go to 21
              end if
           end do
        end do
  21  continue
     end do
  end if

end subroutine

subroutine besfzero(nmax,mmax,k)
!**********************************
!  ベッセル関数のゼロ点を計算する *
!**********************************
  implicit none
  integer, intent(in) :: nmax          ! ベッセル関数のゼロ点の最大個数
  integer, intent(in) :: mmax          ! ベッセル関数の最大次数
  real, intent(inout) :: k(0:nmax,mmax)  ! mmax 次までの nmax+1 個のゼロ点を格納する
  real :: a, b, c, d, e, f, g, lim, dx
  integer :: i, j, n

!-- 二分法の解と近似する条件 ---
  lim=1.0e-6    ! 収束条件

!-- 二分法の二点を決定するための, 刻み幅 ---
!-- ベッセル関数のゼロ点の間隔はおよそ 3 ごとであるので,
!-- 0.5 ずつ刻めば, まあいいか
!-- （注意）実際使用の際は, bessj_f 関数が参照されているかを確認のこと.
!-- バグ検証中
  dx=0.5
!-- 配列の初期化 ---
  do i=0,nmax
     do j=1,mmax
        k(i,j)=0.0
     end do
  end do

!-- 0 次計算 ---
  k(0,1)=0.0
  d=k(0,1)

  do 10 i=1,mmax

     if(i.gt.1)then
        d=k(0,i-1)+dx
     end if

     do while (k(0,mmax).eq.0.0)
        a=d
        e=bessj_f(0,a)
        b=a+dx
        f=bessj_f(0,b)
        d=d+dx

        do while (e*f.lt.0.0)
           c=0.5*(a+b)
           g=bessj_f(0,c)
           if(e*g.lt.0.0)then
              b=c
           else
              a=c
           end if

           if(abs(g).lt.lim)then
              k(0,i)=c
              go to 10
           end if

        end do
     end do 
  10 continue

  if(nmax > 0)then
!-- 1 次以上計算 ---
     do n=1,nmax
     do 21 i=1,mmax
        d=k(n-1,i)+dx
        do while (k(n,mmax).eq.0.0)
           a=d
           e=bessj_f(n,a)
           b=a+dx
           f=bessj_f(n,b)
           d=d+dx
           do while (e*f.lt.0.0)
              c=0.5*(a+b)
              g=bessj_f(n,c)
              if(e*g.lt.0.0)then
                 b=c
              else
                 a=c
              end if
              if(abs(g).lt.lim)then
                 k(n,i)=c
                 go to 21
              end if
           end do
        end do
  21  continue
     end do
  end if

end subroutine

double precision function bessj_d(m,t)  ! 第 I 種ベッセル関数を計算する
  implicit none
  integer, intent(in) :: m  ! 計算する次数
  double precision, intent(in) :: t  ! 引数
  integer :: istep, n
  double precision :: x, coe1
  integer, parameter :: mmax = 100 ! 数値積分用の配列
  double precision, parameter :: pis=3.14159265
  double precision, parameter :: xmin = 0.0d0, xmax = 2.0d0*pis
  double precision, parameter :: dx = (xmax-xmin)/(mmax-1)

  if(t<0.0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of bessj must not be negative."
     write(*,*) "Stop."
     stop
  end if

!-- 負の次数であった場合を分ける ---
  if(m < 0)then
     n=-m
  else
     n=m
  end if

!-- ベッセル関数の積分計算 ---
  bessj_d=0.0d0

  do istep=2,mmax-1
     x=xmin+dx*dble(istep-1)
     bessj_d=bessj_d+dx*(dcos(t*dsin(x)-dble(n)*x))
  end do

  bessj_d=bessj_d+0.5d0*dx*(dcos(t*dsin(xmin)-dble(n)*xmin) +dcos(t*dsin(xmax)-dble(n)*xmax))
  bessj_d=bessj_d/(2.0d0*pis)

!-- 負の次数であった場合を分ける ---
  if(m.lt.0)then
     if(mod(n,2)==0)then  ! (-1)^m の計算を節約する
        coe1=1.0d0
     else
        coe1=-1.0d0
     end if
     bessj_d=coe1*bessj_d
  end if

  return
end function

double precision function bessj_dnoni(nu,t)
! 次数が非整数におけるベッセル関数を計算する.
! 非整数次ではシュレーフリ積分が成り立たないので, Lommel 積分を台形公式で
! 計算することによって評価する. また,
! $J_{-n}(x)=(-1)^nJ_n(x)$
! の式が成り立たないので, 負の次数の場合も直接計算を行うように変更.
! Lommel の積分は以下の式：
! $J_{\nu} (x)=\left(\frac{x}{2} \right) ^{\nu} \frac{1}{\sqrt[]{\dble(pi)} \Gamma (\nu +1/2)} \int^{\dble(pi)}_{0}{\cos{(z\cos{\theta} )} } $
! ただし, この式で評価できるのは, $\nu > -\frac{1}{2} $までなので, これより小さい非整数次のベッセル関数は計算できない.
! そこで, これ以下の次数の非整数ベッセル関数は漸化式：
! $J_{\nu -1}(x)+J_{\nu +1}(x)=\frac{2\nu}{x} J_{\nu} (x)$
! を用いて計算する. ただし, この場合, $x>0$ に限る.

  use Math_Const
  implicit none
  double precision, intent(in) :: nu  ! 計算する次数
  double precision, intent(in) :: t  ! 引数
  integer :: istep
  double precision :: x
  integer, parameter :: mmax = 100 ! 数値積分用の配列
  double precision :: xmin, xmax, dx, tmp1, tmp2, bess0, bess1, bess2, tmp
  intrinsic :: aint

  xmin = 0.0d0
  xmax = dble(pi)
  dx = (xmax-xmin)/(mmax-1)

  if(t<0.0d0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of bessj must not be negative."
     write(*,*) "Stop."
     stop
  end if

  if(nu<=-0.5d0)then  ! nu <= -1/2 の場合の処理.
     tmp1=nu+1.0d0+aint(abs(nu))
     tmp2=nu+2.0d0+aint(abs(nu))  ! 漸化式が 3 項漸化式なので, 初期値が 2 つ.
  end if


!-- ベッセル関数の積分計算 ---
  bessj_dnoni=0.0d0

  if(nu>-0.5d0)then
     do istep=2,mmax-1
        x=xmin+dx*(istep-1)
        bessj_dnoni=bessj_dnoni+dx*(cos(t*cos(x))*((sin(x))**(2.0d0*nu)))
     end do

     bessj_dnoni=bessj_dnoni+0.5d0*dx*(cos(t*cos(xmin))*((sin(xmin))**(2.0d0*nu)) +cos(t*cos(xmax))*((sin(xmax))**(2.0d0*nu)))
     bessj_dnoni=bessj_dnoni*((0.5d0*x)**nu)/(sqrt(dble(pi))*gamma_func_d(nu+0.5d0))

  else  ! nu <= -0.5 のとき.
     bess1=0.0d0
     bess2=0.0d0
     do istep=2,mmax-1
        x=xmin+dx*(istep-1)
        bess1=bess1+dx*(cos(t*cos(x))*((sin(x))**(2.0d0*tmp1)))
        bess2=bess2+dx*(cos(t*cos(x))*((sin(x))**(2.0d0*tmp2)))
     end do

     bess1=bess1+0.5d0*dx*(cos(t*cos(xmin))*((sin(xmin))**(2.0d0*tmp1)) +cos(t*cos(xmax))*((sin(xmax))**(2.0d0*tmp1)))
     bess1=bess1*((0.5d0*x)**tmp1)/(sqrt(dble(pi))*gamma_func_d(tmp1+0.5))
     bess2=bess2+0.5d0*dx*(cos(t*cos(xmin))*((sin(xmin))**(2.0d0*tmp2)) +cos(t*cos(xmax))*((sin(xmax))**(2.0d0*tmp2)))
     bess2=bess2*((0.5d0*x)**tmp2)/(sqrt(dble(pi))*gamma_func_d(tmp2+0.5d0))

     tmp=tmp1

     do while(tmp/=nu)  ! tmp=nu になったら, 求める項になったと判断する.
        bess0=2.0d0*tmp1*bess1/t-bess2
        tmp=tmp-1.0d0
        tmp1=tmp1-1.0d0
        bess2=bess1
        bess1=bess0  ! 項の繰り下げ
     end do

     bessj_dnoni=bess1

  end if

  return

end function

real function bessj_f(m,t)  ! 第 I 種ベッセル関数を計算する
  implicit none
  integer, intent(in) :: m  ! 計算する次数
  real, intent(in) :: t  ! 引数
  integer :: istep, n
  real :: x, coe1
  integer, parameter :: mmax = 100 ! 数値積分用の配列
  real, parameter :: pis=3.14159265
  real, parameter :: xmin = 0.0d0, xmax = 2.0d0*pis
  real, parameter :: dx = (xmax-xmin)/(mmax-1)

  if(t<0.0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of bessj must not be negative."
     write(*,*) "Stop."
     stop
  end if

!-- 負の次数であった場合を分ける ---
  if(m < 0)then
     n=-m
  else
     n=m
  end if

!-- ベッセル関数の積分計算 ---
  bessj_f=0.0

  do istep=2,mmax-1
     x=xmin+dx*(istep-1)
     bessj_f=bessj_f+dx*(cos(t*sin(x)-real(n)*x))
  end do

  bessj_f=bessj_f+0.5*dx*(cos(t*sin(xmin)-real(n)*xmin) +cos(t*sin(xmax)-real(n)*xmax))
  bessj_f=bessj_f/(2.0*pis)

!-- 負の次数であった場合を分ける ---
  if(m.lt.0)then
     if(mod(n,2)==0)then  ! (-1)^m の計算を節約する
        coe1=1.0
     else
        coe1=-1.0
     end if
     bessj_f=coe1*bessj_f
  end if

  return
end function

real function bessj_fnoni(nu,t)
! 次数が非整数におけるベッセル関数を計算する.
! 非整数次ではシュレーフリ積分が成り立たないので, Lommel 積分を台形公式で
! 計算することによって評価する. また,
! $J_{-n}(x)=(-1)^nJ_n(x)$
! の式が成り立たないので, 負の次数の場合も直接計算を行うように変更.
! Lommel の積分は以下の式：
! $J_{\nu} (x)=\left(\frac{x}{2} \right) ^{\nu} \frac{1}{\sqrt[]{\pi} \Gamma (\nu +1/2)} \int^{\pi}_{0}{\cos{(z\cos{\theta} )} } $
! ただし, この式で評価できるのは, $\nu > -\frac{1}{2} $までなので, これより小さい非整数次のベッセル関数は計算できない.
! そこで, これ以下の次数の非整数ベッセル関数は漸化式：
! $J_{\nu -1}(x)+J_{\nu +1}(x)=\frac{2\nu}{x} J_{\nu} (x)$
! を用いて計算する. ただし, この場合, $x>0$ に限る.

  use Math_Const
  implicit none
  real, intent(in) :: nu  ! 計算する次数
  real, intent(in) :: t  ! 引数
  integer :: istep
  real :: x
  integer, parameter :: mmax = 100 ! 数値積分用の配列
  real :: xmin, xmax, dx, tmp1, tmp2, bess0, bess1, bess2, tmp
  intrinsic :: aint

  xmin = 0.0
  xmax = pi
  dx = (xmax-xmin)/(mmax-1)

  if(t<0.0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of bessj must not be negative."
     write(*,*) "Stop."
     stop
  end if

  if(nu<=-0.5)then  ! nu <= -1/2 の場合の処理.
     tmp1=nu+1.0+aint(abs(nu))
     tmp2=nu+2.0+aint(abs(nu))  ! 漸化式が 3 項漸化式なので, 初期値が 2 つ.
  end if


!-- ベッセル関数の積分計算 ---
  bessj_fnoni=0.0

  if(nu>-0.5)then
     do istep=2,mmax-1
        x=xmin+dx*(istep-1)
        bessj_fnoni=bessj_fnoni+dx*(cos(t*cos(x))*((sin(x))**(2.0*nu)))
     end do

     bessj_fnoni=bessj_fnoni+0.5*dx*(cos(t*cos(xmin))*((sin(xmin))**(2.0*nu)) +cos(t*cos(xmax))*((sin(xmax))**(2.0*nu)))
     bessj_fnoni=bessj_fnoni*((0.5*x)**nu)/(sqrt(pi)*gamma_func_f(nu+0.5))

  else  ! nu <= -0.5 のとき.
     bess1=0.0
     bess2=0.0
     do istep=2,mmax-1
        x=xmin+dx*(istep-1)
        bess1=bess1+dx*(cos(t*cos(x))*((sin(x))**(2.0*tmp1)))
        bess2=bess2+dx*(cos(t*cos(x))*((sin(x))**(2.0*tmp2)))
     end do

     bess1=bess1+0.5*dx*(cos(t*cos(xmin))*((sin(xmin))**(2.0*tmp1)) +cos(t*cos(xmax))*((sin(xmax))**(2.0*tmp1)))
     bess1=bess1*((0.5*x)**tmp1)/(sqrt(pi)*gamma_func_f(tmp1+0.5))
     bess2=bess2+0.5*dx*(cos(t*cos(xmin))*((sin(xmin))**(2.0*tmp2)) +cos(t*cos(xmax))*((sin(xmax))**(2.0*tmp2)))
     bess2=bess2*((0.5*x)**tmp2)/(sqrt(pi)*gamma_func_f(tmp2+0.5))

     tmp=tmp1

     do while(tmp/=nu)  ! tmp=nu になったら, 求める項になったと判断する.
        bess0=2.0*tmp1*bess1/t-bess2
        tmp=tmp-1.0
        tmp1=tmp1-1.0
        bess2=bess1
        bess1=bess0  ! 項の繰り下げ
     end do

     bessj_fnoni=bess1

  end if

  return

end function

double precision function bessy_d( n, z )
! 整数次のノイマン関数を計算する.
! 計算には, シュレーフリの積分表示を用い, 半無限領域の積分については,
! 非積分関数が 10^{-6} に達する点までで打ちきる.
! また, 半無限積分の非積分関数は 2 つあるが, それぞれについて項の値を
! 毎回評価し, 上のしきい値を越えた時点でその項は積分をやめるようにする.
! ただし, この方法が適切かどうかは保証できない.
  use Math_Const
  implicit none
  integer, intent(in) :: n  ! 次数
  double precision, intent(in) :: z  ! 変数
  double precision :: dt, term1, term2, tmp1, tmp2, t
  double precision :: tmin, tmax  ! 定積分項の積分領域
  double precision, parameter :: thres=1.0d-6
  integer :: i
  integer, parameter :: nt=100  ! 定積分項の積分分割数

  if(z<0.0d0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of bessj must not be negative."
     write(*,*) "Stop."
     stop
  end if

  tmin=0.0d0
  tmax=dble(pi)
  term1=0.0d0
  term2=0.0d0
  dt=1.0d-2

!-- 半無限積分項の計算
!-- 項 1

  t=0.0d0

  tmp1=0.5d0  ! 非積分関数の z=0 での値 x 0.5
  term1=tmp1

  do while (tmp1>thres)
     t=t+dt
     tmp1=exp(n*t-z*sinh(t))
     term1=term1+tmp1
  end do

  t=t+dt
  term1=term1+0.5d0*exp(n*t-z*sinh(t))
  term1=dt*term1/dble(pi)

!-- 項 2

  t=0.0d0

  tmp2=0.5d0  ! 非積分関数の z=0 での値 x 0.5
  term2=tmp2

  do while (tmp2>thres)
     t=t+dt
     tmp2=exp(-(n*t+z*sinh(t)))
     term2=term2+tmp2*cos(n*dble(pi))  ! cos の周期性でしきい値を一時的に下回らない
                               ! ように, 振幅のみで評価する. cos はあとでかける
  end do

  t=t+dt
  term2=term2+0.5d0*exp(-(n*t+z*sinh(t)))*cos(n*dble(pi))
  term2=dt*term2/dble(pi)

!-- 定積分計算
  dt=(tmax-tmin)/nt
  t=0.0d0

  bessy_d=0.0d0  ! tmin での非積分関数の値

  do i=1,nt-1
     t=t+dt
     bessy_d=bessy_d+sin(z*sin(t)-n*t)
  end do

  bessy_d=bessy_d+0.5d0*sin(z*sin(tmax)-n*tmax)
  bessy_d=dt*bessy_d/dble(pi)-term1-term2

  return
end function

double precision function bessy_dnoni( nu, t )
! 非整数次におけるノイマン関数を計算する.
! $Y_{\nu} =\frac{1}{\sin{\nu \pi}} [\cos{\nu \pi }J_{\nu} (x)-J_{-\nu} (x)]$
  use Math_Const
  implicit none
  double precision, intent(in) :: nu  ! 次数
  double precision, intent(in) :: t  ! 変数
  intrinsic :: aint

  if(t<=0.0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of bessy must not be negative or zero."
     write(*,*) "Stop."
     stop
  end if

  if(nu/=aint(nu))then  ! nu が整数次の場合は, bessy_f にリダイレクトする.
     bessy_dnoni=(cos(nu*dble(pi))*bessj_dnoni( nu, t )-bessj_dnoni( -nu, t )) /(sin(nu*dble(pi)))
  else
     bessy_dnoni=bessy_d( int(nu), t )
  end if

  return
end function

real function bessy_f( n, z )
! 整数次のノイマン関数を計算する.
! 計算には, シュレーフリの積分表示を用い, 半無限領域の積分については,
! 非積分関数が 10^{-6} に達する点までで打ちきる.
! また, 半無限積分の非積分関数は 2 つあるが, それぞれについて項の値を
! 毎回評価し, 上のしきい値を越えた時点でその項は積分をやめるようにする.
! ただし, この方法が適切かどうかは保証できない.
  use Math_Const
  implicit none
  integer, intent(in) :: n  ! 次数
  real, intent(in) :: z  ! 変数
  real :: dt, term1, term2, tmp1, tmp2, t
  real,parameter :: tmin=0.0, tmax=pi  ! 定積分項の積分領域
  real, parameter :: thres=1.0e-6
  integer :: i
  integer, parameter :: nt=100  ! 定積分項の積分分割数

  if(z<0.0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of bessj must not be negative."
     write(*,*) "Stop."
     stop
  end if

  term1=0.0
  term2=0.0
  dt=1.0e-2

!-- 半無限積分項の計算
!-- 項 1

  t=0.0

  tmp1=0.5  ! 非積分関数の z=0 での値 x 0.5
  term1=tmp1

  do while (tmp1>thres)
     t=t+dt
     tmp1=exp(n*t-z*sinh(t))
     term1=term1+tmp1
  end do

  t=t+dt
  term1=term1+0.5*exp(n*t-z*sinh(t))
  term1=dt*term1/pi

!-- 項 2

  t=0.0

  tmp2=0.5  ! 非積分関数の z=0 での値 x 0.5
  term2=tmp2

  do while (tmp2>thres)
     t=t+dt
     tmp2=exp(-(n*t+z*sinh(t)))
     term2=term2+tmp2*cos(n*pi)  ! cos の周期性でしきい値を一時的に下回らない
                               ! ように, 振幅のみで評価する. cos はあとでかける
  end do

  t=t+dt
  term2=term2+0.5*exp(-(n*t+z*sinh(t)))*cos(n*pi)
  term2=dt*term2/pi

!-- 定積分計算
  dt=(tmax-tmin)/nt
  t=0.0

  bessy_f=0.0  ! tmin での非積分関数の値

  do i=1,nt-1
     t=t+dt
     bessy_f=bessy_f+sin(z*sin(t)-n*t)
  end do

  bessy_f=bessy_f+0.5*sin(z*sin(tmax)-n*tmax)
  bessy_f=dt*bessy_f/pi-term1-term2

  return
end function

real function bessy_fnoni( nu, t )
! 非整数次におけるノイマン関数を計算する.
! $Y_{\nu} =\frac{1}{\sin{\nu \pi}} [\cos{\nu \pi }J_{\nu} (x)-J_{-\nu} (x)]$
  use Math_Const
  implicit none
  real, intent(in) :: nu  ! 次数
  real, intent(in) :: t  ! 変数
  intrinsic :: aint

  if(t<=0.0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of bessy must not be negative or zero."
     write(*,*) "Stop."
     stop
  end if

  if(nu/=aint(nu))then  ! nu が整数次の場合は, bessy_f にリダイレクトする.
     bessy_fnoni=(cos(nu*pi)*bessj_fnoni( nu, t )-bessj_fnoni( -nu, t )) /(sin(nu*pi))
  else
     bessy_fnoni=bessy_f( int(nu), t )
  end if

  return
end function

double precision function beta_func_d( x, y )
! ベータ関数を計算するルーチン.
! ベータ関数とガンマ関数の間の関係式
! $B(x,y)=\frac{\Gamma (x)\Gamma (y)}{\Gamma (x+y)} $
! を用いることによって, ガンマ関数からの計算を行う.
! gamma_func において, 引数が特異点の場合, 警告を出す処理をしてあるので,
! ベータ関数の特異点においても警告が出て落ちる仕様になっている.
  implicit none
  double precision, intent(in) :: x  ! 第一引数
  double precision, intent(in) :: y  ! 第二引数

  beta_func_d=(gamma_func_d(x)*gamma_func_d(y))/(gamma_func_d(x+y))

  return
end function

real function beta_func_f( x, y )
! ベータ関数を計算するルーチン.
! ベータ関数とガンマ関数の間の関係式
! $B(x,y)=\frac{\Gamma (x)\Gamma (y)}{\Gamma (x+y)} $
! を用いることによって, ガンマ関数からの計算を行う.
! gamma_func において, 引数が特異点の場合, 警告を出す処理をしてあるので,
! ベータ関数の特異点においても警告が出て落ちる仕様になっている.
  implicit none
  real, intent(in) :: x  ! 第一引数
  real, intent(in) :: y  ! 第二引数

  beta_func_f=(gamma_func_f(x)*gamma_func_f(y))/(gamma_func_f(x+y))

  return
end function

real function delta(t,u)  ! クロネッカーのデルタを計算するサブルーチン
  implicit none
  integer, intent(in) :: t  ! 行成分
  integer, intent(in) :: u  ! 列成分

  if(t==u)then
     delta=1.0
  else
     delta=0.0
  end if

  return
end function

double precision function df_bessj_d( m, t )
! 整数次における第 1 種変形ベッセル関数の計算
! df_bessj_fnoni へリダイレクト
  implicit none
  integer, intent(in) :: m  ! 次数
  double precision, intent(in) :: t  ! 変数

  df_bessj_d=df_bessj_dnoni( dble(m), t )

end function

double precision function df_bessj_dnoni( nu, t )
! 非整数次における第 1 種変形ベッセル関数の計算
! 積分形から計算.
! 積分形は以下の式：
! $$I_{\nu} (x)=\frac{1}{\sqrt[]{\pi} \mathit{\Gamma} (\nu +1/2)} \left(\frac{x}{2} \right) ^{\nu} \int^{\infty}_{0}{\cosh{(x\cosh{t})} sin^{2\nu}{t} dt} $$
! ただし, $\nu >-1/2$であるので, これより小さい次数については, 漸化式：
! $$I_{\nu -1}-I_{\nu +1} =\frac{2\nu}{x} I_{\nu} $$
! を用いて次数を下げる.
  use Math_Const
  implicit none
  double precision, intent(in) :: nu  ! 計算する次数
  double precision, intent(in) :: t  ! 引数
  integer :: istep
  double precision :: x
  integer, parameter :: mmax = 100 ! 数値積分用の配列
  double precision :: xmin, xmax, dx, tmp1, tmp2, bess0, bess1, bess2, tmp
  intrinsic :: aint

  xmin = 0.0d0
  xmax = dble(pi)
  dx = (xmax-xmin)/(mmax-1)

  if(t<0.0d0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of df_bessj must not be negative."
     write(*,*) "Stop."
     stop
  end if

  if(nu<=-0.5d0)then  ! nu <= -1/2 の場合の処理.
     tmp1=nu+1.0d0+aint(abs(nu))
     tmp2=nu+2.0d0+aint(abs(nu))  ! 漸化式が 3 項漸化式なので, 初期値が 2 つ.
  end if


!-- ベッセル関数の積分計算 ---
  df_bessj_dnoni=0.0d0

  if(nu>-0.5d0)then
     do istep=2,mmax-1
        x=xmin+dx*(istep-1)
        df_bessj_dnoni=df_bessj_dnoni+dx*(cosh(t*cos(x))*((sin(x))**(2.0d0*nu)))
     end do

     df_bessj_dnoni=df_bessj_dnoni+0.5d0*dx*(cosh(t*cos(xmin))*((sin(xmin))**(2.0d0*nu)) +cosh(t*cos(xmax))*((sin(xmax))**(2.0d0*nu)))
     df_bessj_dnoni=df_bessj_dnoni*((0.5d0*x)**nu)/(sqrt(dble(pi))*gamma_func_d(nu+0.5d0))

  else  ! nu <= -0.5 のとき.
     bess1=0.0d0
     bess2=0.0d0
     do istep=2,mmax-1
        x=xmin+dx*(istep-1)
        bess1=bess1+dx*(cosh(t*cos(x))*((sin(x))**(2.0d0*tmp1)))
        bess2=bess2+dx*(cosh(t*cos(x))*((sin(x))**(2.0d0*tmp2)))
     end do

     bess1=bess1+0.5d0*dx*(cosh(t*cos(xmin))*((sin(xmin))**(2.0d0*tmp1)) +cosh(t*cos(xmax))*((sin(xmax))**(2.0d0*tmp1)))
     bess1=bess1*((0.5d0*x)**tmp1)/(sqrt(dble(pi))*gamma_func_d(tmp1+0.5d0))
     bess2=bess2+0.5d0*dx*(cosh(t*cos(xmin))*((sin(xmin))**(2.0d0*tmp2)) +cosh(t*cos(xmax))*((sin(xmax))**(2.0d0*tmp2)))
     bess2=bess2*((0.5d0*x)**tmp2)/(sqrt(dble(pi))*gamma_func_d(tmp2+0.5d0))

     tmp=tmp1

     do while(tmp/=nu)  ! tmp=nu になったら, 求める項になったと判断する.
        bess0=2.0d0*tmp1*bess1/t-bess2
        tmp=tmp-1.0d0
        tmp1=tmp1-1.0d0
        bess2=bess1
        bess1=bess0  ! 項の繰り下げ
     end do

     df_bessj_dnoni=bess1

  end if

  return
end function

real function df_bessj_f( m, t )
! 整数次における第 1 種変形ベッセル関数の計算
! df_bessj_fnoni へリダイレクト
  implicit none
  integer, intent(in) :: m  ! 次数
  real, intent(in) :: t  ! 変数

  df_bessj_f=df_bessj_fnoni( real(m), t )

end function

real function df_bessj_fnoni( nu, t )
! 非整数次における第 1 種変形ベッセル関数の計算
! 積分形から計算.
! 積分形は以下の式：
! $$I_{\nu} (x)=\frac{1}{\sqrt[]{\pi} \mathit{\Gamma} (\nu +1/2)} \left(\frac{x}{2} \right) ^{\nu} \int^{\infty}_{0}{\cosh{(x\cosh{t})} sin^{2\nu}{t} dt} $$
! ただし, $\nu >-1/2$であるので, これより小さい次数については, 漸化式：
! $$I_{\nu -1}-I_{\nu +1} =\frac{2\nu}{x} I_{\nu} $$
! を用いて次数を下げる.
  use Math_Const
  implicit none
  real, intent(in) :: nu  ! 計算する次数
  real, intent(in) :: t  ! 引数
  integer :: istep
  real :: x
  integer, parameter :: mmax = 100 ! 数値積分用の配列
  real :: xmin, xmax, dx, tmp1, tmp2, bess0, bess1, bess2, tmp
  intrinsic :: aint

  xmin = 0.0
  xmax = pi
  dx = (xmax-xmin)/(mmax-1)

  if(t<0.0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of df_bessj must not be negative."
     write(*,*) "Stop."
     stop
  end if

  if(nu<=-0.5)then  ! nu <= -1/2 の場合の処理.
     tmp1=nu+1.0+aint(abs(nu))
     tmp2=nu+2.0+aint(abs(nu))  ! 漸化式が 3 項漸化式なので, 初期値が 2 つ.
  end if


!-- ベッセル関数の積分計算 ---
  df_bessj_fnoni=0.0

  if(nu>-0.5)then
     do istep=2,mmax-1
        x=xmin+dx*(istep-1)
        df_bessj_fnoni=df_bessj_fnoni+dx*(cosh(t*cos(x))*((sin(x))**(2.0*nu)))
     end do

     df_bessj_fnoni=df_bessj_fnoni+0.5*dx*(cosh(t*cos(xmin))*((sin(xmin))**(2.0*nu)) +cosh(t*cos(xmax))*((sin(xmax))**(2.0*nu)))
     df_bessj_fnoni=df_bessj_fnoni*((0.5*x)**nu)/(sqrt(pi)*gamma_func_f(nu+0.5))

  else  ! nu <= -0.5 のとき.
     bess1=0.0
     bess2=0.0
     do istep=2,mmax-1
        x=xmin+dx*(istep-1)
        bess1=bess1+dx*(cosh(t*cos(x))*((sin(x))**(2.0*tmp1)))
        bess2=bess2+dx*(cosh(t*cos(x))*((sin(x))**(2.0*tmp2)))
     end do

     bess1=bess1+0.5*dx*(cosh(t*cos(xmin))*((sin(xmin))**(2.0*tmp1)) +cosh(t*cos(xmax))*((sin(xmax))**(2.0*tmp1)))
     bess1=bess1*((0.5*x)**tmp1)/(sqrt(pi)*gamma_func_f(tmp1+0.5))
     bess2=bess2+0.5*dx*(cosh(t*cos(xmin))*((sin(xmin))**(2.0*tmp2)) +cosh(t*cos(xmax))*((sin(xmax))**(2.0*tmp2)))
     bess2=bess2*((0.5*x)**tmp2)/(sqrt(pi)*gamma_func_f(tmp2+0.5))

     tmp=tmp1

     do while(tmp/=nu)  ! tmp=nu になったら, 求める項になったと判断する.
        bess0=2.0*tmp1*bess1/t-bess2
        tmp=tmp-1.0
        tmp1=tmp1-1.0
        bess2=bess1
        bess1=bess0  ! 項の繰り下げ
     end do

     df_bessj_fnoni=bess1

  end if

  return
end function

double precision function df_bessy_d( n, z )
! 整数次の変形ノイマン関数を計算する.
! 計算には, 式：
! $$K_n(x)=\int^{\infty}_{0}{e^{-z\cosh{t}} \cosh{nt} dt} $$
! ただし, $n>=0$. $n<0$については, 変形ノイマン関数の漸化式:
! $$K_{\nu -1}-K_{\nu +1} =-\frac{2\nu}{x} K_{\nu} $$
! を用いる,
! 半無限領域の積分については,
! 非積分関数が 10^{-6} に達する点までで打ちきる.
! ただし, この方法が適切かどうかは保証できない.
  use Math_Const
  implicit none
  integer, intent(in) :: n  ! 次数
  double precision, intent(in) :: z  ! 変数
  integer :: coe1, coe2, coe
  double precision :: t, bess0, bess1, bess2
  double precision, parameter :: thres=1.0d-6
  intrinsic :: aint

  if(t<0.0d0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of df_bessy must not be negative."
     write(*,*) "Stop."
     stop
  end if

  if(n<0)then  ! nu <= -1/2 の場合の処理.
     coe1=n+1+aint(abs(real(n)))
     coe2=n+2+aint(abs(real(n)))  ! 漸化式が 3 項漸化式なので, 初期値が 2 つ.
  end if

  if(n>=0)then
     df_bessy_d=df_bessy_term1_d( n, z )+df_bessy_term2_d( n, z )
  else  ! n<0 のとき
     bess1=df_bessy_term1_d( coe1, z )+df_bessy_term2_d( coe1, z )
     bess2=df_bessy_term1_d( coe2, z )+df_bessy_term2_d( coe2, z )

     coe=coe1

     do while(coe/=n)  ! coe=n になったら, 求める項になったと判断する.
        bess0=2.0d0*coe1*bess1/t-bess2
        coe=coe-1.0d0
        coe1=coe1-1.0d0
        bess2=bess1
        bess1=bess0  ! 項の繰り下げ
     end do

     df_bessy_d=bess1
  end if

  return
end function

double precision function df_bessy_dnoni( nu, t )
! 非整数次における変形ノイマン関数を計算する.
! $K_{\nu} =\frac{1}{\sin{\nu \pi}} [I_{-\nu} (x)-I_{\nu} (x)]$
  use Math_Const
  implicit none
  double precision, intent(in) :: nu  ! 次数
  double precision, intent(in) :: t  ! 変数
  intrinsic :: aint

  if(t<=0.0d0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of df_bessy must not be negative or zero."
     write(*,*) "Stop."
     stop
  end if

  if(nu/=aint(nu))then  ! nu が整数次の場合は, bessy_f にリダイレクトする.
     df_bessy_dnoni=(df_bessj_dnoni( -nu, t )-df_bessj_dnoni( nu, t )) /(sin(nu*dble(pi)))
  else
     df_bessy_dnoni=df_bessy_d( int(nu), t )
  end if

  return
end function

real function df_bessy_f( n, z )
! 整数次の変形ノイマン関数を計算する.
! 計算には, 式：
! $$K_n(x)=\int^{\infty}_{0}{e^{-z\cosh{t}} \cosh{nt} dt} $$
! ただし, $n>=0$. $n<0$については, 変形ノイマン関数の漸化式:
! $$K_{\nu -1}-K_{\nu +1} =-\frac{2\nu}{x} K_{\nu} $$
! を用いる,
! 半無限領域の積分については,
! 非積分関数が 10^{-6} に達する点までで打ちきる.
! ただし, この方法が適切かどうかは保証できない.
  use Math_Const
  implicit none
  integer, intent(in) :: n  ! 次数
  real, intent(in) :: z  ! 変数
  integer :: coe1, coe2, coe
  real :: t, bess0, bess1, bess2
  real, parameter :: thres=1.0e-6
  intrinsic :: aint

  if(t<0.0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of df_bessy must not be negative."
     write(*,*) "Stop."
     stop
  end if

  if(n<0)then  ! nu <= -1/2 の場合の処理.
     coe1=n+1+aint(abs(real(n)))
     coe2=n+2+aint(abs(real(n)))  ! 漸化式が 3 項漸化式なので, 初期値が 2 つ.
  end if

  if(n>=0)then
     df_bessy_f=df_bessy_term1_f( n, z )+df_bessy_term2_f( n, z )
  else  ! n<0 のとき
     bess1=df_bessy_term1_f( coe1, z )+df_bessy_term2_f( coe1, z )
     bess2=df_bessy_term1_f( coe2, z )+df_bessy_term2_f( coe2, z )

     coe=coe1

     do while(coe/=n)  ! coe=n になったら, 求める項になったと判断する.
        bess0=2.0d0*coe1*bess1/t-bess2
        coe=coe-1.0d0
        coe1=coe1-1.0d0
        bess2=bess1
        bess1=bess0  ! 項の繰り下げ
     end do

     df_bessy_f=bess1
  end if

  return
end function

real function df_bessy_fnoni( nu, t )
! 非整数次における変形ノイマン関数を計算する.
! $K_{\nu} =\frac{1}{\sin{\nu \pi}} [I_{-\nu} (x)-I_{\nu} (x)]$
  use Math_Const
  implicit none
  real, intent(in) :: nu  ! 次数
  real, intent(in) :: t  ! 変数
  intrinsic :: aint

  if(t<=0.0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of df_bessy must not be negative or zero."
     write(*,*) "Stop."
     stop
  end if

  if(nu/=aint(nu))then  ! nu が整数次の場合は, bessy_f にリダイレクトする.
     df_bessy_fnoni=(df_bessj_fnoni( -nu, t )-df_bessj_fnoni( nu, t )) /(sin(nu*pi))
  else
     df_bessy_fnoni=df_bessy_f( int(nu), t )
  end if

  return
end function

real function digamma(k)
  !-- ダイガンマ関数を計算するサブルーチン ---
  !-- 使い方 ---
  !-- 関数名は "digamma(n)" で, 引数は必ず整数でなければならない
  implicit none
  integer, intent(in) :: k  ! (k+1) 項目までの計算
  integer :: j

  if (k.gt.1) then
     digamma=0.0
     do j=1,k
        digamma=digamma+1.0/j
     end do
  else
     if (k.eq.1) then
        digamma=1.0
     else
        digamma=0.0
     end if
  end if
  return
end function

real function epsilon(i,j,k)
!-- エディントンのイプシロンを計算するサブルーチン ---
!-- F77 版では利用できなかった CASE 文で振り分けを行う ---
!-- i,j,k は 1..3 の 3 種類しか存在しないという仮定のもとの関数であるので,
!-- 相対性理論でのテンソルには適用できない. ---
  implicit none
  integer, intent(in) :: i  ! 第 1 成分
  integer, intent(in) :: j  ! 第 1 成分
  integer, intent(in) :: k  ! 第 1 成分

  select case (i)

  case (1)

     select case (j)

     case (1)
        epsilon=0.0

     case (2)

        select case (k)

        case (1)
           epsilon=0.0

        case (2)
           epsilon=0.0

        case (3)
           epsilon=1.0

        end select

     case (3)

        select case (k)

        case (1)
           epsilon=0.0

        case (2)
           epsilon=-1.0

        case (3)
           epsilon=0.0

        end select
     end select

  case (2)

     select case (j)

     case (1)

        select case (k)

        case (1)
           epsilon=0.0

        case (2)
           epsilon=0.0

        case (3)
           epsilon=-1.0

        end select

     case (2)
        epsilon=0.0

     case (3)

        select case (k)

        case (1)
           epsilon=1.0

        case (2)
           epsilon=0.0

        case (3)
           epsilon=0.0

        end select
     end select

  case (3)

     select case (j)

     case (1)

        select case (k)

        case (1)
           epsilon=0.0

        case (2)
           epsilon=1.0

        case (3)
           epsilon=0.0

        end select

     case (2)

        select case (k)

        case (1)
           epsilon=-1.0

        case (2)
           epsilon=0.0

        case (3)
           epsilon=0.0

        end select

     case (3)
        epsilon=0.0

     end select
  end select

  return
end function

double precision function gamma_func_d(x)
! ガンマ関数を計算する.
! 基本方針は「岩波数学公式（特殊関数）p.5」の近似多項式を使用.
! この近似式は 0<=x<=1 でしか使えないので, ガンマ関数の等式
! $z\Gamma (z)=\Gamma (z+1)$ で近似式の適用範囲に落とし込む.
! z>1.0 の場合は,
! $\Gamma (z)=(z-1)\Gamma (z-1)=\cdots =(z-1)\cdots (x)\Gamma (x)$
! z<0.0 の場合は,
! $\Gamma (z)=\Gamma (z+1)/z=\cdots =\Gamma (x)/(z\cdots x)$
! また, ガンマ関数の性質から, 負整数では計算がストップするように設定.

  implicit none
  double precision, intent(in) :: x
  double precision :: tmp, intg
  double precision :: coe(8)
  integer :: i
  intrinsic :: aint

  if(x<0.0d0.and.x==aint(x))then
     write(*,*) "*** Error ***"
     write(*,*) " The agreement of Gamma function must not be negative and integer."
     write(*,*) "Stop"
     stop
  end if

  coe=(/-0.577191652d0, 0.988205891d0, -0.897056937d0, 0.918206857d0, -0.756704078d0, 0.482199394d0, -0.193527818d0, 0.035868343d0 /)

  if(abs(x)>1.0d0)then
     intg=aint(abs(x))  ! 小数点以下切り捨て
     if(x>1.0d0)then  ! 正負の判別
        tmp=x-intg
     else
        tmp=x+1.0d0+intg  ! 0 またぎのための +1.
     end if
  else
     tmp=x
  end if

  gamma_func_d=1.0d0

  do i=1,8
     gamma_func_d=gamma_func_d+coe(i)*(tmp**i)
  end do

  if(abs(x)>1.0d0)then  ! ガンマ関数の等式による計算
     tmp=x
     do while(tmp>1.0d0.or.tmp<0.0d0)
        if(x>1.0d0)then
           gamma_func_d=gamma_func_d*tmp
           tmp=tmp-1.0d0
        else
           gamma_func_d=gamma_func_d/tmp
           tmp=tmp+1.0d0
        end if
     end do
  end if

  return
end function

real function gamma_func_f(x)
! ガンマ関数を計算する.
! 基本方針は「岩波数学公式（特殊関数）p.5」の近似多項式を使用.
! この近似式は 0<=x<=1 でしか使えないので, ガンマ関数の等式
! $z\Gamma (z)=\Gamma (z+1)$ で近似式の適用範囲に落とし込む.
! z>1.0 の場合は,
! $\Gamma (z)=(z-1)\Gamma (z-1)=\cdots =(z-1)\cdots (x)\Gamma (x)$
! z<0.0 の場合は,
! $\Gamma (z)=\Gamma (z+1)/z=\cdots =\Gamma (x)/(z\cdots x)$
! また, ガンマ関数の性質から, 負整数では計算がストップするように設定.

  implicit none
  real, intent(in) :: x
  real :: tmp, intg
  real :: coe(8)
  integer :: i
  intrinsic :: aint

  if(x<0.0.and.x==aint(x))then
     write(*,*) "*** Error ***"
     write(*,*) " The agreement of Gamma function must not be negative and integer."
     write(*,*) "Stop"
     stop
  end if

  coe=(/-0.577191652, 0.988205891, -0.897056937, 0.918206857, -0.756704078, 0.482199394, -0.193527818, 0.035868343 /)

  if(abs(x)>1.0)then
     intg=aint(abs(x))  ! 小数点以下切り捨て
     if(x>1.0)then  ! 正負の判別
        tmp=x-intg
     else
        tmp=x+1.0+intg  ! 0 またぎのための +1.
     end if
  else
     tmp=x
  end if

  gamma_func_f=1.0

  do i=1,8
     gamma_func_f=gamma_func_f+coe(i)*(tmp**i)
  end do

  if(abs(x)>1.0)then  ! ガンマ関数の等式による計算
     tmp=x
     do while(tmp>1.0.or.tmp<0.0)
        if(x>1.0)then
           gamma_func_f=gamma_func_f*tmp
           tmp=tmp-1.0
        else
           gamma_func_f=gamma_func_f/tmp
           tmp=tmp+1.0
        end if
     end do
  end if

  return
end function

real function kaijo_f(k)
  !-- 階乗関数を計算するサブルーチン ---
  !-- 使い方 ---
  !-- 関数名は "kaijo(k)" で, 引数 "k" には整数のみ入れること
  implicit none
  real, intent(in) :: k
  integer :: j

  if (k.lt.2.0) then
     kaijo_f=1.0
  else
     kaijo_f=1.0
     do j=1,int(k)
        kaijo_f=real(j)*kaijo_f
     end do
  end if

  return
end function

integer function kaijo_i(k)
  !-- 階乗関数を計算するサブルーチン ---
  !-- 使い方 ---
  !-- 関数名は "kaijo(k)" で, 引数 "k" には整数のみ入れること
  implicit none
  integer, intent(in) :: k
  integer :: j

  if (k.lt.2) then
     kaijo_i=1
  else
     kaijo_i=1
     do j=1,k
        kaijo_i=j*kaijo_i
     end do
  end if

  return
end function

double precision function sp_bessj_d( m, t )
! 第1種球ベッセル関数の計算.
! ベッセル関数と球ベッセル関数の関係から.
  use Math_Const
  implicit none
  integer, intent(in) :: m  ! 次数
  double precision, intent(in) :: t

  if(t<=0.0d0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of sp_bessj must not be negative or zero."
     write(*,*) "Stop."
     stop
  end if

  sp_bessj_d=sqrt(0.5d0*dble(pi)/t)*bessj_dnoni( dble(m)+0.5d0, t )

  return
end function

real function sp_bessj_f( m, t )
! 第1種球ベッセル関数の計算.
! ベッセル関数と球ベッセル関数の関係から.
  use Math_Const
  implicit none
  integer, intent(in) :: m  ! 次数
  real, intent(in) :: t

  if(t<=0.0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of sp_bessj must not be negative or zero."
     write(*,*) "Stop."
     stop
  end if

  sp_bessj_f=sqrt(0.5*pi/t)*bessj_fnoni( real(m)+0.5, t )

  return
end function

double precision function sp_bessy_d( m, t )
! 第2種球ベッセル関数の計算.
! 第1種球ベッセル関数との関係から.
  use Math_Const
  implicit none
  integer, intent(in) :: m  ! 次数
  double precision, intent(in) :: t
  double precision :: coe1

  if(t<=0.0d0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of sp_bessy must not be negative or zero."
     write(*,*) "Stop."
     stop
  end if

  if(mod(abs(m+1),2)==0)then  ! (-1)^n の計算コストを減らすため, ここで正負判定.
     coe1=1.0d0  ! $m+1 = \pm 2n$ なので, coe1=1
  else
     coe1=-1.0d0
  end if

  sp_bessy_d=coe1*sp_bessj_d( -m-1, t )

  return
end function

real function sp_bessy_f( m, t )
! 第2種球ベッセル関数の計算.
! 第1種球ベッセル関数との関係から.
  use Math_Const
  implicit none
  integer, intent(in) :: m  ! 次数
  real, intent(in) :: t
  real :: coe1

  if(t<=0.0)then
     write(*,*) "*** ERROR ***"
     write(*,*) "The argument of sp_bessj must not be negative or zero."
     write(*,*) "Stop."
     stop
  end if

  if(mod(abs(m+1),2)==0)then  ! (-1)^n の計算コストを減らすため, ここで正負判定.
     coe1=1.0  ! $m+1 = \pm 2n$ なので, coe1=1
  else
     coe1=-1.0
  end if

  sp_bessy_f=coe1*sp_bessj_f( -m-1, t )

  return
end function