ここでは、非線形方程式の解を数値的に求める方法である、
二分法、
挟み撃ち(False position)法、
Anderson-Björk法、
Brent法、
Newton法、
Steffensen法
等について紹介します。
- 問題設定
- まとめ
- 数値解法
- 複数のゼロ点を見つけたい場合
問題設定
区間\([a,b]\)で定義された実関数\(f(x)\)に
\(
f(x)=0
\)
を満たす\(x\)が1つある。\(x\)を求めよ。但し\(f(a),f(b)\ne 0\)。
まとめ
1変数の場合:Brent法(二分法と逆2次補間、挟み撃ち法の組み合わせ)
多変数の場合:Newton法
を使うのが良いでしょう。
数値解法
1変数の問題で、
教育上良く使われる方法は二分法
実用的な手法はBrent法
です。
またNewton法は多変数の場合にも複素数の場合でも容易に拡張できるので、その意味で実用的です。
区間\([a,b]\)にゼロ点が1つ存在する事を数学的に言えば、\(f(a)f(b)\lt 0\)ということです。
二分法
要点
・解が確実に見つかります。
・関数の振る舞いが非連続であっても、たちが悪い関数でも確実ですが、収束は遅いです。
計算方法
二分法は位置\([a,b]\)における関数の符号の情報だけを見てゼロ点を推測します。
なので、区間内にゼロ点がある事が分かっていれば、そこを境として符号が違うので確実に解を囲い込んでいくことが出来ます。
教育的に分かりやすい方法であり、根を探すにあたり失敗が無い方法ですが、
滑らかな関数であっても計算時間がかかるため、あまり実用的ではありません。
収束速度について
2分法では、1回の計算あたり範囲が\(1/2\)になるため、漸化式
\(
\displaystyle \varepsilon_n=\varepsilon_{n-1}\cdot 2^{-1}
\)
が成立するため、
\(
\varepsilon_n=\varepsilon_{0}\cdot 2^{-n}
\)
が導けます。ここで\(\varepsilon_{0}\)は初期のxの範囲(\(\varepsilon_0=|b-a|\))を表します。
収束精度と計算回数の関係を決めるためにはnについて解いて、
\(
\begin{align}
\varepsilon_n &=2^{-n} \varepsilon_{0} \\
2^n &=\frac{\varepsilon_0}{\varepsilon_n} \\
n &=\log_2\left(\frac{\varepsilon_0}{\varepsilon_n}\right) \\
\mbox{または}& \\
n &=\frac{\ln\left(\varepsilon_0/\varepsilon_n\right)}{\ln{2}}
\end{align}
\)
より、例えば初期の解の範囲(\(\varepsilon_0\))を1, 解を\(10^{-14}\)まで収束させようとすれば、大体\(n=47\)となり、47回、2分法を繰り返す必要があります。
逆に言えば、どんな状況でも47回繰り返せば相対誤差を14桁収束させることが出来るということです。
収束の判定は
要求精度\(\epsilon_{\text{tol}}\)、機械精度\(\epsilon_{\text{mac}}\)、解の存在範囲\(\delta\)、新たな解の推定値\(x\)、
とすると、
\(
\delta \lt 4\epsilon_{\text{mac}}|x|+\epsilon_{\text{tol}}
\)
もしくは
\(
f(x)=0
\)
で判定します。
この意味は、解の存在範囲を\(\pm 2\epsilon_{\text{mac}}\)の範囲まで特定するか、解の存在範囲が要求精度\(\epsilon_{\text{tol}}\)まで達するかのどちらかが満たされるかで判定します。
Fortranプログラムはこちら。
program main
implicit none
double precision::a,b,tol,sol
double precision,external::f
a=10d0
b=0.5d0
tol=1d-6
call bisection(a,b,f,tol,sol)
write(6,*)sol
stop
end program main
function f(x)
implicit none
double precision,intent(in)::x
double precision::f
f=2d0*(atan(x-3d0)+0.5e0*sin(x-3d0))
return
end function f
subroutine bisection(ax,bx,f,tol,ans)
implicit none
double precision,intent(in)::ax,bx,tol
double precision,intent(out)::ans
double precision,external::f
integer::i
integer,parameter::itmax=100
double precision::a,b,c,fa,fb,fc
double precision::tol1,xm
double precision,parameter::eps=epsilon(1d0)
a=ax
b=bx
fa=f(a)
fb=f(b)
if ((fa .eq.0.0d0 .or. fb .eq. 0.0d0).or. &
(fa * (fb/dabs(fb)) .le. 0.0d0))then
do i=1,itmax
!if(a.gt.b)write(6,'(2f24.16)')b,a
!if(b.ge.a)write(6,'(2f24.16)')a,b
c=(a+b)*0.5d0
fc=f(c)
if(fa*fc.gt.0d0)then
a=c
fa=fc
else
b=c
fb=fc
endif
tol1=2.0d0*eps*dabs(c)+0.5d0*tol
xm = 0.5d0*(a-b)
if ((dabs(xm).le.tol1).or.(fc.eq.0.0d0))exit
enddo
ans=c
else
write(6,*)'f(ax) and f(bx) do not have different signs,',&
' zeroin is aborting'
end if
return
end subroutine bisection
二分法でやると以下の通り20回必要になります。
$ gfortran bisection.f90
$ ./a.out
0.5000000000000000 10.0000000000000000
0.5000000000000000 5.2500000000000000
2.8750000000000000 5.2500000000000000
2.8750000000000000 4.0625000000000000
2.8750000000000000 3.4687500000000000
2.8750000000000000 3.1718750000000000
2.8750000000000000 3.0234375000000000
2.9492187500000000 3.0234375000000000
2.9863281250000000 3.0234375000000000
2.9863281250000000 3.0048828125000000
2.9956054687500000 3.0048828125000000
2.9956054687500000 3.0002441406250000
2.9979248046875000 3.0002441406250000
2.9990844726562500 3.0002441406250000
2.9996643066406250 3.0002441406250000
2.9999542236328125 3.0002441406250000
2.9999542236328125 3.0000991821289062
2.9999542236328125 3.0000267028808594
2.9999904632568359 3.0000267028808594
2.9999904632568359 3.0000085830688477
2.9999995231628418 3.0000085830688477
2.9999995231628418 3.0000040531158447
2.9999995231628418 3.0000017881393433
2.9999995231628418 3.0000006556510925
3.0000000894069672
$
6桁収束するために24回も評価回数が必要です。
計算時間を気にしないのならば良い方法ですが、やはり遅いです。
挟み撃ち法(False position法)
要点
・解が確実に見つかります。
・勢いよくゼロ点を横切っていない場合、収束が遅くなります。
計算方法
二分法との違いはゼロ点の推測に用いる情報量です。
二分法では位置\([a,b]\)における関数の符号だけを見てゼロ点を推測しますが、
挟み撃ち法では位置\([a,b]\)における関数の値も見てゼロ点を推測しています。
この挟み撃ち法の推測は、点\((a,f(a)),(b,f(b))\)を結ぶ直線が通るゼロ点して値を推測するのです。
一つ、挟み撃ち法の説明を見ていた時に、解の囲い込み方法が2通りあるようです。
オリジナルのものは片方の点を絶対に変えない方法のようですが、二分法と同じように決めている物もあります。
ここでは、二分法と同じように決めていく後者の方法を載せておきます。
二分法の新しい点を決める所だけ変えればプログラムは完了です。
program main
implicit none
double precision::a,b,tol,sol
double precision,external::f
a=10d0
b=0.5d0
tol=1d-6
call false(a,b,f,tol,sol)
write(6,*)sol
stop
end program main
function f(x)
implicit none
double precision,intent(in)::x
double precision::f
f=2d0*(atan(x-3d0)+0.5e0*sin(x-3d0))
return
end function f
subroutine false(ax,bx,f,tol,ans)
implicit none
double precision,intent(in)::ax,bx,tol
double precision,intent(out)::ans
double precision,external::f
integer::i
integer,parameter::itmax=100
double precision::a,b,c,fa,fb,fc
double precision::tol1,xm
double precision,parameter::eps=epsilon(1d0)
a=ax
b=bx
fa=f(a)
fb=f(b)
if ((fa .eq.0.0d0 .or. fb .eq. 0.0d0).or. &
(fa * (fb/dabs(fb)) .le. 0.0d0))then
do i=1,itmax
!if(a.gt.b)write(6,'(2f24.16)')b,a
!if(b.ge.a)write(6,'(2f24.16)')a,b
c = a-fa*(a-b)/(fa-fb)
fc=f(c)
if(fa*fc.gt.0d0)then
a=c
fa=fc
else
b=c
fb=fc
endif
tol1=2.0d0*eps*dabs(c)+0.5d0*tol
xm = 0.5d0*(a-b)
if ((dabs(xm).le.tol1).or.(fc.eq.0.0d0))exit
enddo
ans=c
else
write(6,*)'f(ax) and f(bx) do not have different signs,',&
' zeroin is aborting'
end if
return
end subroutine false
要求精度を6桁にすると、実行結果は
$ gfortran false.f90
$ ./a.out
0.5000000000000000 10.0000000000000000
0.5000000000000000 4.8581311942172727
2.6310989812608572 4.8581311942172727
2.6310989812608572 3.1997221817009311
2.9967206978247356 3.1997221817009311
2.9967206978247356 3.0000354381074144
2.9999999998952847 3.0000354381074144
3.0000000000000000
$
となり、初めの1回は無視すると6回で収束に至っていることが分かります。早いですね。
Anderson-Björk法
アンダーソン・ビョーク法と呼ばれるアルゴリズムです。
詳しくは
求根アルゴリズム 挟み撃ち法 / イリノイ法 / アンダーソン・ビョーク法 [2/3] -サブロウ丸
のページが詳しいのでそちらを参照してください。
この方法は割線法が遅くなってしまう時の対処です。
program main
implicit none
double precision::a,b,tol,sol
double precision,external::f
a=10d0
b=0.5d0
tol=1d-6
call AndersonBjork(a,b,f,tol,sol)
write(6,*)sol
stop
end program main
function f(x)
implicit none
double precision,intent(in)::x
double precision::f
f=2d0*(atan(x-3d0)+0.5e0*sin(x-3d0))
return
end function f
subroutine AndersonBjork(ax,bx,f,tol,ans)
implicit none
double precision,intent(in)::ax,bx,tol
double precision,intent(out)::ans
double precision,external::f
integer::i
integer,parameter::itmax=100
double precision::a,b,c,fa,fb,fc
double precision::tol1,xm,m
double precision,parameter::eps=epsilon(1d0)
a=ax
b=bx
fa=f(a)
fb=f(b)
if ((fa .eq.0.0d0 .or. fb .eq. 0.0d0).or. &
(fa * (fb/dabs(fb)) .le. 0.0d0))then
do i=1,itmax
!if(a.gt.b)write(6,'(2f24.16)')b,a
!if(b.ge.a)write(6,'(2f24.16)')a,b
c = a-fa*(a-b)/(fa-fb)
fc=f(c)
if(fa*fc.gt.0d0)then
if(fc/fa.lt.1d0)then
m=1d0-fc/fa
else
m=0.5d0
endif
fb=m*fb
a=c
fa=fc
else
if(fc/fb.lt.1d0)then
m=1d0-fc/fb
else
m=0.5d0
endif
fa=m*fa
b=c
fb=fc
endif
tol1=2.0d0*eps*dabs(c)+0.5d0*tol
xm = 0.5d0*(a-b)
if ((dabs(xm).le.tol1).or.(fc.eq.0.0d0))exit
enddo
ans=c
else
write(6,*)'f(ax) and f(bx) do not have different signs,',&
' zeroin is aborting'
end if
return
end subroutine AndersonBjork
Brent法
要点
・解が確実に見つかります。
・基本的には逆二次補間(inverse quadratic interpolation)で根を探索します。
・逆二次補間が原理的に出来ない場合(二つ以上の関数値が同じ場合など)では挟み撃ち法を行います。
・”探索が失敗”した時は二分法に切り替えて根を探します。
・1変数の場合、実用的な方法として推奨されています。
計算方法
逆二次補間は3点を結ぶ逆二次関数(上下に凸ではなく、左右に凸をもつ関数)としてラグランジュ補間をして、その根をゼロ点の位置として用いる方法です。
しかし、逆二次補間を行う際に必要な3点の内、2点以上が同じ関数値を持つと解が発散する、という問題があるため、その時は挟み撃ち法に切り替えて計算を行います。
二分法は、逆二次補間や挟み撃ち法を用いた為に解の収束が遅くなる、と判定されたときに使われます。
実際に動かしてみると逆二次補間よりも挟み撃ち法が使われる頻度が多いようです。
詳細は(Van Wijngaarden-Dekker-Brent法, William H. Press, Saul A. Teukolsky, William T. Vetterling, Brian P. Flannery著, 丹慶勝市ら訳(1993) 『Numerical Recipes in C [日本語版]C言語による数値計算のレシピ』 技術評論社 261pp.)に書いてありますので、こちらを参照してください。
プログラム自体はパブリックドメインのNetlibにあるもの(zeroin.f)を基本としましょう。ただし、Fortran77で掛かれているので並列計算を考えた時に厄介です。文番号を消したものを置いておきます。
program main
implicit none
double precision::a,b,tol,sol
double precision,external::f
a=10d0
b=0.5d0
tol=1d-6
call brent(a,b,f,tol,sol)
write(6,*)sol
stop
end program main
function f(x)
implicit none
double precision,intent(in)::x
double precision::f
f=2d0*(atan(x-3d0)+0.5e0*sin(x-3d0))
return
end function f
subroutine brent(ax,bx,f,tol,ans)
implicit none
double precision,intent(in)::ax,bx,tol
double precision,intent(out)::ans
double precision,external::f
!
! a zero of the function f(x) is computed in the interval ax,bx .
!
! input..
!
! ax left endpoint of initial interval
! bx right endpoint of initial interval
! f function subprogram which evaluates f(x) for any x in
! the interval ax,bx
! tol desired length of the interval of uncertainty of the
! final result (.ge.0.)
!
! output..
!
! zeroin abscissa approximating a zero of f in the interval ax,bx
!
! it is assumed that f(ax) and f(bx) have opposite signs
! this is checked, and an error message is printed if this is not
! satisfied. zeroin returns a zero x in the given interval
! ax,bx to within a tolerance 4*macheps*abs(x)+tol, where macheps is
! the relative machine precision defined as the smallest representable
! number such that 1.+macheps .gt. 1.
! this function subprogram is a slightly modified translation of
! the algol 60 procedure zero given in richard brent, algorithms for
! minimization without derivatives, prentice-hall, inc. (1973).
!
! Original https://netlib.sandia.gov/go/zeroin.f
!
! modified by sikino for fortran90. (2018/07/22), yyyy/mm/dd
! http://slpr.sakura.ne.jp/qp/
double precision::a,b,c,d,e,eps,fa,fb,fc,tol1,xm,p,q,r,s,t
integer::finishkey
finishkey=0
eps = EPSILON(1.D0)
tol1 = eps+1.0d0
a=ax
b=bx
fa=f(a)
fb=f(b)
! check that f(ax) and f(bx) have different signs
if ((fa .eq.0.0d0 .or. fb .eq. 0.0d0).or. &
(fa * (fb/dabs(fb)) .le. 0.0d0))then
do while(finishkey.eq.0)
c=a
fc=fa
d=b-a
e=d
t=-1d0
do while(t.le.0d0)
if(c.gt.b)write(6,'(2e24.10)')b,c
if(b.ge.c)write(6,'(2e24.10)')c,b
if (dabs(fc).lt.dabs(fb))then
a=b
b=c
c=a
fa=fb
fb=fc
fc=fa
endif
tol1=2.0d0*eps*dabs(b)+0.5d0*tol
xm = 0.5d0*(c-b)
if ((dabs(xm).le.tol1).or.(fb.eq.0.0d0))then
finishkey=1; exit
endif
!
! see if a bisection is forced
!
if ((dabs(e).lt.tol1).or.(dabs(fa).le.dabs(fb)))then
d=xm
e=d
else
s=fb/fa
if (a.eq.c)then
!
! linear interpolation
!
p=2.0d0*xm*s
q=1.0d0-s
else
!
! inverse quadratic interpolation
!
q=fa/fc
r=fb/fc
p=s*(2.0d0*xm*q*(q-r)-(b-a)*(r-1.0d0))
q=(q-1.0d0)*(r-1.0d0)*(s-1.0d0)
endif
if (p.gt.0.0d0)then
q=-q
else
p=-p
endif
s=e
e=d
if (((2.0d0*p).lt.(3.0d0*xm*q-dabs(tol1*q))).and.&
(p.lt.dabs(0.5d0*s*q)))then
d=p/q
else
d=xm
e=d
endif
endif
a=b
fa=fb
if (dabs(d).gt.tol1)then
b=b+d
else
if (xm.gt.0.0d0)then
b=b+tol1
else
b=b-tol1
endif
endif
fb=f(b)
t=fb*(fc/dabs(fc))
enddo
enddo
ans=b
else
write(6,*)'f(ax) and f(bx) do not have different signs,',&
' zeroin is aborting'
end if
return
end subroutine brent
要求精度を6桁にすると、実行結果は
$ gfortran main.f90
$ ./a.out
0.5000000000000000 10.0000000000000000
0.5000000000000000 4.8581311942172727
2.6310989812608572 4.8581311942172727
2.6310989812608572 3.5172292241144740
2.6310989812608572 3.0069570368988154
2.9997489497326733 3.0069570368988154
2.9997489497326733 3.0000000032534229
2.9999995032534215 3.0000000032534229
3.0000000032534229
$
となり、初めの1回は無視すると7回で収束に至っていることが分かります。挟み撃ち法とだいたい同じです。
Netlibがpublicdomainであることの記述は以下の本にも見ることが出来ます。
https://books.google.de/books?id=2GPNBQAAQBAJ&pg=PA109&lpg=PA109&dq=netlib+public+domain&source=bl&ots=d6Uw8D5JMv&sig=Dw3wXTAQThFKLVrL7pm_qnCaq9s&hl=de&sa=X&ved=0ahUKEwjO05Xxt_XKAhXCwxQKHUBlC5sQ6AEIXjAI#v=onepage&q=netlib%20public%20domain&f=false
ちなみにですが、wikipediaにあるBrent法の疑似コードを実装したのですが、うまく働きませんでした。
Brent’s method -wikipedia en
ブレント法 -wikipedia ja
Newton法
要点
・解近傍のただ1点から収束させるので必要な情報が少なく済みます。
・解近傍のただ1点上における関数の微分を用いて収束させ、一回の計算で一致桁数が倍になります。
・本当に解の近くから始めないと、失敗します。
・多変数への拡張が容易ですが、関数の微分を数値微分で代用すると効率が落ちます。
計算方法
ニュートン法について詳しくは
ニュートン法(1、2次元、多次元)
に書いたので、こちらを参照してください。
プログラムは以下のもので、
program main
implicit none
double precision::a,b,tol,sol
double precision,external::f
a=4d0
tol=1d-6
call newton1d(a,f,tol,sol)
write(6,*)sol
stop
end program main
function f(x)
implicit none
double precision,intent(in)::x
double precision::f
f=2d0*(atan(x-3d0)+0.5e0*sin(x-3d0))
return
end function f
subroutine newton1d(x0,f,tol,sol)
implicit none
double precision,intent(in)::x0,tol
double precision,intent(out)::sol
double precision,external::f
! sikinote, http://slpr.sakura.ne.jp/qp
! author: sikino
! date: 2018/07/18 (yyyy/mm/dd)
integer::i
integer,parameter::itrmax=100 ! maximum iteration
double precision,parameter::h=2d-8 ! stepsize for forward difference
double precision,parameter::tny=tiny(1d0) ! machine epsilon
double precision::a,c,f1,f2,g,d
a=x0
do i=1,itrmax
c = a
f2 = f(a+h)
f1 = f(a)
write(30,'(2f24.16)')a,f(a)
write(6,'(2f24.16)')a
g = f2-f1
if(abs(g).le.tny)then
write(6,*)"zero dividing, Newton method"
exit
endif
d = h*f1/g
a = a - d
write(30,'(2f24.16)')a,0e0
write(30,'(2f24.16)')a,f(a)
write(30,*)
if(abs(a).gt.1d0)then
if(abs(d/a).le.tol)exit
else
if(abs(d).le.tol)exit
endif
enddo
sol=a
return
end subroutine newton1d
実際に実行すると
$ gfortran newton.f90
$ ./a.out
4.0000000000000000
2.4339000410871483
3.0980975267667068
2.9994762813770324
3.0000000000829825
3.0000000000000000
$
という結果を得ます。
番外編:Steffensen法(Steffensen’s method)
Steffensen法は自己無撞着方程式を解くために使われる方法で、Newton法に似ています。
特に良く使われるのは、方程式がたまたま
\(
x=g(x)
\)
と書けている特定の方程式を満たす\(x\)を探す場合に使われます。
ですが、
\(
f(x)=x-g(x)
\)
を考えれば
\(
f(x)=0
\)
を考える問題と同じ、ということになります。
ここでは、方程式
\(
x=x^2/2
\)
を満たす\(x\)を探す問題を考えます。
この問題は
\(
x-x^2/2=0
\)
と同じです。
計算手法は
htt://park.itc.u-tokyo.ac.jp/kato-yusuke-lab/nagai/note_070420_self.pdf
でまとめられている通り、
\(
\begin{align}
a&=g(x_n), \\
b&=g(a),\\
x_{n+1}&=x_n-\frac{(a-x_n)^2}{b-2a+x_n}
\end{align}
\)
の漸化式で求められます。
プログラムではこちら。
program main
implicit none
double precision::x,x0,x1,x2,x3,tol
integer::i
double precision,external::f
tol=1d-6
x=1.5d0
do i=1,100
x0=x
x1=f(x0)
x2=f(x1)
if(abs(x0-2d0*x1+x2).lt.1d-14)exit
x=x0-(x1-x0)**2/(x2-2d0*x1+x0)
if(abs(x0-x).lt.tol)exit
enddo
write(6,*)x
stop
end program main
function f(x)
implicit none
double precision,intent(in)::x
double precision::f
f=0.5d0*x*x
return
end function f
複数のゼロ点を見つけたい場合
複数のゼロ点を見つけたい場合、一つの方法として、
解のある区間の特定→収束
を繰り返すことで得られる、と考えられるでしょう。
具体的には計算区間を荒く区切り、符号が変わる範囲を特定、その符号が変わる範囲に対してのみゼロ点を探すのです。
上の図の縦線は等間隔に荒く探した時の、関数が正になる時に青、負の時に赤色に表示しています。
収束した結果が緑の点です。
fortranプログラムはこんな感じになります。
program main
implicit none
double precision::a,b,tol
double precision,external::f
double precision,allocatable::sol(:)
integer::i,Ns,Np,Nmax
a= 0d0
b=10d0
Ns=100
Nmax=20 ! Maximum number of solutions
allocate(sol(1:Nmax))
sol=0d0
tol=1d-6
call brentall(a,b,Ns,f,tol,Nmax,Np,sol)
do i=1,Np
write(11,*)sol(i),0d0
enddo
stop
end program main
function f(x)
implicit none
double precision,intent(in)::x
double precision::f
f=sin(x)+cos(x*x)+0.5e0
return
end function f
subroutine brentall(ax,bx,Ns,f,tol,Nmax,Np,ans)
implicit none
integer,intent(in)::Nmax,Ns
double precision,intent(in)::ax,bx,tol
integer,intent(out)::Np
double precision,intent(out)::ans(1:Nmax)
double precision,external::f
! Ns : number of separation between a to b (a < b)
! Np : Number of points found between [a,b].
integer::i,j,k
double precision::h,a,b,x0,fa,fb,s
if(Ns.le.1)then
write(6,*)"*****Error rootfinding, because Ns=1"
stop
endif
fb=0d0
h=(bx-ax)/dble(Ns-1)
do j=1,Ns
b=(j-1)*h+ax
fb=f(b)
if(fb.eq.0d0)then
ans(j)=b
else
exit
endif
enddo
do i=j,Ns
a=b
fa=fb
b=(i-1)*h+ax
fb=f(b)
if(fa*fb.lt.0d0)then
call brent(a,b,f,tol,s)
j=j+1
ans(j)=s
elseif(fb.eq.0d0)then
j=j+1
ans(j)=b
endif
if(j.ge.Nmax)exit
enddo
Np=j
return
end subroutine brentall
subroutine brent(ax,bx,f,tol,ans)
implicit none
double precision,intent(in)::ax,bx,tol
double precision,intent(out)::ans
double precision,external::f
!
! a zero of the function f(x) is computed in the interval ax,bx .
!
! input..
!
! ax left endpoint of initial interval
! bx right endpoint of initial interval
! f function subprogram which evaluates f(x) for any x in
! the interval ax,bx
! tol desired length of the interval of uncertainty of the
! final result (.ge.0.)
!
! output..
!
! zeroin abscissa approximating a zero of f in the interval ax,bx
!
! it is assumed that f(ax) and f(bx) have opposite signs
! this is checked, and an error message is printed if this is not
! satisfied. zeroin returns a zero x in the given interval
! ax,bx to within a tolerance 4*macheps*abs(x)+tol, where macheps is
! the relative machine precision defined as the smallest representable
! number such that 1.+macheps .gt. 1.
! this function subprogram is a slightly modified translation of
! the algol 60 procedure zero given in richard brent, algorithms for
! minimization without derivatives, prentice-hall, inc. (1973).
!
! Original https://netlib.sandia.gov/go/zeroin.f
!
! modified by sikino for fortran90. (2018/07/22), yyyy/mm/dd
! http://slpr.sakura.ne.jp/qp/
double precision::a,b,c,d,e,eps,fa,fb,fc,tol1,xm,p,q,r,s,t
integer::finishkey
finishkey=0
eps = EPSILON(1.D0)
tol1 = eps+1.0d0
a=ax
b=bx
fa=f(a)
fb=f(b)
! check that f(ax) and f(bx) have different signs
if ((fa .eq.0.0d0 .or. fb .eq. 0.0d0).or. &
(fa * (fb/dabs(fb)) .le. 0.0d0))then
do while(finishkey.eq.0)
c=a
fc=fa
d=b-a
e=d
t=-1d0
do while(t.le.0d0)
!if(c.gt.b)write(6,'(2e24.10)')b,c
!if(b.ge.c)write(6,'(2e24.10)')c,b
if (dabs(fc).lt.dabs(fb))then
a=b
b=c
c=a
fa=fb
fb=fc
fc=fa
endif
tol1=2.0d0*eps*dabs(b)+0.5d0*tol
xm = 0.5d0*(c-b)
if ((dabs(xm).le.tol1).or.(fb.eq.0.0d0))then
finishkey=1; exit
endif
!
! see if a bisection is forced
!
if ((dabs(e).lt.tol1).or.(dabs(fa).le.dabs(fb)))then
d=xm
e=d
else
s=fb/fa
if (a.eq.c)then
!
! linear interpolation
!
p=2.0d0*xm*s
q=1.0d0-s
else
!
! inverse quadratic interpolation
!
q=fa/fc
r=fb/fc
p=s*(2.0d0*xm*q*(q-r)-(b-a)*(r-1.0d0))
q=(q-1.0d0)*(r-1.0d0)*(s-1.0d0)
endif
if (p.gt.0.0d0)then
q=-q
else
p=-p
endif
s=e
e=d
if (((2.0d0*p).lt.(3.0d0*xm*q-dabs(tol1*q))).and.&
(p.lt.dabs(0.5d0*s*q)))then
d=p/q
else
d=xm
e=d
endif
endif
a=b
fa=fb
if (dabs(d).gt.tol1)then
b=b+d
else
if (xm.gt.0.0d0)then
b=b+tol1
else
b=b-tol1
endif
endif
fb=f(b)
t=fb*(fc/dabs(fc))
enddo
enddo
ans=b
else
write(6,*)'f(ax) and f(bx) do not have different signs,',&
' zeroin is aborting'
end if
return
end subroutine brent
導関数を用いたゼロ点の探索
関数のゼロ点の間隔が非常に短い時に便利です。
等間隔に区切ってから探すという考えは同じです。
まず、導関数のゼロ点を探します。
ゼロ点が存在するならば関数のゼロ点は導関数のゼロ点に挟まれたところにあるので、その情報を元に探します。
導関数を解析的に与えていますが、もしも高精度にゼロ点を決めたい場合、二重数を用いた導関数の取得が良いかもしれません。
プログラムは例えば以下の通りです。
program main
implicit none
double precision::a,b,tol
double precision,external::f,df
double precision,allocatable::ans(:)
integer::i,Ns,Np,Nmax
a = 0d0
b = 6d0
Ns = 100
Nmax = 10 ! Maximum number of solutions
tol = 1d-12
allocate(ans(1:Nmax))
ans = 0d0
call rootderiveAB(a,b,Ns,f,df,tol,Nmax,Np,ans)
do i=1,Np
write(12,*)ans(i),0d0
write(6,*)i,ans(i)
enddo
stop
end program main
double precision function f(x)
implicit none
double precision,intent(in)::x
f=sin(x)**2-0.1d0*(x)
return
end function f
double precision function df(x)
implicit none
double precision,intent(in)::x
df = 2d0*sin(x)*cos(x)-0.1e0
return
end function df
subroutine rootderiveAB(ax,bx,Ns,f,df,tol,Nmax,Np,ans)
implicit none
integer,intent(in)::Ns,Nmax
double precision,intent(in)::ax,bx,tol
integer,intent(out)::Np
double precision,intent(out)::ans(1:Nmax)
double precision,external::f,df
integer::j,k
double precision::a,b,fa,fb,c,fc
double precision::dfa,dfb,h,s,r,fr
double precision,parameter::delta=1d-8
a=0d0
c=0d0
ans=0d0
k=0
h=(bx-ax)/dble(Ns-1)
b = ax+delta
fc = f(b)
dfb = df(b)
do j=2,Ns
a = b
dfa = dfb
b = (j-1)*h+ax
dfb = df(b)
if(dfa*dfb.lt.0d0)then
call AndersonBjork(a,b,df,tol,r)
fr = f(r)
if(fc*fr.lt.0d0)then
call AndersonBjork(c,r,f,tol,s)
k = k+1
ans(k) = s
endif
c = r
fc = fr
endif
if(k.ge.Nmax)exit
enddo
if(k.le.Nmax-1)then
r = bx
fr = f(r)
if(fc*fr.lt.0d0)then
call AndersonBjork(c,r,f,tol,s)
k = k+1
ans(k) = s
endif
endif
Np=k
return
end subroutine rootderiveAB
subroutine AndersonBjork(ax,bx,f,tol,ans)
implicit none
double precision,intent(in)::ax,bx,tol
double precision,intent(out)::ans
double precision,external::f
integer::i
integer,parameter::itmax=100
double precision::a,b,c,fa,fb,fc
double precision::tol1,xm,m
double precision,parameter::eps=epsilon(1d0)
a=ax
b=bx
fa=f(a)
fb=f(b)
if ((fa .eq.0.0d0 .or. fb .eq. 0.0d0).or. &
(fa * (fb/dabs(fb)) .le. 0.0d0))then
do i=1,itmax
c = a-fa*(a-b)/(fa-fb)
fc=f(c)
if(fa*fc.gt.0d0)then
if(fc/fa.lt.1d0)then
m=1d0-fc/fa
else
m=0.5d0
endif
fb=m*fb
a=c
fa=fc
else
if(fc/fb.lt.1d0)then
m=1d0-fc/fb
else
m=0.5d0
endif
fa=m*fa
b=c
fb=fc
endif
tol1=2.0d0*eps*dabs(c)+0.5d0*tol
xm = 0.5d0*(a-b)
if ((dabs(xm).le.tol1).or.(fc.eq.0.0d0))exit
enddo
ans=c
else
write(6,*)'f(ax) and f(bx) do not have different signs,',&
' zeroin is aborting'
end if
return
end subroutine AndersonBjork