Class | Special_Function |
In: |
special_function.f90
|
— 特殊関数を計算するモジュール —
Function : | |||
Full_Ellip1_Func_d : | double precision | ||
k : | double precision, intent(in)
|
第 1 種完全楕円関数計算
Alias for Full_Ellip1_Func_d
Function : | |||
Full_Ellip1_Func_f : | real | ||
k : | real, intent(in)
|
第 1 種完全楕円関数計算
Alias for Full_Ellip1_Func_f
Function : | |||
Full_Ellip1_Func_d : | double precision | ||
k : | double precision, intent(in)
|
第 1 種完全楕円関数計算
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
Function : | |||
Full_Ellip1_Func_f : | real | ||
k : | real, intent(in)
|
第 1 種完全楕円関数計算
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
Function : | |||
Full_Ellip2_Func_d : | double precision | ||
k : | double precision, intent(in)
|
第二種完全楕円関数
Alias for Full_Ellip2_Func_d
Function : | |||
Full_Ellip2_Func_f : | real | ||
k : | real, intent(in)
|
第二種完全楕円関数
Alias for Full_Ellip2_Func_f
Function : | |||
Full_Ellip2_Func_d : | double precision | ||
k : | double precision, intent(in)
|
第二種完全楕円関数
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
Function : | |||
Full_Ellip2_Func_f : | real | ||
k : | real, intent(in)
|
第二種完全楕円関数
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 : | |||
nmax : | integer, intent(in)
| ||
mmax : | integer, intent(in)
| ||
k(0:nmax,mmax) : | double precision, intent(inout)
|
**********************************
ベッセル関数のゼロ点を計算する *
**********************************
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 : | |||
nmax : | integer, intent(in)
| ||
mmax : | integer, intent(in)
| ||
k(0:nmax,mmax) : | real, intent(inout)
|
**********************************
ベッセル関数のゼロ点を計算する *
**********************************
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
Function : | |||
bessj_dnoni : | double precision | ||
nu : | double precision, intent(in)
| ||
t : | double precision, intent(in)
|
次数が非整数におけるベッセル関数を計算する. 非整数次ではシュレーフリ積分が成り立たないので, 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$ に限る.
Alias for bessj_dnoni
Function : | |||
bessj_fnoni : | real | ||
nu : | real, intent(in)
| ||
t : | real, intent(in)
|
次数が非整数におけるベッセル関数を計算する. 非整数次ではシュレーフリ積分が成り立たないので, 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$ に限る.
Alias for bessj_fnoni
Function : | |||
bessj_d : | double precision | ||
m : | integer, intent(in)
| ||
t : | double precision, intent(in)
|
第 I 種ベッセル関数を計算する
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
Function : | |||
bessj_dnoni : | double precision | ||
nu : | double precision, intent(in)
| ||
t : | double precision, intent(in)
|
次数が非整数におけるベッセル関数を計算する. 非整数次ではシュレーフリ積分が成り立たないので, 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$ に限る.
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
Function : | |||
bessj_f : | real | ||
m : | integer, intent(in)
| ||
t : | real, intent(in)
|
第 I 種ベッセル関数を計算する
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
Function : | |||
bessj_fnoni : | real | ||
nu : | real, intent(in)
| ||
t : | real, intent(in)
|
次数が非整数におけるベッセル関数を計算する. 非整数次ではシュレーフリ積分が成り立たないので, 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$ に限る.
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
Function : | |||
bessy_d : | double precision | ||
n : | integer, intent(in)
| ||
z : | double precision, intent(in)
|
整数次のノイマン関数を計算する. 計算には, シュレーフリの積分表示を用い, 半無限領域の積分については, 非積分関数が 10^{-6} に達する点までで打ちきる. また, 半無限積分の非積分関数は 2 つあるが, それぞれについて項の値を 毎回評価し, 上のしきい値を越えた時点でその項は積分をやめるようにする. ただし, この方法が適切かどうかは保証できない.
Alias for bessy_d
Function : | |||
bessy_dnoni : | double precision | ||
nu : | double precision, intent(in)
| ||
t : | double precision, intent(in)
|
非整数次におけるノイマン関数を計算する. $Y_{nu} =frac{1}{sin{nu pi}} [cos{nu pi }J_{nu} (x)-J_{-nu} (x)]$
Alias for bessy_dnoni
Function : | |||
bessy_fnoni : | real | ||
nu : | real, intent(in)
| ||
t : | real, intent(in)
|
非整数次におけるノイマン関数を計算する. $Y_{nu} =frac{1}{sin{nu pi}} [cos{nu pi }J_{nu} (x)-J_{-nu} (x)]$
Alias for bessy_fnoni
Function : | |||
bessy_d : | double precision | ||
n : | integer, intent(in)
| ||
z : | double precision, intent(in)
|
整数次のノイマン関数を計算する. 計算には, シュレーフリの積分表示を用い, 半無限領域の積分については, 非積分関数が 10^{-6} に達する点までで打ちきる. また, 半無限積分の非積分関数は 2 つあるが, それぞれについて項の値を 毎回評価し, 上のしきい値を越えた時点でその項は積分をやめるようにする. ただし, この方法が適切かどうかは保証できない.
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
Function : | |||
bessy_dnoni : | double precision | ||
nu : | double precision, intent(in)
| ||
t : | double precision, intent(in)
|
非整数次におけるノイマン関数を計算する. $Y_{nu} =frac{1}{sin{nu pi}} [cos{nu pi }J_{nu} (x)-J_{-nu} (x)]$
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
Function : | |||
bessy_f : | real | ||
n : | integer, intent(in)
| ||
z : | real, intent(in)
|
整数次のノイマン関数を計算する. 計算には, シュレーフリの積分表示を用い, 半無限領域の積分については, 非積分関数が 10^{-6} に達する点までで打ちきる. また, 半無限積分の非積分関数は 2 つあるが, それぞれについて項の値を 毎回評価し, 上のしきい値を越えた時点でその項は積分をやめるようにする. ただし, この方法が適切かどうかは保証できない.
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
Function : | |||
bessy_fnoni : | real | ||
nu : | real, intent(in)
| ||
t : | real, intent(in)
|
非整数次におけるノイマン関数を計算する. $Y_{nu} =frac{1}{sin{nu pi}} [cos{nu pi }J_{nu} (x)-J_{-nu} (x)]$
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
Subroutine : | |||
nmax : | integer, intent(in)
| ||
mmax : | integer, intent(in)
| ||
k(0:nmax,mmax) : | double precision, intent(inout)
|
**********************************
ベッセル関数のゼロ点を計算する *
**********************************
Alias for besdzero
Subroutine : | |||
nmax : | integer, intent(in)
| ||
mmax : | integer, intent(in)
| ||
k(0:nmax,mmax) : | real, intent(inout)
|
**********************************
ベッセル関数のゼロ点を計算する *
**********************************
Alias for besfzero
Function : | |||
beta_func_d : | double precision | ||
x : | double precision, intent(in)
| ||
y : | double precision, intent(in)
|
ベータ関数を計算するルーチン. ベータ関数とガンマ関数の間の関係式 $B(x,y)=frac{Gamma (x)Gamma (y)}{Gamma (x+y)} $ を用いることによって, ガンマ関数からの計算を行う. gamma_func において, 引数が特異点の場合, 警告を出す処理をしてあるので, ベータ関数の特異点においても警告が出て落ちる仕様になっている.
Alias for beta_func_d
Function : | |||
beta_func_f : | real | ||
x : | real, intent(in)
| ||
y : | real, intent(in)
|
ベータ関数を計算するルーチン. ベータ関数とガンマ関数の間の関係式 $B(x,y)=frac{Gamma (x)Gamma (y)}{Gamma (x+y)} $ を用いることによって, ガンマ関数からの計算を行う. gamma_func において, 引数が特異点の場合, 警告を出す処理をしてあるので, ベータ関数の特異点においても警告が出て落ちる仕様になっている.
Alias for beta_func_f
Function : | |||
beta_func_d : | double precision | ||
x : | double precision, intent(in)
| ||
y : | double precision, intent(in)
|
ベータ関数を計算するルーチン. ベータ関数とガンマ関数の間の関係式 $B(x,y)=frac{Gamma (x)Gamma (y)}{Gamma (x+y)} $ を用いることによって, ガンマ関数からの計算を行う. gamma_func において, 引数が特異点の場合, 警告を出す処理をしてあるので, ベータ関数の特異点においても警告が出て落ちる仕様になっている.
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
Function : | |||
beta_func_f : | real | ||
x : | real, intent(in)
| ||
y : | real, intent(in)
|
ベータ関数を計算するルーチン. ベータ関数とガンマ関数の間の関係式 $B(x,y)=frac{Gamma (x)Gamma (y)}{Gamma (x+y)} $ を用いることによって, ガンマ関数からの計算を行う. gamma_func において, 引数が特異点の場合, 警告を出す処理をしてあるので, ベータ関数の特異点においても警告が出て落ちる仕様になっている.
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
Function : | |||
delta : | real | ||
t : | integer, intent(in)
| ||
u : | integer, intent(in)
|
クロネッカーのデルタを計算するサブルーチン
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
Function : | |||
df_bessj_d : | double precision | ||
m : | integer, intent(in)
| ||
t : | double precision, intent(in)
|
整数次における第 1 種変形ベッセル関数の計算 df_bessj_fnoni へリダイレクト
Alias for df_bessj_d
Function : | |||
df_bessj_f : | real | ||
m : | integer, intent(in)
| ||
t : | real, intent(in)
|
整数次における第 1 種変形ベッセル関数の計算 df_bessj_fnoni へリダイレクト
Alias for df_bessj_f
Function : | |||
df_bessj_dnoni : | double precision | ||
nu : | double precision, intent(in)
| ||
t : | double precision, intent(in)
|
非整数次における第 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} $$ を用いて次数を下げる.
Alias for df_bessj_dnoni
Function : | |||
df_bessj_fnoni : | real | ||
nu : | real, intent(in)
| ||
t : | real, intent(in)
|
非整数次における第 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} $$ を用いて次数を下げる.
Alias for df_bessj_fnoni
Function : | |||
df_bessj_d : | double precision | ||
m : | integer, intent(in)
| ||
t : | double precision, intent(in)
|
整数次における第 1 種変形ベッセル関数の計算 df_bessj_fnoni へリダイレクト
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
Function : | |||
df_bessj_dnoni : | double precision | ||
nu : | double precision, intent(in)
| ||
t : | double precision, intent(in)
|
非整数次における第 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} $$ を用いて次数を下げる.
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
Function : | |||
df_bessj_f : | real | ||
m : | integer, intent(in)
| ||
t : | real, intent(in)
|
整数次における第 1 種変形ベッセル関数の計算 df_bessj_fnoni へリダイレクト
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
Function : | |||
df_bessj_fnoni : | real | ||
nu : | real, intent(in)
| ||
t : | real, intent(in)
|
非整数次における第 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} $$ を用いて次数を下げる.
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
Function : | |||
df_bessy_d : | double precision | ||
n : | integer, intent(in)
| ||
z : | double precision, intent(in)
|
整数次の変形ノイマン関数を計算する. 計算には, 式: $$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} に達する点までで打ちきる. ただし, この方法が適切かどうかは保証できない.
Alias for df_bessy_d
Function : | |||
df_bessy_f : | real | ||
n : | integer, intent(in)
| ||
z : | real, intent(in)
|
整数次の変形ノイマン関数を計算する. 計算には, 式: $$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} に達する点までで打ちきる. ただし, この方法が適切かどうかは保証できない.
Alias for df_bessy_f
Function : | |||
df_bessy_dnoni : | double precision | ||
nu : | double precision, intent(in)
| ||
t : | double precision, intent(in)
|
非整数次における変形ノイマン関数を計算する. $K_{nu} =frac{1}{sin{nu pi}} [I_{-nu} (x)-I_{nu} (x)]$
Alias for df_bessy_dnoni
Function : | |||
df_bessy_fnoni : | real | ||
nu : | real, intent(in)
| ||
t : | real, intent(in)
|
非整数次における変形ノイマン関数を計算する. $K_{nu} =frac{1}{sin{nu pi}} [I_{-nu} (x)-I_{nu} (x)]$
Alias for df_bessy_fnoni
Function : | |||
df_bessy_d : | double precision | ||
n : | integer, intent(in)
| ||
z : | double precision, intent(in)
|
整数次の変形ノイマン関数を計算する. 計算には, 式: $$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} に達する点までで打ちきる. ただし, この方法が適切かどうかは保証できない.
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
Function : | |||
df_bessy_dnoni : | double precision | ||
nu : | double precision, intent(in)
| ||
t : | double precision, intent(in)
|
非整数次における変形ノイマン関数を計算する. $K_{nu} =frac{1}{sin{nu pi}} [I_{-nu} (x)-I_{nu} (x)]$
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
Function : | |||
df_bessy_f : | real | ||
n : | integer, intent(in)
| ||
z : | real, intent(in)
|
整数次の変形ノイマン関数を計算する. 計算には, 式: $$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} に達する点までで打ちきる. ただし, この方法が適切かどうかは保証できない.
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
Function : | |||
df_bessy_fnoni : | real | ||
nu : | real, intent(in)
| ||
t : | real, intent(in)
|
非整数次における変形ノイマン関数を計算する. $K_{nu} =frac{1}{sin{nu pi}} [I_{-nu} (x)-I_{nu} (x)]$
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
Function : | |||
digamma : | real | ||
k : | integer, intent(in)
|
— ダイガンマ関数を計算するサブルーチン — — 使い方 — — 関数名は "digamma(n)" で, 引数は必ず整数でなければならない
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
Function : | |||
epsilon : | real | ||
i : | integer, intent(in)
| ||
j : | integer, intent(in)
| ||
k : | integer, intent(in)
|
— エディントンのイプシロンを計算するサブルーチン — — F77 版では利用できなかった CASE 文で振り分けを行う — — i,j,k は 1..3 の 3 種類しか存在しないという仮定のもとの関数であるので, — 相対性理論でのテンソルには適用できない. —
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
Function : | |
gamma_func_d : | double precision |
x : | double precision, intent(in) |
ガンマ関数を計算する. 基本方針は「岩波数学公式(特殊関数)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)$ また, ガンマ関数の性質から, 負整数では計算がストップするように設定.
Alias for gamma_func_d
Function : | |
gamma_func_f : | real |
x : | real, intent(in) |
ガンマ関数を計算する. 基本方針は「岩波数学公式(特殊関数)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)$ また, ガンマ関数の性質から, 負整数では計算がストップするように設定.
Alias for gamma_func_f
Function : | |
gamma_func_d : | double precision |
x : | double precision, intent(in) |
ガンマ関数を計算する. 基本方針は「岩波数学公式(特殊関数)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)$ また, ガンマ関数の性質から, 負整数では計算がストップするように設定.
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
Function : | |
gamma_func_f : | real |
x : | real, intent(in) |
ガンマ関数を計算する. 基本方針は「岩波数学公式(特殊関数)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)$ また, ガンマ関数の性質から, 負整数では計算がストップするように設定.
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
Function : | |
kaijo_f : | real |
k : | real, intent(in) |
— 階乗関数を計算するサブルーチン — — 使い方 — — 関数名は "kaijo(k)" で, 引数 "k" には整数のみ入れること
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
Function : | |
kaijo_i : | integer |
k : | integer, intent(in) |
— 階乗関数を計算するサブルーチン — — 使い方 — — 関数名は "kaijo(k)" で, 引数 "k" には整数のみ入れること
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
Function : | |||
sp_bessj_d : | double precision | ||
m : | integer, intent(in)
| ||
t : | double precision, intent(in) |
第1種球ベッセル関数の計算. ベッセル関数と球ベッセル関数の関係から.
Alias for sp_bessj_d
Function : | |||
sp_bessj_f : | real | ||
m : | integer, intent(in)
| ||
t : | real, intent(in) |
第1種球ベッセル関数の計算. ベッセル関数と球ベッセル関数の関係から.
Alias for sp_bessj_f
Function : | |||
sp_bessj_d : | double precision | ||
m : | integer, intent(in)
| ||
t : | double precision, intent(in) |
第1種球ベッセル関数の計算. ベッセル関数と球ベッセル関数の関係から.
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
Function : | |||
sp_bessj_f : | real | ||
m : | integer, intent(in)
| ||
t : | real, intent(in) |
第1種球ベッセル関数の計算. ベッセル関数と球ベッセル関数の関係から.
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
Function : | |||
sp_bessy_d : | double precision | ||
m : | integer, intent(in)
| ||
t : | double precision, intent(in) |
第2種球ベッセル関数の計算. 第1種球ベッセル関数との関係から.
Alias for sp_bessy_d
Function : | |||
sp_bessy_f : | real | ||
m : | integer, intent(in)
| ||
t : | real, intent(in) |
第2種球ベッセル関数の計算. 第1種球ベッセル関数との関係から.
Alias for sp_bessy_f
Function : | |||
sp_bessy_d : | double precision | ||
m : | integer, intent(in)
| ||
t : | double precision, intent(in) |
第2種球ベッセル関数の計算. 第1種球ベッセル関数との関係から.
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
Function : | |||
sp_bessy_f : | real | ||
m : | integer, intent(in)
| ||
t : | real, intent(in) |
第2種球ベッセル関数の計算. 第1種球ベッセル関数との関係から.
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