「プログラミングと数値計算」カテゴリーアーカイブ

プログラミングと数値計算

逆行列の数値計算

コメントする

Lapackを用いて数値計算で逆行列を求めます。
基本的に数値的にあらわに逆行列を求める意味はそんなにありません。
連立一次方程式を解きたければ、行列のLU分解を通じて解けば良いです。この場合、逆行列を求めることはしません。

そうはいっても使ってみたい時があります。そんな状況を考えましょう。

Lapack, もしくはインテルのマス・カーネル・ライブラリ(MKL)を用います。

用いるルーチンは

?getrf, ?getri

の2つです。

ここに用意したのは配列の大きさNと配列Aを入れると逆行列を出力するプログラムです。
倍精度、複素倍精度のルーチンを書きました。

ifort -mkl main.f90

でコンパイルしてください。

program main
  implicit none
  integer::i,j,N
  complex(kind(0d0)),allocatable::A(:,:),B(:,:)
 
  N=3
  allocate(A(1:N,1:N),B(1:N,1:N))
  A(1,1:3)=(/(2d0,0d0),(3d0,0d0),(0d0,0d0)/)
  A(2,1:3)=(/(2d0,0d0),(9d0,0d0),(1d0,3d0)/)
  A(3,1:3)=(/(3d0,4d0),(5d0,0d0),(3d0,1d0)/)

  B=A
 
  do i=1,N
     do j=1,N
        write(6,'(2f15.10,$)')A(i,j)
     enddo
     write(6,*)
  enddo
  write(6,*)

  call zinvmat(size(A,1),A)
 
  do i=1,N
     do j=1,N
        write(6,'(2f15.10,$)')A(i,j)
     enddo
     write(6,*)
  enddo
  write(6,*)

  A=matmul(B,A)
 
  do i=1,N
     do j=1,N
        write(6,'(2f15.10,$)')A(i,j)
     enddo
     write(6,*)
  enddo
  write(6,*)

  stop
end program main
   
subroutine invmat(N,A)
  implicit none
  integer,intent(in)::N
  double precision,intent(inout)::A(1:N)

  integer::info,lwork,ipiv(1:N)
  double precision::tw(1:1)
  double precision,allocatable::work(:)
 
  info=0
  call dgetrf(N,N,A,N,ipiv,info)
  if(info.ne.0)then
     write(6,*)"Error at inverse matrix ?getrf, info",info
     stop
  endif
 
  !size query
  call dgetri(N,A,N,ipiv,tw,-1,info)
  lwork=nint(tw(1))
  allocate(work(1:lwork+1))
  work=0d0
 
  call dgetri(N,A,N,ipiv,work,lwork,info)
  if(info.ne.0)then
     write(6,*)"Error at inverse matrix ?dgetri, info",info
     stop
  endif
 
  return
end subroutine invmat


subroutine zinvmat(N,A)
  implicit none
  integer,intent(in)::N
  complex(kind(0d0)),intent(inout)::A(1:N)

  integer::info,lwork,ipiv(1:N)
  complex(kind(0d0))::tw(1:1)
  complex(kind(0d0)),allocatable::work(:)
 
  info=0
  call zgetrf(N,N,A,N,ipiv,info)
  if(info.ne.0)then
     write(6,*)"Error at inverse matrix ?getrf, info",info
     stop
  endif
 
  !size query
  call zgetri(N,A,N,ipiv,tw,-1,info)
  lwork=nint(dble(tw(1)))
  allocate(work(1:lwork+1))
  work=dcmplx(0d0,0d0)
 
  call zgetri(N,A,N,ipiv,work,lwork,info)
  if(info.ne.0)then
     write(6,*)"Error at inverse matrix ?dgetri, info",info
     stop
  endif
 
  return
end subroutine zinvmat
プログラミングと数値計算, 数学

リーマンのゼータ関数の複素力学系

コメントする

本稿の目的はリーマンのゼータ関数を、ニュートン法による写像を用いて別の視点から見ることです。
綺麗な絵が得られる[1]ので自分のコンピュータ上で見てみたいと思いました。

複素力学系とは？

複素力学系とは、簡単に言えば写像のことです。
実関数による写像の繰り返しで得られる系を力学系と呼び、
複素関数による写像の繰り返しで得られる系を複素力学系と呼びます。
”力学”の言葉の由来はニュートン力学から来ています。

”ニュートン力学”は目に見えるくらいの物体を扱う学問ですが、その正体は時間に関する2階の微分方程式です。
なので、時刻\(t\)の物体の振る舞い\(x(t)\)からちょっとの時間\(\Delta t\)秒後の物体の振る舞い\(x(t+\Delta t)\)は、適当な時間発展をさせる演算子\(f\)によって
\(
x(t)\overset{f}{\longrightarrow} x(t+\Delta t)
\)
と移り変わります。これを何度も繰り返し作用させて任意の時刻\(t’\)まで時間発展させる事が出来ます。

\(
x(t)\overset{f}{\longrightarrow} x(t+\Delta t)\overset{f}{\longrightarrow} x(t+2\Delta t)\overset{f}{\longrightarrow}x(t+3\Delta t)\overset{f}{\longrightarrow} \cdots\overset{f}{\longrightarrow} x(t’)
\)
となると、ニュートン力学を性質を知ろうとするときに重要な情報は、演算子\(f\)と初期値に集約されます。

演算子\(f\)の空間へどんどん写像していくわけですので、ある写像の繰り返しも力学のようだ、だから”力学系”という名前が付けられたわけです。
もう少し詳しく知りたければ、まずは[3]を読むと良いでしょう。

本稿では複素力学系の一つであるニュートン＝ラフソン法によって得られる写像(ここでは便宜的にニュートン写像と呼ぶことにします)を考えます。

複素関数\(f(z)\)の具体的なニュートン写像の数式は以下で与えられます。
\(
\displaystyle N_f(z)=z-\frac{f(z)}{f'(z)}
\)
ある複素平面の初期値からスタートして、この写像を何回繰り返したら収束したか？をその系を特徴づける値とします。
要は、ニュートン＝ラフソン法の初期値を複素平面上の全ての点を取り、収束するまでの回数をカウントするのです。

[adsense1]

ニュートン写像の具体例

本稿の目的はゼータ関数に対して行うことですが、まずは簡単な複素関数のニュートン写像を見てみましょう。
まず、複素関数
\(
\displaystyle f(z)=z^2-1
\)
を考えます。根の周り（\(z=\pm 1\)）では収束回数は少なくなることが予想できます。実際にやってみますとこんな感じに。

非常に単調です。実部の値が正か負かでのみ特徴づけられるようです。

続いて、複素関数
\(
\displaystyle f(z)=z^3-1
\)
を考えます。根は\(z=1, e^{\pm i2\pi/3}\)。

3つは確かに分けられていますが、その境界辺りでは非常に奇怪な模様になります。

さらに、複素関数
\(
\displaystyle f(z)=z^4-1
\)
を考えます。根は\(z=\pm 1, \pm i\)。

ゼータ関数のニュートン写像

では、ゼータ関数に適応してみましょう。
ゼータ関数の導関数は導出方法とプログラムは[2],[9]/リーマンのゼータ関数の数値計算コード(複素平面)に追記したのでそちらをご覧ください。
するとこんなニュートン写像になります。

ゼロ点付近では収束が早くなっています。ゼロ点のある場所がマークしたところです。

カラーを対数にしますとこんな図に。

(2017/01/13 追記)
もっとほかの範囲のニュートン写像を見ていきます。

全体像

拡大その1(全体像の左側の四角)

拡大その2(全体像の右側の四角)

拡大その２, 高解像度版 highres_zetanewton.png (15MB)

元の画像はこちらからダウンロードできます。

[adsense2]

ゼータ関数のニュートン写像を得るfortran90のプログラムはこちらです。

ifort -O3 -qopenmp main.f90

計算範囲はxa,xb,ya,ybで指定されています。

参考文献

[1]Tomoki Kawahira “Riemann’s zeta function and Newton’s method: Numerical experiments from a complex-dynamical viewpoint”

[2]Tom M. Apóstol “Formulas for Higher Derivatives of the Riemann Zeta Function”, Math. of. Comp vol 44, 169, 1985, pp. 223-232.

[3]Chapter 14 力学系（補講１）

[4]ジュリア集合の色付けを工夫して芸術的なフラクタル図形を描く

[5]複素力学系, ニュートン法, ジュリア集合

[6]西沢清子, 藤村雅代 “多項式のニュートン写像における鉢の幅について(カオスをめぐる力学系の諸問題)”

[7]Riemann Zeta Function -wolfram mathworld

[8]ディガンマ関数の数値計算 -シキノート
[9]リーマンのゼータ関数の数値計算コード(複素平面) -シキノート

プログラミングと数値計算, 数学

二重指数関数型数値積分

1件のコメント

二重指数関数型数値積分公式(DE公式またはtanh-sinh公式)とは、変数変換によって被積分関数を別の関数に変換し積分する方法のことです。
計算アイデアは

  1. 変数変換によって台形則が良く働く被積分関数に変換する
  2. 台形則によって数値積分する

という考えに立脚しています。端点に特異点が存在する場合に最適、という特徴を持ちます。
1974年に、高橋 秀俊と森 正武によって提案されました[1]。

二重指数関数型数値積分とは、関数\(f(x)\)の\([-1,1]\)に渡る積分を

\(
\begin{align}
\int_{-1}^{1} f(x) dx &\approx \sum_{i=-N_-}^{N^+} w_i f(x_i),\\
x_i&=\tanh\left(\frac{\pi}{2}\sinh(ih)\right), \\
w_i&=\frac{h\frac{\pi}{2}\cosh(ih)}{\cosh^2\left(\frac{\pi}{2}\sinh(ih)\right)}
\end{align}
\)

として近似します。\(N_-, N_+\)は離散化誤差と打ち切り誤差が等しくなるように決められます。
\(N_-, N_+\)はプログラム上では、\(x_i\)がコンピュータの扱える桁数を超えず、\(w_i\)がアンダーフローを起こさない範囲で決められます。


[adsense1]

計算アイデア

DE公式は変数変換型の数値積分公式と呼ばれます。
DE公式の計算は、

  1. 変数変換によって台形則が良く働く被積分関数に変換する
  2. 台形則によって数値積分する

という考えが元になっています。

大きな特徴として、

・端点特異性に強い
・応用範囲が広い

ことが挙げられます。
例えば、端点で発散してしまう積分
\(
\displaystyle \int_0^1 \frac{1}{\sqrt{x}} dx
\)
や、厄介な積分
\(
\displaystyle \int_0^1 \sin\left(\frac{1}{\sqrt{x}}\right)/\sqrt{x} dx
\)
の計算も少ない分点数で実行できます(後者の厄介な積分はDE公式を用いて4桁程度一致します。しかし、ほかの補間型の積分公式では1桁合うかどうかでしょう)。

なぜ変数変換でうまく計算できるのか、これを理解するにはまず、台形則が良く働く場合とは何かを知らなければなりません。

台形則が良く働く関数とは、関数の端点での微分の値が近い事です。
台形則の刻み幅を\(h\), 区間\([a,b]\)を台形則によって関数\(f(x)\)を数値積分する時、本来の積分値と台形則で求めた値の誤差を表す第1項は、
\(
\displaystyle \frac{h^2}{12}\{f'(b)-f'(a)\}
\)
と表されます。刻み幅を小さくすれば誤差が小さくなるのは直観的に分かりますが、誤差を小さくできる要因は\(\{f'(b)-f'(a)\}\)にもあります。これは、
・両端で微分の値が等しい(周期関数の1周期に渡る積分、\(a,b\)に近づくつれて関数が定数に近づいていく積分)
を考えるとき、高精度の結果を与えると言っています。

上記条件が満たされるとき、他の高次の誤差項\(f^{(n)}(b)-f^{(n)}(a)\)もほとんどゼロになることが期待されるため、数値計算誤差が限りなく小さくなっていきます。

では変数変換によって端点で減衰する被積分関数に変換することを考えましょう。
高橋-森によって以下の変数変換が提案され、その特性が調べられました[1]。
\(
\displaystyle x=\varphi(t)=\tanh\left(\frac{\pi}{2}\sinh(t)\right)
\)
この変数変換をすることによって端点で”急速に“ゼロに近づく被積分関数に変換されるのです。

この”急速に“の速度はすさまじく、tが大きくなる時、被積分関数は
\(
\displaystyle f(\varphi(t))\varphi'(t)\sim A\exp\{-c\exp(-|t|)\}
\)
の形を持ちます。指数の指数の形で減衰するため、二重指数関数型という名前が付けられているのです。

まぁ、なぜ簡単に計算できるのかと言えば、\(1/\sqrt{x}|_{x\to 0}\)で発散していく時、これよりも早く減衰する関数で割れば収束しますよね、という事です。

※三重、四重指数関数型があるのでは、と考えるのは自然です。しかし、このような関数は(多分ですが)正則であるという条件の下では存在しないことが示されています[3,4]。一重指数関数型数値積分公式は存在します(例えばIMT公式)。

ニュートン・コーツ型数値積分、ガウス求積法は補間型の数値積分公式と呼ばれます。
これらの公式は
与えられたデータ点とデータ点を(重み関数)×(多項式)として補間し、その補間された関数を積分する
というアイデアの元考えられています。
しかし、重み関数は方程式から人間が知っていないとならず、上の形以外の関数を無理やり積分しようとしても積分精度は悪いです。
そのため、問題ごとに合わせたアルゴリズムの変更が必要不可欠になります。

数値計算で気を付けるべき点

端点特異点がある場合の収束

端点特異点がある場合、変数変換後の空間で計算区間が足らなくなり、大きな打切り誤差が発生します。
端点で発散している時に顕著です。
例えば、積分
\(
\displaystyle \int_0^1 \sqrt{x}dx
\)
は高精度(16桁近く一致)の結果を与えますが、
積分
\(
\displaystyle \int_0^1 \frac{1}{\sqrt{x}}dx
\)
は8桁程度の一致しかしません。この原因は打切り誤差です。桁落ちが起きないように処理が必要な問題となります。

積分区間の変更

積分
\(
\displaystyle \int_a^b f(x) dx
\)
を行いたい場合、変数変換
\(
\displaystyle x=\frac{b-a}{2}t+\frac{b+a}{2}
\)
を行うことで区間\([-1,1]\)の積分に置き換えることが出来ます。

広義積分に対する二重指数関数型数値積分

半無限区間\([0,\infty]\)の場合、

\(
\begin{align}
\int_{0}^{\infty} f(x) dx &\approx \sum_{i=-N_-}^{N^+} w_i f(x_i),\\
x_i&=\exp\left(\frac{\pi}{2}\sinh(t)\right), \\
w_i&=h\frac{\pi}{2}\cosh(ih)\exp\left(\frac{\pi}{2}\sinh(ih)\right)
\end{align}
\)

無限区間\([-\infty,\infty]\)の場合、

\(
\begin{align}
\int_{-\infty}^{\infty} f(x) dx &\approx \sum_{i=-N_-}^{N^+} w_i f(x_i),\\
x_i&=\sinh\left(\frac{\pi}{2}\sinh(t)\right), \\
w_i&=h\frac{\pi}{2}\cosh(ih)\cosh\left(\frac{\pi}{2}\sinh(ih)\right)
\end{align}
\)

のように変数変換を行うことで二重指数で減衰する関数に変わります。

また、半無限区間の積分の多くの場合は\(exp(-x)\)で減衰します。
これを考慮すると
\(
x=\exp(t-\exp(-t))
\)
という変数変換が有効だということが分かります[1]。本稿では数値計算のアルゴリズムの都合上載せません。

計算の工夫

被積分関数の評価回数を可能な限り減らすため、アルゴリズムを工夫します。

変数変換後の空間で刻み幅\(h\)で求めた数値積分値\(I_h\)は
\(
\displaystyle I_h=h\sum_{i=-N}^N f(\varphi(ih))\varphi'(ih)
\)
と表されます。刻み幅を半分\(h/2\)にすると、分点数は\(4N+1\)になり、
\(
\displaystyle I_{h/2}={h/2}\sum_{i=-2N}^{2N} f(\varphi(ih/2))\varphi'(ih/2)
\)
と表されます。
\(I_h\)を利用して、\(I_{h/2}\)を表現すると、
\(
\displaystyle I_{h/2}=\frac{1}{2}\left\{I_h + h\sum_{i=-N}^{N-1} f(\varphi(ih+h/2))\varphi'(ih+h/2)\right\}
\)
と表されます。

この表式の利点は以下の通りです。
本来、\(I_{h/2}\)を計算するためには\(4N+1\)回右辺を計算しなければなりません。
しかし、\(I_{h}\)と\(I_{h/2}\)の分点の位置が重なっているときがちょうど2N+1点有ります。よって重なっていない残りの\(2N\)点だけを計算してやれば\(I_{h/2}\)を計算できるのです。評価回数が\(4N+1\)回から\(2N\)回に減ったことで単純に計算時間が半分になります。

[adsense2]

fortranプログラム

関数fの数値積分を実行します。
対応しているのは、

・1,2,3次元
・実関数/複素関数(実/複素引数)
・有限区間/半無限区間/無限区間

と

・極座標、球面座標での全空間積分

となっています。
数値計算精度は有効桁数の問題から、8桁程度と思うのが良いと思います。

複素関数の積分は、複素数点と複素数点を直線で結んだ線積分です。
また、半無限区間、無限区間の複素関数の積分では始点\(ca,wa,va\)と角度\(thx,thy,thz\)によって経路を指定することが出来ます。

厳密に全てのルーチンが正しく動作するかは確認していません。
利用する際は連絡先とサイトについてをご覧下さい。

モジュール↓(2000行近くあります)

具体的なプログラム例

積分
\(
\displaystyle \int_0^{5}\sin(\sqrt(x))
\)
を計算。

厳密値
4.3340264879445362
数値計算結果
4.33402648794427

プログラム

全具体例

実装してある計算を全ルーチンを利用したプログラムを書きます。
詳細はコメントを確認してください。

基本的にaを含む変数は積分の始点、bは積分の終点です。

program main
  use DE_integration
  implicit none
  integer::info
  double precision::xa,xb,ya,yb,za,zb,eps,s,thx,thy,thz
  complex(kind(0d0))::ca,cb,wa,wb,va,vb
  double precision,parameter::pi=dacos(-1d0)
  complex(kind(0d0))::cs
 
  double precision::f1,f2,f3,f4,p2,p3,fh1,fi1,fi2,fp2,fi3,fp3
  complex(kind(0d0))::g1,g2,g3,g4,g5,g6,h1,h2,h3,gh1,hh1,&
       gi1,hi1,gi2,hi2,gp2,gi3,hi3,gp3
  external::f1,f2,f3,f4,g1,g2,g3,g4,g5,g6,p2,p3,h1,h2,h3,&
       fh1,gh1,hh1,fi1,gi1,hi1,fi2,gi2,hi2,fp2,gp2,gi3,hi3,gp3,fi3,fp3
 
 
  ! +------- 1D Integration -------+

  ! real f, real x, 1D, finite-range
  xa=0d0;  xb=1d0;  
  eps=1d-12; s=0d0  
  call dde1d(f1,xa,xb,eps,s,info)
  write(6,*)info,s

  ! complex f, real x, 1D, finite-range
  xa=0d0;  xb=1d0;  
  eps=1d-12; s=0d0  
  call cde1d(g1,xa,xb,eps,cs,info)
  write(6,*)info,cs

  ! complex f, complex x, 1D, finite-range
  ca=dcmplx(0d0,1d0);  cb=dcmplx(1d0,3d0)  
  eps=1d-12; s=0d0  
  call zde1d(h1,ca,cb,eps,cs,info)
  write(6,*)info,cs

  ! real f, real x, 1D, semi-infinite
  xa=2d0;  
  eps=1d-12; s=0d0  
  call dde1d_hinf(fh1,xa,eps,s,info)
  write(6,*)info,s

  ! complex f, real x, 1D, semi-infinite
  xa=2d0;
  eps=1d-12; s=0d0
  call cde1d_hinf(gh1,xa,eps,cs,info)
  write(6,*)info,cs

  ! complex f, complex x, 1D, semi-infinite
  ca=dcmplx(0d0,0d0);  thx=pi/4d0
  eps=1d-12; s=0d0
  call zde1d_hinf(hh1,ca,thx,eps,cs,info)
  write(6,*)info,cs

  ! real f, real x, 1D, infinite
  xa=2d0;  
  eps=1d-12; s=0d0  
  call dde1d_inf(fi1,eps,s,info)
  write(6,*)info,s

  ! complex f, real x, 1D, infinite
  xa=2d0;
  eps=1d-12; s=0d0
  call cde1d_inf(gi1,eps,cs,info)
  write(6,*)info,cs

  ! complex f, complex x, 1D, infinite
  ca=dcmplx(0d0,0d0);  thx=pi/4d0
  eps=1d-12; s=0d0
  call zde1d_inf(hi1,ca,thx,eps,cs,info)
  write(6,*)info,cs
 
 
  ! +------- 2D Integration -------+
 
  ! real f, real x,y, 2D, finite-range
  xa=0d0; xb=1d0; ya=0d0; yb=2d0
  eps=1d-12; s=0d0  
  call dde2d(f2,xa,xb,ya,yb,eps,s,info)
  write(6,*)info,s

  ! complex f, real x,y, 2D, finite-range
  xa=0d0; xb=1d0; ya=0d0; yb=2d0
  eps=1d-12; s=0d0  
  call cde2d(g2,xa,xb,ya,yb,eps,cs,info)
  write(6,*)info,cs

  ! complex f, complex x,y, 2D, finite-range
  ca=dcmplx(0d0,1d0);  cb=dcmplx(1d0,3d0)  
  wa=dcmplx(1d0,-1d0);  wb=dcmplx(2d0,0d0)  
  eps=1d-12; s=0d0  
  call zde2d(h2,ca,cb,wa,wb,eps,cs,info)
  write(6,*)info,cs

  ! real f, real x,y, 2D, infinite-range
  eps=1d-8; s=0d0
  call dde2d_inf(fi2,eps,s,info)
  write(6,*)info,s

  ! complex f, real x,y, 2D, infinite-range
  eps=1d-12; s=0d0  
  call cde2d_inf(gi2,eps,cs,info)
  write(6,*)info,cs

  ! complex f, complex x,y, 2D, infinite-range
  ca=dcmplx(0d0,0d0);  thx=0d0
  wa=dcmplx(0d0,0d0);  thy=0d0
  eps=1d-12; s=0d0
  call zde2d_inf(hi2,ca,thy,wa,thx,eps,cs,info)
  write(6,*)info,cs

  ! real f, real x,y, 2D polar, infinite-range
  eps=1d-12; s=0d0
  call dde_polar(fp2,eps,s,info)
  write(6,*)info,s

  ! complex f, real x,y, 2D polar, infinite-range
  eps=1d-12; s=0d0  
  call cde_polar(gp2,eps,cs,info)
  write(6,*)info,cs
 
 
  ! +------- 3D Integration -------+

  ! real f, real x,y,z, 3D, finite-range
  xa=0d0; xb=1d0; ya=0d0; yb=2d0; za=2d0; zb=3d0
  eps=1d-12; s=0d0
  call dde3d(f3,xa,xb,ya,yb,za,zb,eps,s,info)
  write(6,*)info,s

  ! complex f, real x,y,z, 3D, finite-range
  xa=0d0; xb=1d0; ya=0d0; yb=2d0; za=2d0; zb=3d0
  eps=1d-12; s=0d0  
  call cde3d(g3,xa,xb,ya,yb,za,zb,eps,cs,info)
  write(6,*)info,cs

  ! complex f, complex x,y,z, 3D, finite-range  
  ca=dcmplx(0d0,1d0);  cb=dcmplx(1d0,3d0)  
  wa=dcmplx(1d0,-1d0);  wb=dcmplx(2d0,0d0)  
  va=dcmplx(1d0,1d0);  vb=dcmplx(0d0,1d0)
  eps=1d-12; s=0d0  
  call zde3d(h3,ca,cb,wa,wb,va,vb,eps,cs,info)
  write(6,*)info,cs

  ! real f, real x,y,z, 3D, finite-range
  eps=1d-12; s=0d0
  call dde3d_inf(fi3,eps,s,info)
  write(6,*)info,s

  ! complex f, real x,y,z, 3D, finite-range
  eps=1d-12; s=0d0  
  call cde3d_inf(gi3,eps,cs,info)
  write(6,*)info,cs

  ! complex f, complex x,y,z, 3D, finite-range
  ca=dcmplx(0d0,1d0);  thx=0d0
  wa=dcmplx(1d0,-1d0); thy=pi/2d0
  va=dcmplx(1d0,1d0);  thz=0d0
  eps=1d-12; s=0d0  
  call zde3d_inf(hi3,ca,thx,wa,thy,va,thz,eps,cs,info)
  write(6,*)info,cs

  ! real f, real x,y, 3D spherical, infinite-range
  eps=1d-12; s=0d0
  call dde_polar(fp3,eps,s,info)
  write(6,*)info,s

  ! complex f, real x,y, 3D spherical, infinite-range
  eps=1d-12; s=0d0  
  call cde_polar(gp3,eps,cs,info)
  write(6,*)info,cs
 
  stop
end program main

function f1(x)
  implicit none
  double precision,intent(in)::x
  double precision::f1
 
  f1=sin(sqrt(x))
 
  return
end function f1

function g1(x)
  implicit none
  double precision,intent(in)::x
  complex(kind(0d0))::g1
 
  g1=dcmplx(sin(sqrt(x)),exp(-x))
 
  return
end function g1

function h1(z)
  implicit none
  complex(kind(0d0)),intent(in)::z
  complex(kind(0d0))::h1
 
  h1=sin(z)
 
  return
end function h1

function fh1(x)
  implicit none
  double precision,intent(in)::x
  double precision::fh1
 
  fh1=exp(-x)
 
  return
end function fh1

function gh1(x)
  implicit none
  double precision,intent(in)::x
  complex(kind(0d0))::gh1
 
  gh1=dcmplx(sqrt(x)*exp(-x),exp(-x))
 
  return
end function gh1

function hh1(z)
  implicit none
  complex(kind(0d0)),intent(in)::z
  complex(kind(0d0))::hh1
  double precision,parameter::pi=dacos(-1d0)
 
  hh1=exp(dcmplx(0d0,1d0)*0.5d0*pi*z**2)
 
  return
end function hh1

function fi1(x)
  implicit none
  double precision,intent(in)::x
  double precision::fi1
 
  fi1=exp(-x*x)
 
  return
end function fi1

function gi1(x)
  implicit none
  double precision,intent(in)::x
  complex(kind(0d0))::gi1
 
  gi1=dcmplx(1d0/(1d0+x*x),exp(-x*x))
 
  return
end function gi1

function hi1(z)
  implicit none
  complex(kind(0d0)),intent(in)::z
  complex(kind(0d0))::hi1
  double precision,parameter::pi=dacos(-1d0)
 
  hi1=1d0/(1d0+z*z)
 
  return
end function hi1


function f2(x,y)
  implicit none
  double precision,intent(in)::x,y
  double precision::f2
 
  f2=sin(sqrt(x))*exp(-y)
 
  return
end function f2

function g2(x,y)
  implicit none
  double precision,intent(in)::x,y
  complex(kind(0d0))::g2
 
  g2=dcmplx(sin(sqrt(x))/sqrt(y),exp(-x)*y)
 
  return
end function g2

function h2(z,w)
  implicit none
  complex(kind(0d0)),intent(in)::z,w
  complex(kind(0d0))::h2
 
  h2=sin(z)*w
 
  return
end function h2

function fi2(x,y)
  implicit none
  double precision,intent(in)::x,y
  double precision::fi2
 
  fi2=1d0/(1d0+x**4+y**4)
 
  return
end function fi2

function gi2(x,y)
  implicit none
  double precision,intent(in)::x,y
  complex(kind(0d0))::gi2
 
  gi2=dcmplx(exp(-y*y-x*x),exp(-y*y-x*x))
 
  return
end function gi2

function hi2(z,w)
  implicit none
  complex(kind(0d0)),intent(in)::z,w
  complex(kind(0d0))::hi2
 
  hi2=exp(-z*z-w*w)
 
  return
end function hi2

function fp2(r,theta)
  implicit none
  double precision,intent(in)::r,theta
  double precision::fp2
 
  fp2=r*exp(-r)*sin(theta)**2
  fp2=r*fp2 ! Jacobian
 
  return
end function fp2

function gp2(r,theta)
  implicit none
  double precision,intent(in)::r,theta
  complex(kind(0d0))::gp2
 
  gp2=dcmplx(0d0,1d0)*r*exp(-r)*sin(theta)**2
  gp2=r*gp2 ! Jacobian
 
  return
end function gp2

function f3(x,y,z)
  implicit none
  double precision,intent(in)::x,y,z
  double precision::f3
 
  f3=sin(x*z)*exp(-y)
 
  return
end function f3

function g3(x,y,z)
  implicit none
  double precision,intent(in)::x,y,z
  complex(kind(0d0))::g3
 
  g3=dcmplx(sin(sqrt(x))/sqrt(y),exp(-x)*y*sqrt(z))
 
  return
end function g3

function h3(z,w,v)
  implicit none
  complex(kind(0d0)),intent(in)::z,w,v
  complex(kind(0d0))::h3
 
  h3=sin(z)*w*v**2
 
  return
end function h3

function fi3(x,y,z)
  implicit none
  double precision,intent(in)::x,y,z
  double precision::fi3
 
  fi3=exp(-x*x-y*y-z*z)
 
  return
end function fi3

function gi3(x,y,z)
  implicit none
  double precision,intent(in)::x,y,z
  complex(kind(0d0))::gi3
 
  gi3=dcmplx(exp(-y*y-x*x-z*z),2d0*exp(-y*y-x*x-z*z))
 
  return
end function gi3

function hi3(z,w,v)
  implicit none
  complex(kind(0d0)),intent(in)::z,w,v
  complex(kind(0d0))::hi3
 
  hi3=exp(-abs(z)**2-abs(w)**2-abs(v)**2)
 
  return
end function hi3

function fp3(r,theta,phi)
  implicit none
  double precision,intent(in)::r,theta,phi
  double precision::fp3
 
  fp3=r*exp(-r)*sin(theta)**2
  fp3=r*r*sin(theta)*fp3 ! Jacobian
 
  return
end function fp3

function gp3(r,theta,phi)
  implicit none
  double precision,intent(in)::r,theta,phi
  complex(kind(0d0))::gp3
 
  gp3=dcmplx(0d0,1d0)*r*exp(-r)*sin(theta)**2
  gp3=r*r*sin(theta)*gp3 ! Jacobian
 
  return
end function gp3

参考文献

[1] H. Takahasi and M. Masatake, “Double Exponential Formulas for Numerical Integration” (1974)
[2]渡辺二太, 二重指数関数型数値積分公式について(1990)

[3] 森 正武、「数値解析における二重指数関数型変換の最適性」
[4] M. Sugihara, Optimality of the double exponential formula-functional analysis approach,
Numer. Math. 75 (1997) 379-395.

数値積分法の入門とDE公式の説明として、
[5] 戸田 英雄, 小野 令美 数値解析における一つの話題

[6] 森 正武「二重指数関数型変換のすすめ」

[7]森 正武, “FORTRAN 77 数値計算プログラミング”、p.174-176岩波書店、(1986)第一刷

プログラミングと数値計算, 数学

畑政義による写像

コメントする

畑政義による写像によって得られる点の集合は、簡単な式で書かれるにもかかわらず、その綺麗さに惹きつけられます
このページでは、畑政義による写像の定義、fortranコード、図を掲載します。

  1. 序
  2. 畑政義による写像の数式
  3. 代表的なパラメータ
  4. パラメータを予想する(2つの複素定数がゼロの場合)
  5. 考察
  6. 参考文献

序

ある日、こんなツイートを見ました。


とても綺麗で感動しました。また、


というツイートに触発されました。自分でも作ってみよう、と。

畑政義による写像の数式

畑政義によって考えられた写像は、簡単な数式で綺麗な図が得られます。

このページでは畑政義の写像で得られる画像の”綺麗さ”を主とします。

畑政義による写像の数式は論文[1]より、
\(
\begin{align}
F_1(z)&=\alpha z+\beta \bar{z} \\
F_2(z)&=\gamma (z-1)+\delta (\bar{z}-1)+1
\end{align}
\)
です(\(\alpha,\beta,\gamma,\delta\)は複素定数,\(\bar{z}\)は\(z\)の複素共役を意味します)。

ある1点に対して写像を行うと、\(F_1,F_2\)によっての2つ点に写像されます。
ある1点からスタートして、\(n\)回作用させていきます。\(n\)回作用させた結果、最後に得られる点の数は\(2^n\)点になります。

具体的にどういう風に計算をすればいいかといいますと
1.初期値\(z_0\)を用意
2.値\(F_1(z_0),F_2(z_0)\)を計算
3.値\(F_1(F_1(z_0)),F_1(F_2(z_0)),F_2(F_1(z_0)),F_2(F_2(z_0))\)を計算
4…
という具合に計算していくのです。そうして得られた最後の複素数の組を複素平面上に打っていくのです。

fortranコードはこちら。重複して計算するのが嫌なので少し工夫しています。

program main
  implicit none
  integer,parameter::N=12
  integer::i
  complex(kind(0d0))::a,b,c,d,z0,h(1:2**N)
 
  a=dcmplx(0.7d0,0.2d0)
  b=dcmplx(0.0d0,0.0d0)
  c=dcmplx(0d0,0d0)
  d=dcmplx(2d0/3d0,0d0)
  z0=dcmplx(1d0,0d0)

  h=dcmplx(0d0,0d0)

  call hatamap(N,a,b,c,d,z0,h)
  do i=1,2**N
     write(10,'(2f10.6)')h(i)
  enddo
 
  stop
end program main

subroutine hatamap(N,a,b,c,d,z0,h)
  implicit none
  integer,intent(in)::N
  complex(kind(0d0)),intent(in)::a,b,c,d,z0
  complex(kind(0d0)),intent(out)::h(1:2**N)

  integer::i,j,k,l,m
  complex(kind(0d0))::z,F,h0(1:2**N)
  external::F
 
  h=dcmplx(0d0,0d0); h0=dcmplx(0d0,0d0)  
 
  h(1)=z0;  h0(1:2**N)=h(1:2**N)
  do j=1,N
     k=1-2**(N-j)
     l=1-2**(N-j+1)
     do i=1,2**j
        if(mod(i,2).eq.1)l=l+2**(N-j+1)
        k=k+2**(N-j)
        m=mod(i+1,2)+1
        h(k)=F(m,a,b,c,d,h0(l))
     enddo
     h0(1:2**N)=h(1:2**N)
  enddo  
 
  return
end subroutine hatamap

function F(n,a,b,c,d,z)
  implicit none
  integer,intent(in)::n
  complex(kind(0d0)),intent(in)::a,b,c,d,z
  complex(kind(0d0))::F
 
  if(n.eq.1)then
     F=a*z+b*conjg(z)
  elseif(n.eq.2)then
     F=c*(z-1d0)+d*(conjg(z)-1d0)+1d0
  else
     write(6,*)"***error"; stop
  endif
 
  return
end function F

さて、プログラムが正しく動いていることを確かめるため、論文のパラメータで写像を再現してみます。
論文[1]では\((\alpha,\beta,\gamma,\delta)\)のセットとして描いています。
論文[1]ではこんな感じに紹介されています。
hata_paper_c

私のプログラムでは、
(左上) \((0.4614+i0.4614, 0, 0.622-i0.196, 0)\)
(右上) \( (0, 0.3+i0.3, 0, 41/50)\)
(左下) \((0, 0.5+i0.5, 0, -0.5+i0.5)\)
(右下) \((0.4614+i0.4614, 0, 0, 0.2896-i0.585)\)
hatamap_reconst_c
となり、ちゃんと正しく計算されていることが分かります。綺麗ですね。

[adsense1]

代表的なパラメータ

さて綺麗な画像を得るために探さなければならないパラメータは\(\alpha,\beta,\gamma,\delta,z_0\)の全部で5つ。各々複素定数なので、実部と虚部で合計10個のパラメータをいじって綺麗な画像を探さなければなりません。これは多いです。
まずは[2],[3],[4]に掲載されているパラメータで計算を行って見ましょう。
ずらっと並べます。
hatamap2_c

hatamap3_c

hatamap4_c

hatamap5_c

hatamap6_c

hatamap1_c

[adsense2]

パラメータを予想する

さて、綺麗な画像として紹介されているのは大体\(\alpha,\beta,\gamma,\delta\)のうち2つがゼロであり、\(0,\pm0.25,\pm 0.5, \pm0.75, \pm1\)のどれかです。この組み合わせだけでも甚大で、
\( _4C_2\times 9^8=258 280 326\)通りの組み合わせがあります。
2億個の画像を見てこれは綺麗、これは違うを判断することはできません。

注記しておきますが、写像を作る際に\(\alpha,\beta,\gamma,\delta\)の絶対値が1以下である必要はありません。
この条件は恐らく指数関数の発散を最低限防ぐためという予想だと思います。

おおよその傾向として以下の推測が出来ました。
\(\kappa, \lambda\)を\(\alpha,\beta,\gamma,\delta\)のゼロではないどれかだとすると、

  • \({\rm Re}{\kappa}={\rm Re}{\lambda}=0\)の時、つまらない画像になる
  • \({\rm Im}{\kappa}={\rm Im}{\lambda}=0\)の時、つまらない画像になる
  • \(\kappa=0\)または\(\lambda=0\)はつまらない画像になる
  • \(\alpha=\beta=0\)または\(\gamma=\delta=0\)はつまらない画像になる

だと感覚的にわかったので、これらを除外します。
さらに、\(0,\pm 0.5, \pm1\)のみを考えて僕自身が綺麗だと思う画像のみを集めてみました。
都合上、\(h=0.5\)と置いています。
また、範囲を固定するために点の撮りうる最大の値を固定してあります。

hatamap001_c3

hatamap002_c3

hatamap003_c3

hatamap004_c3

hatamap005_c3

hatamap006_c3

hatamap007_c3

考察

簡単に分かったことがあります。図の傾向は0.5の数や1の数に密接に関係しているようです。
ここで考えている4つのパラメータは、\(\kappa, \lambda\)のそれぞれ実部、虚部です。
ここで、この4つのパラメータを\((i,j,k,l)\)の組と考えましょう。括弧内の順番は特に関係なく、4つのパラメータの内どれか、を意味するとします。

例えば、初めの方にある、長方形の頂点に点が置かれたような図が得られるとき、4つのパラメータの組は\((0,0,\pm 1,\pm h)\)の組み合わせが多いことに気が付きます。
h100_c

続いて、これぞフラクタルだ、と思わせる形は\((\pm h, \pm h, \pm h, \pm h)\)、
hhhh_c

最後の方の紋様のような模様では\((\pm 1, \pm 1, \pm 1, \pm 1)\)で埋められているようです。
1111_c

恐らく、フラクタル的な雰囲気を持つ画像は、\(\kappa, \lambda\)の各々の値が有限で、絶対値が1とか、そんな時に出てくるのではないでしょうか。

今回調べた範囲のは、\(\alpha,\beta,\gamma,\delta\)のうち2つがゼロ、しかも0.5刻みしか許さないという非常に強い条件を入れた範囲です。
これだけでも膨大な数になることが、上の画像の量を見ただけで分かるでしょう。

本来は\(\alpha,\beta,\gamma,\delta\)がゼロではなくて良く、0.5刻みである必要もなく、実数ですから、今回調べたのはごくごく一部です。

綺麗な画像の定義があいまいなのもいけませんね。どうにかしてみたいものです。

また、同じく@snowy_treeさんが、


という綺麗なパラメータを集めたgifを公開してくれました。凄く綺麗なパラメータがたくさんあります！
とんでもなく綺麗な写像を見てみたいものです。

参考文献

[1]Dimensión, Análisis Multifractal y Aplicaciones
内の「3. Fractals in Mathematics (Hata)」
※中を見ると掲載されている元の論文はPatterns and Waves pp.259-278(1986)という論文のようです。
畑さんは、写像を拡張し統一的に扱おうとしたようです。なので、畑さんがこの写像を1から全て作った、というのは語弊があるかと思います。

[2]カオス #3,#6,#10,#11,#12,#13,#14,#15,#27畑政義写像 -主にコーディング

Web上で畑政義による写像が書けるサイトがありますので紹介いたします。
[2]畑政義写像で遊ぼう -救済に紹介されています。
(Play with Hata-map / 畑政義写像で遊ぼう)

[3]畑政義写像(1) -閃光的網站・弛緩複合体 Blog
※1. ただし、若干異なっています。
n回繰り返した時のみの写像の集まりのはずですが、どうやらn回に至るまでの点もプロットしているようです。n+1回繰り返しても似た画像しか出てこないのでまぁ、問題ないと思いますが…。

※2. また、どちらも上下が逆さまになっています。時々この上の二つで作成した値を私のプログラムに入れても再現できない場合があります。これに起因する問題なのか、別の要因なのかははっきりしません。

プログラミングと数値計算, 数学

平均、分散、標準偏差

コメントする

(i) 全データが存在する場合

　例１ ： ４０人クラスにおいてテスト点数の解析を行いたい(４０人全員の点数を知っている)。
　例２ ： 過去１年間、365日で体重がどのくらい増減したかの解析をしたい(365日分のデータが存在する)。
平均\(m\)
\(
\displaystyle m=\frac{1}{N}\sum_{i=1}^N x_i
\)
分散\(v\)
\(
\displaystyle v=\frac{1}{N}\sum_{i=1}^N (x_i-m)^2
\)
標準偏差\(\sigma\)
\(
\displaystyle \sigma=\sqrt{v}
\)

平均値から\(\pm 66\%\)の誤差に収まっている範囲は、
平均m ± 標準偏差σ　 と書ける。
例1 のクラスの点数の場合は、
平均m ± 標準偏差σ [点]　　となる。

(ii)一部分のデータしか存在しない場合

例１ ： ４０人クラスにおいて２３人しかテストの点数を知らないが、その２３人からクラス全体の点数の解析を行いたい（２３人の点数は分かる。残り１７人の点数は不明）。
　例２ ： 過去１年間、365日で体重の増減を解析したいが、200日分のデータしかない。だけど１年の解析を行いたい（165日分のデータは不明、紛失した）。
　　　　例３ ： 物理量の測定（測定回数が1000回だとしても、物理量は無限回の測定をしなければ真値は不明だ、と考える。）

この場合、平均、分散、標準偏差は
平均\(m’\)
\(
\displaystyle m’=\frac{1}{N}\sum_{i=1}^N x_i
\)
分散\(v’\)
\(
\displaystyle v’=\frac{1}{N}\sum_{i=1}^N (x_i-m’)^2
\)
標準偏差\(\sigma’\)
\(
\displaystyle \sigma’=\sqrt{v’}
\)
平均値から\(\pm 66\%\)の不確かさに収まっている範囲は、
平均m’ ± 標準偏差σ’　 と書ける。
例1 のクラスの点数の場合は、
平均m’ ± 標準偏差σ’ [点]　　となる。

誤差と不確かさ　は違うので注意しましょう。
誤差 → 完璧なデータのときに使う。
不確かさ → 本当の値を知らないときに使う。

プログラミングと数値計算

√xの数値積分(端点で特異点が存在する場合)

コメントする

\(\sqrt{x}\)を\([0\sim b]\)の範囲で数値的に積分したいとします。
この時に問題となるのは\(\sqrt{x}\)が\(x=0\)で特異点(この場合、一階微分が発散する)を持ってしまうことです。
解決するには変数変換を行い、
\(
\displaystyle \int_0^{b}\sqrt{x} dx = \int_0^{b^{1/2}} 2x^2 dx
\)
として右辺を計算するのが良いでしょう。

端点特異点を持つ場合、数値積分は工夫しなければなりません。
ここでは\(\sqrt{x}\)を\(0\)から\(b\)まで積分することを考えます。

問題点

台形則、シンプソン則などのニュートン・コーツ型の数値積分は点と点をラグランジュ補間(多項式による補間)を行って積分します。
そのため、多項式で表せない関数を数値積分するときは著しく積分精度が落ちてしまいます。
ガウス・ルジャンドル求積法は次数が高いだけでニュートンコーツ型と同じラグランジュ補間を行うため精度が良くありません。
こういった時には台形則を組み合わせて精度評価が出来るロンバーグ積分法による方法が推奨されますが、結局は台形則なので、多項式の表現から抜け出ることはできず、被積分関数の評価回数がかなり多くなってしまいます。

ガウス求積法の一部にラゲール多項式を用いるガウス・ラゲール求積法があります。
これは
\(x=0\)で\(x^{\alpha},(0\lt \alpha)\)の振る舞い
かつ
\(x=\infty\)で被積分関数が\(e^{-x}\)で減衰する関数
に対して非常によい方法ですが、これを使う際の積分範囲は\([0\sim \infty]\)であり、今回の場合うまく用いることが出来ません。

最善の方法は二重指数関数型数値積分公式(DE公式)という積分法でしょう。
補間するのではなく、変数変換によって積分する空間を変えて積分する方法で、端点特異点がある場合に強い方法です二重指数関数型数値積分(理論とプログラム)。
端点でDE公式も使えないほどの非常に強い特異性を持つ場合、超函数法(hyperfunction method)と呼ばれる数値積分法が良いそうです。

ある程度の精度で簡単に計算するのならば、積分区間を分割します。
被積分関数が特異性を発揮するのは\(x=0\)付近ですから、積分
\(
\displaystyle \int_0^{b}\sqrt{x} dx = \int_0^{\Delta}\sqrt{x} dx + \int_{\Delta}^b\sqrt{x} dx
\)
にし、右辺第1項を低次の方法(例えば台形則)で分点数を多くとり計算します。第2項には特異性を含まないので荒い積分方法で良いでしょう。

実際に\(\sqrt{x}\)の数値積分が困難であることを数値計算で示します。
\(
\displaystyle \int_0^1 \sqrt{x} dx = \frac{2}{3} = 0.66666666666\cdots
\)
を各々の方法で計算しますと、

  0.666172080968984      短冊近似　　　(1000分割)
  0.666660362218984      台形則　　　　(1000分割)
  0.666664189108662      シンプソン則　(1000分割)
  0.666664574081247      ロンバーグ則　(1000分割,相対誤差12桁一致)
  0.666666768098704      ガウス・ルジャンドル求積(100点)

という結果を得ます。
いかに特異点が存在する際の数値積分が難しいか分かるでしょう。

解決法

変数変換を行います。
これにより被積分関数を多項式に置き換えることが出来ます。
変数変換により、
\(
\displaystyle \int_0^{b}\sqrt{x} dx = \int_0^{b^{1/2}} 2x^2 dx
\)
と、簡単になります。
実際、右辺を数値的に計算してみますと、

  0.665690422058105      短冊近似　　　(1000分割)
  0.666666984558105      台形則　　　　(1000分割)
  0.666666666666667      シンプソン則　(1000分割)
  0.666666666666667      ロンバーグ則　(1000分割,相対誤差12桁一致)
  0.666666666666654      ガウス・ルジャンドル求積(100点)

となります。短冊近似、台形則で精度が悪いのは\(x^2\)の多項式はこの二つの方法では元々出来ないものなのでこれは問題ありません。数値計算法の想定と一致する結果が導かれています。

プログラミングと数値計算

fortran90によるヒープソートとバブルソート

コメントする

fortran90で配列のソートを行うプログラムを載せます。
クイックソート(ここでは載せません)はヒープソートよりも若干遅くなってしまいました。
プログラムの最適化が出来ていない、Fortranの性質（ルーチンの呼び出しが遅い）からかもしれません。

どういうソート方法なのかはwikipediaをご参照ください（ヒープソート、バブルソート）。

計算時間はヒープソートの方が圧倒的に早いです。

クイックソートの方がヒープソートよりも早いです。コードは最速のクイックソートへ。

倍精度型の、サイズNの配列arrayを昇順(小さい数から大きい数へ)に並べ替えます。

バブルソート

平均計算量\(O(N^2)\)

subroutine bubblesort(N,array)
  !sikinote, 2016/08/08
  implicit none
  integer,intent(in)::N
  double precision,intent(inout)::array(1:N)
  integer::i,j
  double precision::t
   
  do i=1,N-1
     do j=i+1,N
        if(array(i) .gt. array(j))then
           t=array(i)
           array(i)=array(j)
           array(j)=t
        end if
     end do
  end do

  return
end subroutine bubblesort

ヒープソート

平均計算量\(O(N\log N)\)

subroutine heapsort(n,array)
  implicit none
  integer,intent(in) :: n
  double precision,intent(inout) :: array(1:n)
 
  integer ::i,k,j,l
  double precision :: t
 
  if(n.le.0)then
     write(6,*)"Error, at heapsort"; stop
  endif
  if(n.eq.1)return

  l=n/2+1
  k=n
  do while(k.ne.1)
     if(l.gt.1)then
        l=l-1
        t=array(L)
     else
        t=array(k)
        array(k)=array(1)
        k=k-1
        if(k.eq.1) then
           array(1)=t
           exit
        endif
     endif
     i=l
     j=l+l
     do while(j.le.k)
        if(j.lt.k)then
           if(array(j).lt.array(j+1))j=j+1
        endif
        if (t.lt.array(j))then
           array(i)=array(j)
           i=j
           j=j+j
        else
           j=k+1
        endif
     enddo
     array(i)=t
  enddo

  return
end subroutine heapsort

[adsense1]

配列arrayをどのように入れ替えたのか？という情報が欲しければ

バブルソート

平均計算量\(O(N^2)\)

subroutine bubblesort2(N,data,turn)
  !sikinote, 2016/08/08
  integer,intent(in)::N
  integer,intent(out)::turn(1:N)
  double precision,intent(inout)::data(1:N)
  integer::i,j,ti
  double precision::tmp

  do i=1,N
     turn(i)=i
  enddo

  do i=1,N-1
     do j=i+1,N
        if(data(i) .gt. data(j))then
           tmp=data(i)
           data(i)=data(j)
           data(j)=tmp
         
           ti=turn(i)
           turn(i)=turn(j)
           turn(j)=ti
        end if
     end do
  end do

  return
end subroutine bubblesort2

ヒープソート

平均計算量\(O(N\log N)\)

subroutine heapsort2(n,array,turn)
  implicit none
  integer,intent(in)::n
  integer,intent(out)::turn(1:n)
  double precision,intent(inout)::array(1:n)
 
  integer::i,k,j,l,m
  double precision::t
 
  if(n.le.0)then
     write(6,*)"Error, at heapsort"; stop
  endif
  if(n.eq.1)return

  do i=1,N
     turn(i)=i
  enddo

  l=n/2+1
  k=n
  do while(k.ne.1)
     if(l.gt.1)then
        l=l-1
        t=array(l)
        m=turn(l)
     else
        t=array(k)
        m=turn(k)
        array(k)=array(1)
        turn(k)=turn(1)
        k=k-1
        if(k.eq.1) then
           array(1)=t
           turn(1)=m
           exit
        endif
     endif
     i=l
     j=l+l
     do while(j.le.k)
        if(j.lt.k)then
           if(array(j).lt.array(j+1))j=j+1
        endif
        if (t.lt.array(j))then
           array(i)=array(j)
           turn(i)=turn(j)
           i=j
           j=j+j
        else
           j=k+1
        endif
     enddo
     array(i)=t
     turn(i)=m
  enddo

  return
end subroutine heapsort2

というプログラムで実装できます。

プログラム例1 ソートする

実際に実行してみます。
乱数で振った配列aを昇順に並べ替えるには

program main
  implicit none
  integer::i,N
  double precision,allocatable::a(:)
  double precision::t
 
  N=10
  allocate(a(0:N-1)); a=0d0

  do i=0,N-1
     call random_number(t)
     a(i)=t
     write(6,*)a(i)
  enddo

  call heapsort(size(a),a)
  do i=0,N-1
     write(6,*)i,a(i)
  enddo
 
  stop
end program main
   
subroutine heapsort(n,array)
  implicit none
  integer,intent(in) :: n
  double precision,intent(inout) :: array(1:n)
 
  integer ::i,k,j,l
  double precision :: t
 
  if(n.le.0)then
     write(6,*)"Error, at heapsort"; stop
  endif
  if(n.eq.1)return

  l=n/2+1
  k=n
  do while(k.ne.1)
     if(l.gt.1)then
        l=l-1
        t=array(L)
     else
        t=array(k)
        array(k)=array(1)
        k=k-1
        if(k.eq.1) then
           array(1)=t
           exit
        endif
     endif
     i=l
     j=l+l
     do while(j.le.k)
        if(j.lt.k)then
           if(array(j).lt.array(j+1))j=j+1
        endif
        if (t.lt.array(j))then
           array(i)=array(j)
           i=j
           j=j+j
        else
           j=k+1
        endif
     enddo
     array(i)=t
  enddo

  return
end subroutine heapsort

とすればよいです。実行結果は

$ gfortran main.f90
$ ./a.out
  0.99755959009261719    
  0.56682470761127335    
  0.96591537549612494    
  0.74792768547143218    
  0.36739089737475572    
  0.48063689875473148    
   7.3754263633984518E-002
   5.3552292777272470E-003
  0.34708128851801545    
  0.34224381607283505    
           0   5.3552292777272470E-003
           1   7.3754263633984518E-002
           2  0.34224381607283505    
           3  0.34708128851801545    
           4  0.36739089737475572    
           5  0.48063689875473148    
           6  0.56682470761127335    
           7  0.74792768547143218    
           8  0.96591537549612494    
           9  0.99755959009261719    
$

となります。

[adsense2]

プログラム例2 どのように並べ替えたかの順番を知る

program main
  implicit none
  integer::i,N
  integer,allocatable::turn(:)
  double precision,allocatable::a(:)
  double precision::t
 
  N=10
  allocate(a(0:N-1)); a=0d0
  allocate(turn(0:N-1)); turn=0

  do i=0,N-1
     call random_number(t)
     a(i)=t
     write(6,*)i,a(i)
  enddo
  write(6,*)

  call heapsort2(size(a),a,turn)
  do i=0,N-1
     write(6,*)turn(i),a(i)
  enddo
 
  stop
end program main
   
subroutine heapsort2(n,array,turn)
  implicit none
  integer,intent(in)::n
  integer,intent(out)::turn(1:n)
  double precision,intent(inout)::array(1:n)
 
  integer::i,k,j,l,m
  double precision::t
 
  if(n.le.0)then
     write(6,*)"Error, at heapsort"; stop
  endif
  if(n.eq.1)return

  do i=1,N
     turn(i)=i
  enddo

  l=n/2+1
  k=n
  do while(k.ne.1)
     if(l.gt.1)then
        l=l-1
        t=array(l)
        m=turn(l)
     else
        t=array(k)
        m=turn(k)
        array(k)=array(1)
        turn(k)=turn(1)
        k=k-1
        if(k.eq.1) then
           array(1)=t
           turn(1)=m
           exit
        endif
     endif
     i=l
     j=l+l
     do while(j.le.k)
        if(j.lt.k)then
           if(array(j).lt.array(j+1))j=j+1
        endif
        if (t.lt.array(j))then
           array(i)=array(j)
           turn(i)=turn(j)
           i=j
           j=j+j
        else
           j=k+1
        endif
     enddo
     array(i)=t
     turn(i)=m
  enddo

  return
end subroutine heapsort2

実行例

$ gfortran main.f90
$ ./a.out
           0  0.99755959009261719    
           1  0.56682470761127335    
           2  0.96591537549612494    
           3  0.74792768547143218    
           4  0.36739089737475572    
           5  0.48063689875473148    
           6   7.3754263633984518E-002
           7   5.3552292777272470E-003
           8  0.34708128851801545    
           9  0.34224381607283505    

           8   5.3552292777272470E-003
           7   7.3754263633984518E-002
          10  0.34224381607283505    
           9  0.34708128851801545    
           5  0.36739089737475572    
           6  0.48063689875473148    
           2  0.56682470761127335    
           4  0.74792768547143218    
           3  0.96591537549612494    
           1  0.99755959009261719
プログラミングと数値計算

4倍精度演算(fortran90)

コメントする

fortran90において4倍精度で計算を行います。

メリット
情報落ちの回避
桁落ちの回避

デメリット
計算速度が遅い(倍精度の40~50倍!)
4倍精度に対応しているライブラリが少ない

計算式を工夫して、どうしても4倍精度でないと解けない場合のみ4倍精度を使うことを考えましょう。

  1. 4倍精度の存在理由
  2. 4倍精度演算の組み込み関数
  3. 4倍精度陽的ルンゲクッタ法(刻み幅制御)
  4. 4倍精度陰的ルンゲクッタ法(刻み幅制御)
  5. 4倍精度の一般行列の対角化(複素非エルミート)
  6. 4倍精度のLU分解による連立方程式

4倍精度の存在理由

4倍精度は倍精度演算を正しく行うための補助的存在です。
初めから最後まで4倍精度で行うことはほとんどありません。
4倍精度が効果を発揮する桁落ちの例を考えましょう。

計算
\(
1-(1+\frac{10^{-10}}{3})
\)
を考えます。
答えは\(-3.333333\cdots\times 10^{-11}\)です。
数値計算で倍精度と4倍精度で試してみますと、

program main
  implicit none
 
  write(6,*)1d0-(1d0+(1d-10)/3d0)
  write(6,*)1q0-(1q0+(1q-10)/3q0)
 
  stop
end program main

であり、実行結果は

$ ifort main.f90
$ ./a.out
 -3.333333609134570E-011
 -3.333333333333333333333342109654793E-0011
$

となります。計算過程で工夫もできないような場合、4倍精度を利用して

program main
  implicit none
  double precision::a
  real*16::b
 
  b=1q0-(1q0+(1q-10)/3q0)
  a=dble(b)
  write(6,*)a
 
  stop
end program main

として途中だけ4倍精度にして計算する、これが4倍精度の存在理由です。
上記プログラムを実行すると

-3.333333333333333E-011

となります。

想定

4倍精度演算は決まった書き方が無く、コンパイラに依存します(補足1)。
ここでは、
intel®fortran コンパイラ(ifort (IFORT) 16.0.2 20160204)
と
gnu fortran コンパイラ(GNU Fortran (Ubuntu 4.8.4-2ubuntu1~14.04.1) 4.8.4
)
の二つで動作することを考えます。

4倍精度変数の宣言方法

4倍精度実数、4倍精度複素数は

real*16::a
complex*32::c

と変数宣言をしましょう。
値を代入する際は、

a=1q0
c=cmplx(1q0,2q0,kind=16)

として”q”を用います。
※”c=cmplx(1q0,2q0)”としてはダメです。
複素数への代入はcmplx(実部、虚部、精度指定)でないといけません。
ifortだけであれば、qcmplxで自動的に精度が4倍精度指定されますが、gfortranではkindで指定しないと代入されません。実際、

program main
  implicit none
  complex*32::z

  z=cmplx(1q0/3q0,1q0)
  write(6,*)z  
 
  z=cmplx(1q0/3q0,1q0,kind=16)
  write(6,*)z

  stop
end program main

を実行すると、gfortranでもifortでも

$ ifort main.f90
$ ./a.out
 (0.333333343267440795898437500000000,1.00000000000000000000000000000000)
 (0.333333333333333333333333333333333,1.00000000000000000000000000000000)
$
$ gfortran main.f90
$ ./a.out
 ( 0.333333343267440795898437500000000000      ,  1.00000000000000000000000000000000000      )
 ( 0.333333333333333333333333333333333317      ,  1.00000000000000000000000000000000000      )
$

という結果を得て、正しく値が代入されません。

[adsense1]

4倍精度演算のための組み込み関数

基本的には総称名を用いるのが良いと思います[1,2]。

a=sin(4q0)
c=exp(cmplx(3q0,1q0,kind=16))

倍精度から4倍精度に変換する際は、

a=sin(4d0)*1q0
c=cmplx(exp(3q0),kind=16)

とすると良いでしょう。あとは他の精度の時と同じです。

ルンゲクッタ法の4倍精度刻み幅制御

4倍精度でルンゲクッタ法を行います。(刻み幅制御ルンゲクッタ法についてはルンゲクッタ法の説明と刻み幅制御をご覧ください。)
対象とする微分方程式は
\(
\displaystyle \frac{d^2y}{dx^2}=\left(-\frac{1}{4x^2}+\frac{i}{x}-1\right)y
\)
を初期条件
\(
\begin{align}
\left. y(x)\right|_{x=1}=\exp(i) \\
\left. \frac{dy(x)}{dx}\right|_{x=1}=\left(\frac{1}{2}+i\right)\exp(i)
\end{align}
\)
の条件下で解くものです。解析解は\(y(x)=\exp(ix)\sqrt{x},\frac{dy(x)}{dx}=\left(\frac{1}{2x}+i\right)\exp(ix)\sqrt{x} \)となります。
メインのコードは

program main
  use qRKmod
  implicit none
  integer::i,N,Nx,info
  real*16::dx,tol,xbound,x0,tx
  real*16,allocatable::x(:)
  complex*32,allocatable::y(:),ss(:)
  complex*32::rkfc
  external::rkfc
 
  N=2
  allocate(y(1:N))
 
  x0=1q0; dx=1000q0; Nx=2
  allocate(x(0:Nx-1))
  do i=0,Nx-1
     x(i)=x0+dble(i)*dx
  enddo

  y(1)=exp(cmplx(0q0,1q0,kind=16))
  y(2)=cmplx(0.5q0,1q0,kind=16)*y(1)

  call qrk_preparation("rkf45")

  tol=1q-18
  write(10,'(3e30.17e4)')x(0),real(y(1)),imag(y(1))
  do i=1,Nx-1
     info=0; tx=x(i-1); xbound=x(i)
     call qrkf45_e(rkfc,tx,y,xbound,info,tol)
     if(info.eq.-1)write(6,'(A,f10.5,A,f10.5)')"strange point between ",x(i-1)," and ",x(i)
 
     write(10,'(3e30.17e4)')x(i),real(y(1)),imag(y(1))
  enddo
  write(6,*)x(0),y(1)
 
  call qrk_deallocation("rkf45")
 
  stop
end program main
!----------------
function rkfc(N,x,y,s)
  implicit none
  integer,intent(in)::N,s
  real*16,intent(in)::x
  complex*32::y(1:N)
  complex*32::rkfc
 
  rkfc=0q0
  if(s.eq.1)then
     rkfc=y(2)
  elseif(s.eq.2)then
     rkfc=(-1q0/(4q0*x*x)+cmplx(0q0,1q0,kind=16)/x-1q0)*y(1)
  else
     write(6,*)"unknown s, program stop"
     stop
  endif
 
  return
end function rkfc

で、4倍精度用のルンゲクッタ法のモジュールはこちら。

1ステップ当りの精度を18桁に設定し、実行すると
実行すると、

$ ifort qrkmod.f90 qmain.f90
$ ./a.out
   1.00000000000000000000000000000000      
 (-12.4004402201339396388318226191018,29.1071998369283977905998988164457)
$
$ gfortran qrkmod.f90 qmain.f90
$ ./a.out
   1.00000000000000000000000000000000000       ( -12.4004402201339396388318226207936776      ,  29.1071998369283977905998988157304999      )
$

という結果を得ます。
ここに表示されているのは、解析解の\(x=1001\)での値で、
-12.400440220133925015780697384759199505100325758422733906… +
29.107199836928403740368952842025341239069669658649312423… i
が厳密値となります。
x=1001で数値計算解と比較すると15桁一致していることが分かります。

計算時間は倍精度計算の約40倍かかりますが、どうしても16桁近い精度が欲しい場合や桁落ちが激しいことが分かっている場合には、途中を4倍精度で演算して後で倍精度に戻す、と言う方法が良いでしょう。

[adsense2]

計算時間について

ルンゲクッタ法で、倍精度、4倍精度を比較します。
中身が複雑なのであまり良い比較方法ではありませんが、目安としてどの程度か分かるでしょう。
CPU時間を計測します。

上記微分方程式を10回解いたとき、
倍精度では
0.298 [秒]
4倍精度では
11.268[秒]
でした。
約40倍遅いことが分かります。
計算が工夫できるならするべきです。むやみに4倍精度を使ってはなりません。

補足1)コンパイラに依存してしまうとは？

例えば、
\(1/3\)を計算してみましょう。

program main
  implicit none

  write(6,*)qext(1d0/3d0)
 
  stop
end program main

”qext”は倍精度→4倍精度の型変換をする組み込み関数です。
このコードをifortで行うと計算が実行され、
実行結果

$ ifort main.f90
$ ./a.out
  0.333333333333333314829616256247391  
$

を得ます。しかし、同じコードをgfortranでコンパイルしようとすると、

$ gfortran main.f90
main.f90:4.12:

  write(6,*)qext(1d0/3d0)
            1
Error: Function 'qext' at (1) has no IMPLICIT type
$

となり、コンパイルが出来ません。
この場合、型変換用の組み込み関数を使わないで、

program main
  implicit none

  write(6,*)(1d0/3d0)*1q0
 
  stop
end program main

とするのが良いでしょう。
異なる型の演算は高い方の型に合わせられることを利用します。
すると、どちらのコンパイラでもokで、

$ gfortran main.f90
$ ./a.out
  0.333333333333333314829616256247390993      
$ ifort main.f90
$ ./a.out
  0.333333333333333314829616256247391      
$

となります。
gfortranとifortで表示されている桁数が違うのは標準出力の違いだけのようです。
なぜなら、組み込み関数[3]
———————————————————–
precision:10進数で表現できる桁数
epsilon:機械精度(1にこの値を足しても1のままになる最大の値)
tiny:指数表現での最小値
huge:指数表現での最大値
———————————————————–
を使って調べると、

program main
  implicit none
  real*16::a
 
  write(6,*)precision(a)
  write(6,*)epsilon(a)
  write(6,*)tiny(a)
  write(6,*)huge(a)

  stop
end program main

実行結果

$ ifort main.f90
$ ./a.out
          33
  1.925929944387235853055977942584927E-0034
  3.362103143112093506262677817321753E-4932
  1.189731495357231765085759326628007E+4932
$
$ gfortran main.f90
$ ./a.out
          33
   1.92592994438723585305597794258492732E-0034
   3.36210314311209350626267781732175260E-4932
   1.18973149535723176508575932662800702E+4932
$

という結果が得られるからです。

4倍精度の陰的ルンゲクッタ法

4倍精度の陰的ルンゲクッタ法については
陰的Runge-Kutta法
に載せてありますので、そちらをご覧ください。

4倍精度の一般行列の対角化

複素非エルミート行列の対角化については
4倍精度の一般行列の対角化
に載せてありますので、そちらをご覧ください。

4倍精度のLU分解による連立方程式の解法

4倍精度のLU分解を用いた連立方程式の解法は
九州大学の渡部 善隆様が公開なさっているGECP(Gaussian Elimination with Complete Pivoting, 一般実行列に対する連立1次方程式の数値解を完全ピボット選択付き Gauss の消去法によって求める Fortran サブルーチン)
によって実現できます[4]。
http://yebisu.cc.kyushu-u.ac.jp/~watanabe/RESERCH/GECP/index.html。
再配布可能です。

参考文献

[1]9.58 CMPLX — Complex conversion function -The GNU Fortran Compiler(gfortran complex精度指定)
[2]第 3 章 FORTRAN 77 および VMS 組み込み関数 -Sun Studio 12: Fortran ライブラリ・リファレンス
[3]浅岡 香枝、平野 彰雄、”はじめてのFortran90”
[4]渡部 善隆, 一般実行列に対する連立1次方程式の数値解を完全ピボット選択付き Gauss の消去法http://yebisu.cc.kyushu-u.ac.jp/~watanabe/RESERCH/GECP/index.html

プログラミングと数値計算

ガウス=クロンロッド求積法

コメントする

ガウス=クロンロッド求積法と呼ばれる数値積分法です。

  1. ガウス=クロンロッド求積法の説明
  2. fortran90によるプログラム
    1. 15次ガウス=クロンロッド求積(\([-1\sim 1]\))
    2. 15次ガウス=クロンロッド求積(\([a\sim b]\))
    3. 61次ガウス=クロンロッド求積(\([a\sim b]\))
  3. 参考文献

説明

ガウス=ルジャンドル求積法の補助的な存在、というとらえ方でいいと思います。
通常はガウス=ルジャンドル求積法の誤差推定のために使われるらしいです。

積分
\(
\displaystyle \int_{-1}^{1} f(x) dx
\)
を、
\(
\displaystyle \int_{-1}^{1} f(x) dx \approx \sum_{i=1}^{2N+1} \omega_i f(x_i)+\mathcal{O}(x^{3N+1})
\)
として近似します。ここで、\(\omega_i\)は点\(x_i\)での重みを意味します。
\(\omega_i, x_i\)は任意に決められず、\(N\)をいくつにするかによって強制的に決定されます。

ガウス=クロンロッド求積法は次数(\(2N+1\))を用いたとき、被積分関数が
\(x^{3N+1}\)以下の多項式であれば厳密な積分値を返しますCHAPTER 5 Numerical Quadrature。
Nは次数。分点数と一致。

重要な事ですが、被積分関数が多項式ではない場合、あまりよくない積分結果になってしまいます。
例えば、積分
\(
\displaystyle \int_0^b \sqrt{x} dx
\)
を考えると、被積分関数が多項式で書けないので、精度はガクッと落ちます。
この理由は、被積分関数の微分が\(x=0\)で発散するためであり、高次の積分法になるほど顕著に表れます。

また、ルンゲ現象に代表される、高次で発生する様々な問題を排除するため、通常は積分区間を複数に分けて、低次の積分法を組み合わせて計算を行います。

[adsense1]

fortran90によるプログラム

以下のプログラムは15次ガウス=クロンロッド求積法のプログラムです。
これは、積分
\(
\displaystyle \int_{-1}^{1}e^{-x} dx = 2\sinh(1) \approx 2.350402387287602913764764
\)
を計算するプログラムとなっています。

program main
  implicit none
  integer::i,N
  double precision,allocatable::x(:),w(:)
  double precision::f,s
  external::f
 
  N=15
  allocate(x(1:N),w(1:N)); x=0d0; w=0d0
  call GaussKronrod15(x,w)
  s=0d0
  do i=1,N
     s=s+w(i)*f(x(i))
  enddo  
  write(6,*)s

  deallocate(x,w)  
 
  stop
end program main

function f(x)
  implicit none
  double precision,intent(in)::x
  double precision::f
 
  f=exp(-x)

  return
end function f

subroutine GaussKronrod15(x,w)
  !Gauss-Kronrod Quadrature Nodes and Weights
  !http://www.advanpix.com/2011/11/07/gauss-kronrod-quadrature-nodes-weights/
  implicit none
  double precision,intent(out)::x(1:15),w(1:15)
 
  integer::i
  integer,parameter::N=15
 
  x=0d0; w=0d0
 
  x( 8) = 0d0
  x( 9) = 2.077849550078984676006894037732449d-1
  x(10) = 4.058451513773971669066064120769615d-1
  x(11) = 5.860872354676911302941448382587296d-1
  x(12) = 7.415311855993944398638647732807884d-1
  x(13) = 8.648644233597690727897127886409262d-1
  x(14) = 9.491079123427585245261896840478513d-1
  x(15) = 9.914553711208126392068546975263285d-1  
  do i=1,7
     x(i)=-x(N-i+1)
  enddo
 
  w( 8) = 2.094821410847278280129991748917143d-1
  w( 9) = 2.044329400752988924141619992346491d-1
  w(10) = 1.903505780647854099132564024210137d-1
  w(11) = 1.690047266392679028265834265985503d-1
  w(12) = 1.406532597155259187451895905102379d-1
  w(13) = 1.047900103222501838398763225415180d-1
  w(14) = 6.309209262997855329070066318920429d-2
  w(15) = 2.293532201052922496373200805896959d-2
  do i=1,7
     w(i)=w(N-i+1)
  enddo

  return
end subroutine GaussKronrod15

実行結果は
2.35040238728760
となり、厳密値
2.350402387287602913
と全桁一致します。

区間変更

定義そのままでは\([-1\sim 1]\)なので、区間を変更しましょう。
区間変更は\(y=\frac{b-a}{2}x+\frac{b+a}{2}\)と変数変換をすれば、

\(
\begin{align}
\int_a^b f(x) dx &= \int_{-1}^{1} f(y) \frac{b-a}{2}dy \\
&\approx \sum_{i=1}^N \left(\frac{b-a}{2}\omega_i\right) f(\frac{b-a}{2}x+\frac{b+a}{2}) \\
&= \sum_{i=1}^N \omega_i’ f(x_i’)
\end{align}
\)
と掛けます。これをプログラムします。
ここでは、積分
\(
\displaystyle \int_{1}^{2.4}e^{-x} dx = e^{-1}-e^{-2.4} \approx 0.27716148788202981
\)
を計算します。

program main
  implicit none
  integer::i,N
  double precision,allocatable::x(:),w(:)
  double precision::f,s
  external::f
 
  N=15
  allocate(x(1:N),w(1:N)); x=0d0; w=0d0
  call GaussKronrod15ab(1d0,2.4d0,x,w)
  s=0d0
  do i=1,N
     s=s+w(i)*f(x(i))
  enddo  
  write(6,*)s

  deallocate(x,w)  
 
  stop
end program main

function f(x)
  implicit none
  double precision,intent(in)::x
  double precision::f
 
  f=exp(-x)

  return
end function f

subroutine GaussKronrod15ab(a,b,x,w)
  !Gauss-Kronrod Quadrature Nodes and Weights
  !http://www.advanpix.com/2011/11/07/gauss-kronrod-quadrature-nodes-weights/
  implicit none
  double precision,intent(in)::a,b
  double precision,intent(out)::x(1:15),w(1:15)
 
  integer::i
  integer,parameter::N=15
 
  x=0d0; w=0d0
 
  x( 8) = 0d0
  x( 9) = 2.077849550078984676006894037732449d-1
  x(10) = 4.058451513773971669066064120769615d-1
  x(11) = 5.860872354676911302941448382587296d-1
  x(12) = 7.415311855993944398638647732807884d-1
  x(13) = 8.648644233597690727897127886409262d-1
  x(14) = 9.491079123427585245261896840478513d-1
  x(15) = 9.914553711208126392068546975263285d-1  
  do i=1,7
     x(i)=-x(N-i+1)
  enddo
 
  w( 8) = 2.094821410847278280129991748917143d-1
  w( 9) = 2.044329400752988924141619992346491d-1
  w(10) = 1.903505780647854099132564024210137d-1
  w(11) = 1.690047266392679028265834265985503d-1
  w(12) = 1.406532597155259187451895905102379d-1
  w(13) = 1.047900103222501838398763225415180d-1
  w(14) = 6.309209262997855329070066318920429d-2
  w(15) = 2.293532201052922496373200805896959d-2
  do i=1,7
     w(i)=w(N-i+1)
  enddo
 
  x=0.5d0*((b-a)*x+(a+b))
  w=0.5d0*(b-a)*w
 
  return
end subroutine GaussKronrod15ab

となります。

実行結果は
0.277161487882030
となり、厳密値
0.27716148788202981
と全桁一致します。数値計算なので、最後のところは四捨五入されています。

61次ガウス=クロンロッド求積法

61次ガウス=クロンロッド求積法のコードも置いておきます。
これほどの高次は余り使わず、低次のものを組み合わせたほうが良いことを再び書いておきます。

積分
\(
\displaystyle \int_{-3}^{20}e^{-x} dx = e^{3}-e^{-20} \approx 20.0855369211265141
\)
を計算します。

program main
  implicit none
  integer::i,N
  double precision,allocatable::x(:),w(:)
  double precision::f,s
  external::f
 
  N=61
  allocate(x(1:N),w(1:N)); x=0d0; w=0d0
  call GaussKronrod61ab(-3d0,20d0,x,w)
  s=0d0
  do i=1,N
     s=s+w(i)*f(x(i))
  enddo  
  write(6,*)s

  deallocate(x,w)  
 
  stop
end program main

function f(x)
  implicit none
  double precision,intent(in)::x
  double precision::f
 
  f=exp(-x)

  return
end function f

subroutine GaussKronrod61ab(a,b,x,w)
  !Gauss-Kronrod Quadrature Nodes and Weights
  !http://www.advanpix.com/2011/11/07/gauss-kronrod-quadrature-nodes-weights/
  implicit none
  double precision,intent(in)::a,b
  double precision,intent(out)::x(1:61),w(1:61)
 
  integer::i
  integer,parameter::N=61
 
  x=0d0; w=0d0
 
  x(31:61) = &
       (/0.000000000000000000000000000000000d0  &
       , 5.147184255531769583302521316672257d-2 &
       , 1.028069379667370301470967513180006d-1 &
       , 1.538699136085835469637946727432559d-1 &
       , 2.045251166823098914389576710020247d-1 &
       , 2.546369261678898464398051298178051d-1 &
       , 3.040732022736250773726771071992566d-1 &
       , 3.527047255308781134710372070893739d-1 &
       , 4.004012548303943925354762115426606d-1 &
       , 4.470337695380891767806099003228540d-1 &
       , 4.924804678617785749936930612077088d-1 &
       , 5.366241481420198992641697933110728d-1 &
       , 5.793452358263616917560249321725405d-1 &
       , 6.205261829892428611404775564311893d-1 &
       , 6.600610641266269613700536681492708d-1 &
       , 6.978504947933157969322923880266401d-1 &
       , 7.337900624532268047261711313695276d-1 &
       , 7.677774321048261949179773409745031d-1 &
       , 7.997278358218390830136689423226832d-1 &
       , 8.295657623827683974428981197325019d-1 &
       , 8.572052335460610989586585106589439d-1 &
       , 8.825605357920526815431164625302256d-1 &
       , 9.055733076999077985465225589259583d-1 &
       , 9.262000474292743258793242770804740d-1 &
       , 9.443744447485599794158313240374391d-1 &
       , 9.600218649683075122168710255817977d-1 &
       , 9.731163225011262683746938684237069d-1 &
       , 9.836681232797472099700325816056628d-1 &
       , 9.916309968704045948586283661094857d-1 &
       , 9.968934840746495402716300509186953d-1 &
       , 9.994844100504906375713258957058108d-1 /)

  do i=1,30
     x(i)=-x(N-i+1)
  enddo
  w(31:61)= &
       (/5.149472942945156755834043364709931d-2 &
       , 5.142612853745902593386287921578126d-2 &
       , 5.122154784925877217065628260494421d-2 &
       , 5.088179589874960649229747304980469d-2 &
       , 5.040592140278234684089308565358503d-2 &
       , 4.979568342707420635781156937994233d-2 &
       , 4.905543455502977888752816536723817d-2 &
       , 4.818586175708712914077949229830459d-2 &
       , 4.718554656929915394526147818109949d-2 &
       , 4.605923827100698811627173555937358d-2 &
       , 4.481480013316266319235555161672324d-2 &
       , 4.345253970135606931683172811707326d-2 &
       , 4.196981021516424614714754128596976d-2 &
       , 4.037453895153595911199527975246811d-2 &
       , 3.867894562472759295034865153228105d-2 &
       , 3.688236465182122922391106561713597d-2 &
       , 3.497933802806002413749967073146788d-2 &
       , 3.298144705748372603181419101685393d-2 &
       , 3.090725756238776247288425294309227d-2 &
       , 2.875404876504129284397878535433421d-2 &
       , 2.650995488233310161060170933507541d-2 &
       , 2.419116207808060136568637072523203d-2 &
       , 2.182803582160919229716748573833899d-2 &
       , 1.941414119394238117340895105012846d-2 &
       , 1.692088918905327262757228942032209d-2 &
       , 1.436972950704580481245143244358001d-2 &
       , 1.182301525349634174223289885325059d-2 &
       , 9.273279659517763428441146892024360d-3 &
       , 6.630703915931292173319826369750168d-3 &
       , 3.890461127099884051267201844515503d-3 &
       , 1.389013698677007624551591226759700d-3/)
  do i=1,30
     w(i)=w(N-i+1)
  enddo
 
  x=0.5d0*((b-a)*x+(a+b))
  w=0.5d0*(b-a)*w
 
  return
end subroutine GaussKronrod61ab

実行結果
20.0855369211265
厳密値
20.0855369211265141

[adsense2]

fortran90で、任意の次数の求積点を知りたければ、f90のプログラムが
KRONROD Gauss-Kronrod Quadrature Rules -Source Codes in
Fortran90
にて公開されています。

参考文献

Gauss-Kronrod Quadrature Nodes and Weights

プログラミングと数値計算

unformattedによるファイル入出力(fortran90)

コメントする

fortran90でファイルの入出力に関する設定です。

fortranでデータの書き出しには、
書式付きと書式なしがあります。

書式付きはそこでプログラムがすべて終わる時
書式なしはそのデータを使って別のプログラムを動かす時
と使い分けられると思います。

[adsense1]

書式付き

利点
・テキストデータなので、結果を人間がわかりやすい形で出力出来る。
・ミスを発見しやすい
欠点
・データの書き出しに時間がかかる
・データ量が多くなる(書式なしの約3倍)

書式付きは、例えば

open(10,file="test.d")
write(10,'(A,i5,e15.5e2)')"aaa",j,alpha

見たいに書式を指定して書ださせることです。

書式なし

利点
・書き出し時間を短くできる
・データ量が少なくなる(書式付の約1/3倍)
・簡潔にコードが書ける
欠点
・バイナリファイルなので出力結果を直接見ることが出来ない。

書式なしのプログラムでは、

open(10,file="test.bin",form="unformatted")
write(10)"aaa",j,alpha

の様に書きます。

実際のプログラムでは、

program main
  implicit none
  integer,parameter::N1=4
  integer,parameter::N2=7

  integer::i,j
  double precision::A(1:N1),B(1:N2)
  complex(kind(0d0))::CC(1:N1,1:N2)
 
  do i=1,N1
     A(i)=100d0+dble(i)
  enddo
  do j=1,N2
     B(j)=dble(j)
  enddo
  do i=1,N1
     do j=1,N2
        CC(i,j)=A(i)+B(j)
     enddo
  enddo
     
!q  open(21,file="unformatted.bin",form="unformatted")
!q  write(21)N1,N2
!q  do i=1,N1
!q     do j=1,N2
!q        write(21)A(i),B(j),CC(i,j)
!q     enddo
!q  enddo
!q  close(21)

  open(21,file="unformatted.bin",form="unformatted")
  write(21)N1,N2
  write(21)A,B,CC
  close(21)
 
  stop
end program main

といった感じです。

書式なしの読み込み

書式なしのファイルを読み込むためにはまったく同じ形で読み込ませればいいです。
例えば、上の形で書いた場合、読み込みは

program main
  implicit none
  integer::i,j,N1,N2
 
  double precision,allocatable::A(:),B(:)
  complex(kind(0d0)),allocatable::CC(:,:)
 
  open(21,file="unformatted.bin",form="unformatted")
  read(21)N1,N2
  allocate(A(1:N1),B(1:N2),CC(1:N1,1:N2))
!q  do i=1,N1
!q     do j=1,N2
!q        read(21) A(i),B(j),CC(i,j)
!q     enddo
!q  enddo
  read(21) A,B,CC
  close(21)
 
  do i=1,N1
     do j=1,N2
        write(6,'(4f10.5)')A(i),B(j),CC(i,j)
     enddo
  enddo
 
  stop
end program main

とすればいいです。
”!q”のコメントアウトは２つのプログラムに共通しています。
なのでどういう書き方でも、同じ入出力の形を指定してあげれば良いです。

[adsense2]