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

モンテカルロ法

モンテカルロ法は,乱数を使って系の平衡状態にせまる一つの方法です。

ここでは二次元正方格子のイジング模型について紹介します。
イジング模型は隣り合う格子のスピン同士の相関エネルギーのみを考慮した模型です。
ハミルトニアンは以下のようになります。

\(
\displaystyle
H=-J \Sigma_{< i , j >}{s_{i}s_{j}}
\)
 
あるスピン状態を持つ系の状態Aについて,そのハミルトニアンを\(H_A\)とすると,
ボルツマン因子と分配関数\(Z\)を用いて状態の実現確率を計算することが出来ます。

\(
P(A)=\frac{\exp{(-\frac{H_A}{k_B T})}}{Z}
\)
 
Aからランダムに一つの格子におけるスピンを一つだけフリップした状態を状態Bとして,
状態Aと状態Bの実現確率比を乱数と比較します。
\(P(B)/P(A)>{\rm random}\)ならば状態Bを採用し,そうでなければ状態Aを採用します。
ここまでの流れを1mcs(モンテカルロステップ)といい,これを何度も繰り返すことで平衡状態に近づきます。
以下の二つのgifは,相転移温度より高い温度と低い温度で,
モンテカルロステップにより二次元正方格子のスピンがどのように振る舞うかをみているアニメーションです。
黒がダウンスピン,白がアップスピンです。


温度T=10eVのスピンの挙動
温度T=10eVのスピンの挙動

こちらは温度T=10eVで,自発磁化を持たない事が分かります。


温度T=0.001eVのスピンの挙動
温度T=0.001eVのスピンの挙動

こちらは温度T=0.001eVで,スピンが揃って自発磁化を持つ事が分かります。

画像をクリックするとmcsスタート!!

スピンのふるまいを追うと,自発磁化を持つ温度と持たない温度でスピンのふるまいが違う事が分かります。
二次元のイジング模型はオンサーガーにより厳密に解かれている(相転移温度T=2.26eV at J=1)ので,
それを踏まえて下のプログラムで遊んでみるといいですよ。

これのプログラムソースコード(保証は一切しません!!)
*注意 このプログラムを実行する前にising_anというディレクトリを作ってください。
*追記 2015 2/13 磁化とエネルギーを計算出来るようにしました。
計算方法は重み付き選択法というのを使ってます。

\(
\langle A \rangle = \frac{1}{T} \sum_{t=t_0+1}^{t_0 + T}A_{\alpha_{t}}
\)
 
十分平衡状態になっている\(t_0\)以降のモンテカルロステップで,物理量の統計平均を取る方法です。
平衡以前の物理量を計算しないmcsをからまわしと言います。

格子点51×51で,\(J=2\)で計算しました。
スピンの大きさを1として,相互作用をダブルカウントしているので注意しましょう。
即ち\(J=1\)の結果が欲しければプログラム上ではintJ=0.125にすればよいかも。

**********parameter**********
i_max::x方向の格子点の数
j_max::y方向の格子点の数
mcs_max::最大モンテカルロステップ数
mcs2step::mcs2step以降のmcsを平衡状態と見なし,物理量を計算します
intj::\(J/4\)
temp::温度
mov_max::mcs_max/movmax毎のスピン状態をgifアニメーションで見れるように区切ります。
**********parameter**********

単位格子あたりのエネルギーの温度依存性グラフを添付します。

ene

相転移温度付近でエネルギーの変化が大きい事が分かります。

単位格子あたりの磁化の絶対値の温度依存性グラフを添付します。

mag

相転移温度付近で自発磁化が発生し始めている事が分かります。

gnuplotを用いて,格子点上のスピンがどのように平衡状態へ近づくかをダイナミックに確認する事が出来ます。

gnuplot anime.gnuplot
 
を実行するとアニメが始まります。

gnuplot animegif.gnuplot
 
でgifアニメが作成出来ます。

!————————————————
! title = ising2d.f90
! developer = Amesyabody
! released = 2015 2/13
! programming language = fortran
!
!explanation
!2 dimentional square lattice Ising model's dynamical magnetism
!calculated by Monte Carlo method.
!————————————————
   
program main
    implicit none
    integer(4)::i,j,i_max,j_max,mcs,mcs_max,mov,mov_max,mcs2step
    parameter(i_max=50,j_max=50,mcs_max=1000000,&
    mcs2step=500000,mov_max=100)
    real(8)::intj,temp
    parameter(intj=0.25d0,temp=0.1d0)
    real(8)::spin(0:i_max,0:j_max)
    real(8)::ratio,ham1,ham2,hamres,dum,ene
    integer(4)::px,mx,py,my,rndx,rndy
    character(10)::movc,movc2

    real(8)::mag,mag2,magres
   
    !-----make random-----
    integer(4),allocatable::seed(:)
    integer cnt,seedsize
    real(8)::rnd,rndi,rndj,rnds
   
    call random_seed(size=seedsize)
    allocate(seed(seedsize))
    write(*,*)seedsize

    dum=rndmf(0)

    call system_clock(count=cnt)
    seed=cnt!+idnint(dum*1000000)
!            dum=rndmf(seed(0))
!            seed=idnint(seed*dum)
    call random_seed(put=seed)

    !------------------

mag2=0.0d0
ene=0.0d0

do mov=0,mov_max

write(movc,'(i3)')mov

open(100+mov,file="ising_an/spin"//trim(adjustl(movc))//".dat"&
,status="unknown")

end do

open(5000,file="ising_an/anime.gnuplot",status="unknown")
open(5001,file="ising_an/animegif.gnuplot",status="unknown")

    !-----primitive spin set-----
   
    do i=0,i_max
        do j=0,j_max
            call random_number(rnd)
!           write(*,*)rnd
            if(rnd>0.5d0)then
                spin(i,j)=1.0d0
            else
                spin(i,j)=-1.0d0
            end if
!           write(*,*)spin(i,j)!,cnt,seed(1)

        write(100,'(i3,i3,f5.1)')i,j,spin(i,j)

        end do

        write(100,*)" "

    end do
   
    !----------------------------
   
    do mcs=1,mcs_max
   
        do i=0,i_max
       
            do j=0,j_max
           
                px=i+1
                if(i==i_max)px=px-i_max-1
                py=j+1
                if(j==j_max)py=py-j_max-1
                mx=i-1
                if(i==0)mx=mx+i_max+1
                my=j-1
                if(j==0)my=my+j_max+1

                ham1=ham1-intj*spin(i,j)*spin(px,j)&
                -intj*spin(i,j)*spin(i,py)&
                -intj*spin(mx,j)*spin(i,j)&
                -intj*spin(i,my)*spin(i,j)

                do mov=1,mov_max-1

                    if(mcs==mov*mcs_max/mov_max)&
                    write(100+mov,'(i3,i3,f5.1)')i,j,spin(i,j)

                end do

                if(mcs>mcs2step)then

                    mag2=mag2+spin(i,j)

                end if
               
            end do

            do mov=1,mov_max-1

                if(mcs==mov*mcs_max/mov_max)write(100+mov,*)" "

            end do

        end do

        if(mcs>mcs2step)then

            magres=magres+abs(mag2)
            mag2=0.0d0
            ene=ene+ham1

        end if

        call random_number(rndi)
        call random_number(rndj)
        rndx=idnint(rndi*i_max)
        rndy=idnint(rndj*j_max)

!       write(*,*)rnd
!write(*,*)spin(rndx,rndy)
        spin(rndx,rndy)=-spin(rndx,rndy)
!write(*,*)spin(rndx,rndy)
        do i=0,i_max
       
            do j=0,j_max
           
                px=i+1
                if(i==i_max)px=px-i_max-1
                py=j+1
                if(j==j_max)py=py-j_max-1

                mx=i-1
                if(i==0)mx=mx+i_max+1
                my=j-1
                if(j==0)my=my+j_max+1

                ham2=ham2-intj*spin(i,j)*spin(px,j)&
                -intj*spin(i,j)*spin(i,py)&
                -intj*spin(mx,j)*spin(i,j)&
                -intj*spin(i,my)*spin(i,j)
   
            end do
           
        end do
       
        ratio=exp((-ham2+ham1)/temp)
!       write(*,*)ham1,ham2,ratio
       
        ham1=0.0d0
        ham2=0.0d0
       
        call random_number(rnds)

        if(ham1 > ham2)then!metroporis
        goto 200
        end if
       
        if(rnds>ratio)then
        spin(rndx,rndy)=-spin(rndx,rndy)
        end if

200     continue

    end do
   
    do i=0,i_max
        do j=0,j_max
       
        mag=mag+spin(i,j)
       
        px=i+1
        if(i==i_max)px=px-i_max-1
        py=j+1
        if(j==j_max)py=py-j_max-1
        mx=i-1
        if(i==0)mx=mx+i_max+1
        my=j-1
        if(j==0)my=my+j_max+1

        hamres=hamres-intj*spin(i,j)*spin(px,j)&
        -intj*spin(i,j)*spin(i,py)&
        -intj*spin(mx,j)*spin(i,j)&
        -intj*spin(i,my)*spin(i,j)

        write(100+mov_max,'(i3,i3,f5.1)')i,j,spin(i,j)
       
        end do

        write(100+mov_max,*)" "

    end do
   
    mag=mag/(dble(i_max*j_max))
   
!   write(*,'(3f10.5,f15.5)')temp,intj,mag,hamres

    ene=ene/(dble((mcs_max-mcs2step)*(i_max+1)*(j_max+1)))
    magres=magres/(dble((mcs_max-mcs2step)*(i_max+1)*(j_max+1)))

    write(*,'(A,f10.5,A,f10.5)')"energy=",ene,"      magnet=",magres

    write(5000,*)"set size sq"
    write(5000,*)"set pm3d map"
    write(5000,*)"set palette rgbformulae 21,22,23"
    write(5000,*)"set xlabel 'x'"
    write(5000,*)"set ylabel 'y'"
    write(5000,*)"set zra[-1:1]"
    write(5000,*)"set zlabel 'spin'"
    write(5000,*)"splot 'spin0.dat'"
    write(5000,*)"pause 0.1"
    do mov=1,mov_max
    write(movc,'(i3)')mov
    write(5000,*)"splot 'spin"//trim(adjustl(movc))//".dat'"
    write(5000,*)"pause 0.1"

    end do

    write(5001,*)"set tics font 'Times,15'"
    write(5001,*)"set xlabel font 'Times,15'"
    write(5001,*)"set ylabel font 'Times,15'"
    write(5001,*)"set size sq"
    write(5001,*)"set pm3d map"
    write(5001,*)"set palette rgbformulae 21,22,23"
    write(5001,*)"set xlabel 'x'"
    write(5001,*)"set ylabel 'y'"
    write(5001,*)"set zra[-1:1]"
    write(5001,*)"set cbrange [-1:1]"
    write(5001,*)"set zlabel 'spin'"
    write(5001,*)"set term gif animate optimize"
    write(5001,*)"set output 'is_t10.gif'"
    write(5001,*)"do for[i=0:100] {"
    write(5001,*)'file = sprintf("spin%01d.dat", i)'
    write(movc2,'(i10)')mcs_max/mov_max
    write(5001,*)'time = sprintf("s=%d[mcs]",i*'//trim(adjustl(movc2))//')'
    write(5001,*)"set title time"
    write(5001,*)"splot file"
    write(5001,*)"}"

    contains

real(8) function rndmf(seeds)
implicit none

integer(4)::a,m,q,p,n,ndiv,j,k,seeds
real(8)::rm,rmax
parameter(a=16807,m=2147483647,rm=1.0/m)
parameter(q=127773,p=2836,n=32,ndiv=1+(m-1)/n)
parameter(rmax=1.0-1.2e-7)
integer(4)r(n),r0,r1

if (seeds .ne. 0)then
r1=abs(seeds)
do j=n+8,1,-1
k=r1/q
r1=a*(r1-k*q)-p*k
if(r1 .lt. 0)r1=r1+m
if(j .le. n)r(j)=r1
end do
r0=r(1)
end if


k=r1/q
r1=a*(r1-k*q) -p*k
if(r1 .lt. 0)r1=r1+m
j=1+r0/ndiv
r0=r(j)
r(j)=r1
rndmf=min(rm*r0,rmax)

end function
   
end program

プリクラ問題

covering designのt=2に相当、
La Jolla Covering Repository Tablesに全部載ってます…
リンク先クリックすればいいんだね。
Combinatorial covering designs に文献とかあるから、なんかもう・・・
もういいや

fortran90によるのコードはこのページの下の方です
だんだんと条件を付け加えて更新していくつもりです。n=9~10でm=3,4程度は厳しいです。



力技でやってみたよ!
主眼が回数になっているので、実際の組み合わせは?と気になってやったものです。

事の発端

コンピュータによる総当たりでは今のままではn=10位が限界です。
だんだんと改良して増やせていければ、と。
コードは後ほど僕に時間ができ次第、公開します。



より↓

念のための確認もかねて、計算は表の値-1から確かめて総当たりを行った結果です。なので具体的な組み合わせが載っているものは正しいはずです。
組み合わせの総数はおおよそ
\(\displaystyle \sum_{q=3}^{q^{Answer}} {}_{{}_nC_m}C_{q}\)
という膨大な数の組み合わせとなります。ここで\(q^{Answer}\)はプリクラ問題の最小回数です。
\(q=3\)はあり得ない、全てを検証する必要はない、など確実にわかる要素は多いですが、例えばn=9,m=3,解q=12を考えると
\(\displaystyle {}_{{}_9C_3}C_{12}=112,992,892,764,570 \ \ \sim 10^{14}(=100T)\)回
の計算が必要です。理想的な状況を考え、cpu10GHz,コア数10で並列処理で行う場合、計算時間は
\(\displaystyle \frac{10^{14}回}{10\times 10^{9}Hz\cdot 10\mbox{コア}}=1000[秒]\)
なのでぎりぎり計算できそうかなーくらいになります。
しかし、このあたりが限界で、n=10,m=3,解q=17になると、
\(\displaystyle {}_{{}_{10}C_3}C_{17}=189,916,591,435,396,829,640\ \ \sim 10^{20}(100E)\)回
の計算となります。先ほどの設定で行うならば、\(10^{9}\)秒~31.7年かかります。
スパコンの京(10PHz)をフルに使えるならば1000[s]で終わります。しかしそこで終わりです。n=11は…もう無理です。

効率のいい方法を考えない限り、解は得られません。

n\m 2 3 4 5 6 7 8 9 10 11
2 1 1 1 1 1 1 1 1 1 1
3 3 1 1 1 1 1 1 1 1 1
4 6 3 1 1 1 1 1 1 1 1
5 10 4 3 1 1 1 1 1 1 1
6 15 6 3 3 1 1 1 1 1 1
7 21 7 5 3 3 1 1 1 1 1
8 28 11 6 4 3 3 1 1 1 1
9 36 12 8 5 3 3 3 1 1 1
10 45 17 9 6 4 3 3 3 1 1
11 55 19 11 7 6 4 3 3 3 1

(3,2)=3

1 2
1 3
2 3

(4,2)=6

(4,3)=3

1 2 3
1 2 4
1 3 4

(5,2)=10

(5,3)=4

1 2 3
1 2 4
1 2 5
3 4 5

(5,4)=3

1 2 3 4
1 2 3 5
1 2 4 5

(6,2)=15

(6,3)=6

1 2 3
1 2 4
1 5 6
2 5 6
3 4 5
3 4 6

(6,4)=3

1 2 3 4
1 2 5 6
3 4 5 6

(6,5)=3

1 2 3 4 5
1 2 3 4 6
1 2 3 5 6

(7,2)=21

(7,3)=7

1 2 3
1 4 5
1 6 7
2 4 6
2 5 7
3 4 7
3 5 6

(7,4)=5

1 2 3 4
1 2 3 5
1 2 3 6
1 2 3 7
4 5 6 7
or
1 2 3 5
1 4 6 7
2 3 4 5
2 4 6 7
3 5 6 7

(7,5)=3

1 2 3 4 5
1 2 3 6 7
1 4 5 6 7

(7,6)=3

1 2 3 4 5 6
1 2 3 4 5 7
1 2 3 4 6 7

(8,2)=28

(8,3)=11

計算中…

(8,4)=6

1 2 3 4
1 2 5 6
1 2 7 8
3 4 5 6
3 4 7 8
5 6 7 8

(8,5)=4

1 2 3 4 5
1 2 3 4 6
1 2 3 7 8
4 5 6 7 8

(8,6)=3

1 2 3 4 5 6
1 2 3 4 7 8
1 2 5 6 7 8

(8,7)=3

1 2 3 4 5 6 7
1 2 3 4 5 6 8
1 2 3 4 5 7 8

(9,2)=36

(9,3)=12

計算中…

(9,4)=8

1 2 3 5
1 2 3 6
1 2 4 7
1 2 8 9
1 3 4 8
1 3 7 9
4 5 6 9
5 6 7 8


info)cputime=3.0415[s], Nc=10523209, com=1 2 35 115 126

(9,5)=5

1 2 3 4 5
1 2 3 4 6
1 2 7 8 9
3 4 7 8 9
5 6 7 8 9

(9,6)=3

1 2 3 4 5 6
1 2 3 7 8 9
4 5 6 7 8 9

(9,7)=3

1 2 3 4 5 6 7
1 2 3 4 5 8 9
1 2 3 6 7 8 9

(9,8)=3

1 2 3 4 5 6 7 8
1 2 3 4 5 6 7 9
1 2 3 4 5 6 8 9

(10,2)=45

(10,3)=17

計算厳しい

(10,4)=9

計算中(4日後くらい?)

(10,5)=6

(10,6)=4

1 2 3 4 5 6
1 2 3 4 7 8
1 2 3 4 9 10
5 6 7 8 9 10

(10,7)=3

1 2 3 4 5 6 7
1 2 3 4 8 9 10
1 5 6 7 8 9 10

(10,8)=3

1 2 3 4 5 6 7 8
1 2 3 4 5 6 9 10
1 2 3 4 7 8 9 10

(10,9)=3

1 2 3 4 5 6 7 8 9
1 2 3 4 5 6 7 8 10
1 2 3 4 5 6 7 9 10

(11,2)=55

(11,3)=19

(11,4)=11

(11,5)=7

(11,6)=

(11,7)=4

1 2 3 4 5 6 7
1 2 3 4 5 6 8
1 2 3 4 9 10 11
5 6 7 8 9 10 11

(11,8)=3

1 2 3 4 5 6 7 8
1 2 3 4 5 9 10 11
1 2 6 7 8 9 10 11

(11,9)=3

1 2 3 4 5 6 7 8 9
1 2 3 4 5 6 7 10 11
1 2 3 4 5 8 9 10 11

(11,10)=3

1 2 3 4 5 6 7 8 9 10
1 2 3 4 5 6 7 8 9 11
1 2 3 4 5 6 7 8 10 11



fortran90のコード。総当たりで調べます。
別にinputファイルが必要です。n:m=3:2以上の時は考慮していません。3回で終わるからね。
下の例はn=6, m=3に相当しています。(inputのrはmに相当します。)
qiは調べ始める最低回数、qeは調べ終わる最高回数です。
出力はこうなります。

 M          35
q  -->    3
q  -->    4
q  -->    5
q  -->    6
q  -->    7
 number of calculation     1276464
 cpu_time  0.905050993     [sec]
+------------+
  1  2  3
  1  4  5
  1  6  7
  2  4  6
  2  5  7
  3  4  7
  3  5  6
+------------+

ここからfortran90のコード。gfortranで確かめています。

program main
  implicit none
  integer::n,r,qi,qe,qc
  integer::i,j
  real::t1,t2
  integer,allocatable::groups(:,:)
 
  n=7
  r=3
  qi=3
  qe=10
  allocate(groups(1:qe,1:r))
  groups=0

  call cpu_time(t1)  
  call pkprob(n,r,qi,qe,qc,groups)
  call cpu_time(t2)
  write(6,*)"cpu_time",t2-t1,"[sec]"

  write(6,'(A)')"+------------+"
  do i=1,qc
     do j=1,r
        write(6,'(i3)',advance='no')groups(i,j)
     enddo
     write(6,*)          
  enddo
  write(6,'(A)')"+------------+"
 
  stop
end program main
!==========================
subroutine pkprob(n,r,qi,qe,qc,groups)
  !Covering Design t=2
  implicit none
  integer,intent(in)::n,r,qi,qe
  integer,intent(out)::qc,groups(1:qe,1:r)
 
  integer::q,M,ic,ncalc
  integer::i,j,q2,k
  integer,allocatable::ini(:),tmp(:),cgroup(:,:),pk(:,:)
  integer,allocatable::choose(:)
 
  integer::check1,nCr
  integer::csign
  !  logical::csign,gsign
  external::nCr

  !Combination M=nCr
  M=nCr(n,r)  
  write(6,*)"M",M

  !csign      : Sign of critical combination of array  
  !ic         : Critical value of i which number of combination of combination
  !qc         : Critical value of q which number of combination of combination
  !pk(1:n,1:n): Checking array if every number fill(1) combination or not(0)
  !ncount(1:n): To check calculation number of times
  allocate(ini(1:r),tmp(1:r),cgroup(1:M,1:r))
  ini(1:r)=0
  cgroup(1:M,1:r)=0
  tmp(1:r)=0
 
  do j=1,r
     ini(j)=j
     tmp(j)=ini(j)
  enddo
  !Substitute combination to cgroup.
  do i=1,M
     cgroup(i,1:r)=tmp(1:r)
     call combination(n,r,ini,tmp)
  enddo
  deallocate(ini,tmp)
  !csign      : Sign of critical combination of array  
  !ic         : Critical value of i which number of combination of combination
  !qc         : Critical value of q which number of combination of combination
  !pk(1:n,1:n): Checking array if every number fill(1) combination or not(0)
  !ncount(1:n): To check calculation number of times
  csign=0
  ic=0
  qc=0
  allocate(pk(1:n,1:n))
  pk=0

  ncalc=0

  !q : We need to consider below combination.
  !  Example ) n=5, r=3 case.
  !
  !cgroup(i,1:r)
  !i\r| 1 2 3
  !----------
  ! 1 | 1 2 3
  ! 2 | 1 2 4
  ! 3 | 1 2 5
  ! 4 | 1 3 4
  ! 5 | 1 3 5
  ! 6 | 1 4 5
  ! 7 | 2 3 4
  ! 8 | 2 3 5
  ! 9 | 2 4 5
  !10 | 3 4 5
  !
  !We have to choose q= 3 or 4 or 5 ...combination of "cgroup".
  !Sum total of these combination can write D=_{nCr}C_q.
  !Specifically,
  !---choose q groups from cgroup
  ! +----q=3----+ +-----q=4-----+ +------q=5------+
  ! |choose(1:q)| | choose(1:q) | |  choose(1:q)  |
  ! | l |       | | l |         | | l |           |
  ! |===|=======| |===|=========| |===|===========|
  ! | 1 | 1 2 3 | | 1 | 1 2 3 4 | | 1 | 1 2 3 4 5 |
  ! | 2 | 1 2 4 | | 2 | 1 2 3 5 | | 2 | 1 2 3 4 6 |
  ! | 3 | 1 2 5 | | 3 | 1 2 3 6 | | 3 | 1 2 3 4 7 |
  ! | 4 | 1 2 6 | | 4 | 1 2 4 7 | | 4 | 1 2 3 4 8 |
  ! | 5 | 1 2 7 | | 5 | 1 2 4 8 | | 5 | 1 2 3 4 9 |
  ! | 6 | 1 2 8 | | 6 | 1 2 5 9 | | 6 | 1 2 3 4 10|
  ! | 7 | 1 2 9 | | 7 | 1 2 5 10| | 7 | 1 2 3 5 6 |
  ! |...| . . . | |...| . . . . | |...| . . . .   |
  ! |120| 4 5 6 | |210| 7 8 9 10| |252| 6 7 8 9 10|
  ! +-----------+ +-------------+ +---------------+
  !
  ! If q=4, l=3
  !  We choose below combination, and check satisfy condition or not by "pk".
  ! 1 | 1 2 3
  ! 2 | 1 2 4
  ! 3 | 1 2 5
  ! 6 | 1 4 5
 
  do q=qi,qe
     write(6,'(A,i5)')"q  -->",q
     allocate(choose(1:q),ini(1:q))
     choose(1:q)=0
     ini(1:q)=0
     
     do j=1,q
        ini(j)=j
        choose(j)=ini(j)
     enddo
         
     csign=0
     do while(csign.eq.0)
        !condition 1 to reduce calculation
        check1=cgroup(choose(1),1)
        if(check1.ne.1)exit

        !condition 2 to reduce calculation
        check1=cgroup(choose(2),1)
        if(check1.ge.2)exit

        !condition 3 to reduce calculation for less than n:r=3:2
        check1=cgroup(choose(q),1)
        if(check1.ge.3)then
           pk=0
           do q2=1,q
              do j=1,r
                 do k=1,r
                    pk(cgroup(choose(q2),j),cgroup(choose(q2),k))=1
                 enddo
              enddo
           enddo
           !memory calculation number of times
           ncalc=ncalc+1
           if(minval(pk).eq.1)then
              csign=1
              qc=q
           endif

           if(csign.eq.1)exit
        endif

        !go forward choose(1:q)
        call combination(M,q,ini,choose)
     enddo
     
     if(csign.eq.1)exit
     deallocate(choose,ini)
  enddo
  write(6,*)"number of calculation",ncalc

  groups(1:qe,1:r)=0
  do i=1,qc
     do j=1,r
        groups(i,j)=cgroup(choose(i),j)
     enddo
  enddo
 
  return
end subroutine pkprob
!---------------------------------
subroutine combination(n,r,ini,arr)
  implicit none  
  integer(8)::i,n,r,ini(1:r),bef(1:r),arr(1:r)
  integer(8)::numx
  logical::key(1:r)
 
  bef(1:r)=arr(1:r)-ini(1:r)
  arr(1:r)=0
  key(1:r)=.false.

  numx=n-r
  do i=1,r
     if(bef(i).eq.numx)key(i)=.true.
  enddo

  do i=1,r-1
     if(key(i+1))then
        if(key(i))then
           if(i.ne.1)arr(i)=arr(i-1)      
        else
           arr(i)=bef(i)+1
        endif
     else
        arr(i)=bef(i)
     endif
  enddo
  if(key(r))then
     arr(r)=arr(r-1)
  else
     arr(r)=bef(r)+1
  endif
 
  arr(1:r)=arr(1:r)+ini(1:r)

  return
end subroutine combination
!----------------------------------
function nCr(n,r)
  implicit none
  integer(8)::n,r,i,r0,nCr

  r0=n-r
  if(r.le.r0)r0=r

  nCr=1
  do i=1,r0
     nCr=nCr*(n-r0+i)
     nCr=nCr/i
  enddo
 
  return
end function nCr

フォントサイズ変更

emacsでフォントサイズを変更したい場合は?環境はemacs24。

(調べてもよくわからないし出てこない…。)
一度だけ変更したい場合は、Ctrl-x-± で可能です。
ではずっと変更したい場合は?
emacsの設定ファイルに記述します。emacsの設定ファイルの場所は
emacswiki – InitFileより

  1. For GnuEmacs, it is ~/.emacs or _emacs or ~/.emacs.d/init.el.
  2. For XEmacs, it is ~/.xemacs or ~/.xemacs/init.el.
  3. For AquamacsEmacs, it is ~/.emacs or ~/Library/Preferences/Aquamacs Emacs/Preferences.el

にあります。環境によって場所が異なります。
Linuxmint17.1,”sudo apt-get install emacs24″で行った場合、おそらく~/.emacsでしょう。

21.8 Fontsを見るとデフォルトでは
フォント(の種類) : monospace font
フォントサイズ : 10pt
として設定されているそうです。

テキストエディタで~/.emacsを開き、
(custom-set-variables


)
の括弧の

(add-to-list 'default-frame-alist
                       '(font . "DejaVu Sans Mono-12"))

という文を記述します。
現在、フォントのタイプの変更は僕は分かりません。多分DejaVu…を変えればよさそう。
12のところを10とか14とかに変えればデフォルトのフォントサイズを変更することができます。

見出しに使っている画像は8,9,10,11,12,20の場合の比較です。参考にどうぞ。

僕の使ってる~./emacsはこちら

組み合わせ

組み合わせ\(_nC_r\)、重複組み合わせ\(_nH_r\)の一覧を求めるfortranコードです。

\(_nH_r=~_{n+r-1}C_r\)


組み合わせ\(_nC_r\)の場合


  1  2  3  4
  1  2  3  5
  1  2  3  6
  1  2  4  5
  1  2  4  6
  1  2  5  6
  1  3  4  5
  1  3  4  6
  1  3  5  6
  1  4  5  6
  2  3  4  5
  2  3  4  6
  2  3  5  6
  2  4  5  6
  3  4  5  6

を得たい場合

重複組み合わせ\(_nH_r\)の場合


  1  1  1  1
  1  1  1  2
  1  1  1  3
  1  1  2  2
  1  1  2  3
  1  1  3  3
  1  2  2  2
  1  2  2  3
  1  2  3  3
  1  3  3  3
  2  2  2  2
  2  2  2  3
  2  2  3  3
  2  3  3  3
  3  3  3  3

を得たい場合

組み合わせをrecursionを使わないで得るために、全ての行を初めの値で引いてみました。

+------------+
  0  0  0  0
  0  0  0  1
  0  0  0  2
  0  0  1  1
  0  0  1  2
  0  0  2  2
  0  1  1  1
  0  1  1  2
  0  1  2  2
  0  2  2  2
  1  1  1  1
  1  1  1  2
  1  1  2  2
  1  2  2  2
  2  2  2  2
+------------+

すると、ちょうどr進数と同じになります。なので、これを復元するプログラムを書きました。

時間計測

fortran90において、
このプログラムは何秒かかるか?
早い?遅い?
を調べるためにはもちろん計算時間を計るのが一番です。

  1. 実時間とCPU時間の違い
  2. 実時間計測
  3. CPU時間計測

実時間とCPU時間の違い


『計算時間』には大きく2種類あります。実時間CPU時間です。

  • 実時間 → 現実の世界での経過時間
  • CPU時間 → プログラムの実行でCPUを使った時間

※[1]より。参考文献とは程遠いですが、僕の認識とあっていて、綺麗な説明と感じたので載せておきます。

例えば、計算時間はそんなにかかってないのに詳細な画像を得たいがために書き出すデータ量を増やしている場合、実時間は長く、CPU時間は短くなります。
また、あるデータ点1つを得るために計算時間は膨大にかかる場合、実時間≈CPU時間になります。

fortranでは時刻を得るためのサブルーチンが既に用意されています。
ここで紹介するのは、実時間を得るための
date_and_time

system_clock
の2種類。
CPU時間を得るためのサブルーチンは
cpu_time
の1種類です。

実時間計測(date_and_time)


その場所で何時何分何秒を出力させたい時、その場所に

  write(6,'(3A,i0,A,i0,A,i0,A,i0,A,i0,A,i0,A)')"  == ", &
       c," ",ti(1),"/",ti(2),"/",ti(3), &
       "  ",ti(5),":",ti(6),":",ti(7),", (yyyy/mm/dd  hh:mm:ss)"

を入れましょう[2]。character(10)::b(1:3), integer::ti(1:8)です。

使う際はこうすると良いでしょう。

program main
  implicit none

  call current_time("program start ")  

  !program here
  write(6,*)"press Enter"
  read *
   
  call current_time("program finish")  
 
  stop
end program main

subroutine current_time(c)
  implicit none
  character(*),intent(in)::c
  integer::ti(1:8)
  character(10)::b(1:3)
 
  call date_and_time(b(1),b(2),b(3),ti)
  write(6,*)
  write(6,'(3A,i0,A,i0,A,i0,A,i0,A,i0,A,i0,A)')"  == ", &
       c," ",ti(1),"/",ti(2),"/",ti(3), &
       "  ",ti(5),":",ti(6),":",ti(7),", (yyyy/mm/dd  hh:mm:ss)"
  write(6,*)
 
  return
end subroutine current_time

サブルーチンcurrent_timeを定義して、それを呼び出すだけのほうが分かりやすいかと思います。
引数は何という文言をその場所に指定したいかを示すものです。
実行して適当なときにEnterキーを押してプログラムを進めると、

$ gfortran main2.f90
$ ./a.out
   
  == program start  2016/2/15  9:16:38, (yyyy/mm/dd  hh:mm:ss)

 press Enter

  == program finish 2016/2/15  9:16:40, (yyyy/mm/dd  hh:mm:ss)

$

という結果が得られるでしょう。もちろん、プログラムを動かした時点での時間が表示されます。
一瞬で終わるプログラムの場合は差は見られ無いと思います。

実時間計測(system_clock)


system_clockはfortran標準実装なので汎用性は高いです[4]。system_clockは組み込まれているサブルーチンなので下のプログラムをそのままコピペして使う事が出来ます。

program main
  implicit none
  integer::ti,tf,tr ! ti: initial time, tf: finish time, tr: time rate
  integer::i

  call system_clock(ti)

  !program here
  write(6,*)"press Enter"
  read *

  call system_clock(tf,tr)
 
  write(6,'(f10.3,A)')(tf-ti)/dble(tr),"[s]"
 
  return
end program main

上の文を実行して適当なときにEnterキーを押してプログラムを進めると、

$ gfortran main2.f90
$ ./a.out
    press Enter
      1.283[s]
$

という出力が得られます。

CPU時間の計測(cpu_time)


CPU時間の計測するには

    call cpu_time(t0)
    ...
    call cpu_time(t1)
    write(6,'(f10.3,A)')(t1-t0),"[CPU sec]"

を入れましょう[3]。real::t1,t2です。

program main
  implicit none
  real::t0,t1
  integer::i

  call cpu_time(t0)

  !program here
  write(6,*)"press Enter"
  read *
 
  call cpu_time(t1)
 
  write(6,'(f10.3,A)')(t1-t0),"[CPU sec]"
 
  stop
end program main

でokです。適当な時間待って、Enterキーを押すと

$ gfortran main2.f90
$ ./a.out
    press Enter
     0.000[s]

という出力が得られるでしょう。
これはcpuを動かしていないためであり、cpuが動いていた時間というのは限りなく0だ、ということです。

参考文献

[1]ユーザ時間とシステム時間の違いを教えてください。
[2]1.4.7.1 date_and_time: 日付と時刻の取得 -ORACLE®
[3]8 移植性のある時間計測の方法 -nag
[4]9.254 SYSTEM_CLOCK — Time function

大きな数を扱う

大きい数=工夫or対数!

大きい数を扱う…例えば階乗を計算しろ、という問題や組み合わせ\(_nC_r\)を計算しろ、という問題に時々あたります。

まず、典型的な例として組み合わせ
\(\displaystyle _nC_r=\frac{n!}{(n-r)!r!}\)
を計算しましょう。
この計算はそのまま定義のまま計算しようとすると階乗が出てくるので、途中の値は物凄くでかい数字になるのですが、最後の答えは小さい値になるはずです。それなのに計算できないのはおかしくない!?工夫次第で何とかなるものです。
下の表は3つの計算方法についてまとめたものです。

integer(4バイト整数型±2 147 483 647)を用いた計算
定義のまま計算 工夫して計算 対数を利用して計算
最大のn,r \(_{12}C_6\) \(_{29}C_{14}\) \(_{33}C_{16}\)
理由 階乗の計算によるオーバーフロー “割り切れる”ための制約 (限界値)

integer(8バイト整数型±9 223 372 036 854 775 807)を用いた計算
計算方法 定義のまま計算 工夫して計算 対数を利用して計算
最大のn,r \(_{20}C_{10}\) \(_{61}C_{30}\) \(_{48}C_{24}\)
理由 階乗の計算によるオーバーフロー “割り切れる”ための制約 倍精度型変数の有効桁数が足りない
定義のまま計算

例えばfortranでintegerの宣言により定義した場合、階乗が正しく計算できる範囲(オーバーフローしない範囲)は、\(12!=479\ 001\ 600\)
まで計算できます。
変数の型がいくつまで計算できるかは、組み込み関数hugeを使うことで確認できます。

program main
  implicit none
  integer::n

  write(6,*)"huge",huge(n)

  stop
end program main

これで確認すると、整数型は
\(\pm 2\ 147\ 483\ 647\)
までの値なら代入することができるため、
\(13!=6\ 227\ 020\ 800\)は計算できないことがわかります。
一応関数はこんな感じ。

function nCr_fact(n,r)
  !sikinote
  implicit none
  integer::nCr_fact,fact,n,r
  external::fact
 
  nCr_fact=fact(n)/(fact(n-r)*fact(r))
 
  return
end function nCr_fact
function fact(n)
  implicit none
  integer::fact,i,n
 
  if(n.le.-1)write(6,*)"####warning#### parameter of factorial has negative value"
  fact=1
  do i=2,n
     fact=fact*i
  enddo

  return
end function fact

( ※余談ですが、8バイト型整数で宣言、すなわちinteger(8)で宣言すると
\(9\ 223\ 372\ 036\ 854\ 775\ 807\)
まで計算できます(19桁、\(20!=2\ 432\ 902\ 008\ 176\ 640\ 000\)まで)。)

なので定義通りの計算はn=12までが限界です。実用的じゃありません。

工夫して計算

\(\displaystyle _nC_r=\frac{n!}{(n-r)!r!}\)を工夫します。

\(
\begin{align}
\displaystyle _nC_r&=\frac{n!}{(n-r)!r!} \\
&=\frac{n(n-1)(n-2)\cdots(n-r+2)(n-r+1)}{r(r-1)(r-2)\cdots2\cdot 1} \\
&=\frac{n}{r}\cdot \frac{n-1}{r-1}\cdot \frac{n-2}{r-2}\cdots \frac{n-r+2}{2}\cdot \frac{n-r+1}{1} \\
&=\prod_{i=1}^r\frac{n-r+i}{i}
\end{align}
\)
として計算します。こうすれば階乗みたいに大きな数を計算する必要がなくなります。
関数を書けばこうなります。

function nCr(n,r)
  !sikinote
  implicit none
  integer::n,r,i,r0,nCr

  r0=n-r
  if(r.le.r0)r0=r

  nCr=1
  do i=1,r0
     nCr=nCr*(n-r0+i)
     nCr=nCr/i
  enddo
 
  return
end function nCr

で\(_nC_r\)を求めることができます。
上のプログラムでは、最大\(_{29}C_{14}=77\ 558\ 760\)まで求めることができます。
これは絶対に割り切れることを前提にしているためにおこるもので、

nCr=nCr*(n-r0+i)

の文のところで最大値が決まってしまうためです。
定式化すれば、
\(_nC_r\)に対し、\(_{n-1}C_{r-1}\cdot n\)が扱える整数値を超えないこと
と表現できます。

\(_{29}C_{14}=77\ 558\ 760\)が計算できるのは、
\(_{29-1}C_{14-1}*29=1\ 085\ 822\ 640\)
であるので計算可能です。次の\(_{30}C_{15}\)を計算するためには
\(_{30-1}C_{15-1}*30=2\ 326\ 762\ 800\)が
integerの最大の整数値\(\pm 2\ 147\ 483\ 647\)
を超えてしまうのでこれ以上計算はできません。
※もしもinteger(8)を用いると\(_{61}C_{30}\)まで計算できます。

対数を利用して計算

もう一つ対数を利用した方法を紹介します。
対数を利用すると、
\(\displaystyle _nC_r=\frac{n!}{(n-r)!r!}\)は、\(S= _nC_r\)とおくと
\(
\begin{align}
\displaystyle \ln(S)&=\ln\left[\frac{n!}{(n-r)!r!}\right] \\
&=\ln(n!)-\ln\{(n-r)!\}-\ln(r!) \\
&=\sum_{i=n-r+1}^n\ln(i)-\sum_{i=2}^{r}\ln(i)
\end{align}
\)
と書けます。よって、
\(\displaystyle S=\exp\left[\sum_{i=n-r+1}^n\ln(i)-\sum_{i=2}^{r}\ln(i)\right]\)
です。プログラムを書けば

function nCr_log(n,r)
  !sikinote
  implicit none
  integer::n,r,i,r0,nCr2
  double precision::tmp
 
  r0=n-r
  if(r.le.r0)r0=r

  tmp=0.d0
  do i=n-r0+1,n
     tmp=tmp+log(dble(i))
  enddo
  do i=2,r0
     tmp=tmp-log(dble(i))
  enddo

  nCr2=nint(exp(tmp))  

  return
end function nCr_log

となります。この場合は\(_{n}C_{r}\)が整数型で扱える範囲を越えなければいいという条件だけになるので、
integerでは\(_{33}C_{16}\)までokです。

integer(8)では\(_{66}C_{33}\)までできます…が、上のプログラムそのままではできません。
おそらく、組み込み関数nint(実数型を整数型に四捨五入して代入する)がinteger(8)に対応していない(かも)ということと、倍精度の有効桁数がだんだんと足らなくなっていくので厳しいです。後者による問題によって、確認した範囲では\(_{48}C_{24}\)位が限界です。

乱数

fortran90においての乱数の発生方法です。

乱数を1から作るのは、乱数を研究するとかでない限り止めましょう。
ここではfortran90で乱数を発生させるためにどうすればいいか?を記述します。

私は乱数について詳しくありませんが、調べた限りメルセンヌツイスタという乱数発生法が良い乱数を発生するようです。
メルセンヌツイスタの詳細はMersenne Twister Home Page にあるのでご参照ください。
fortran90コードはhttps://gist.github.com/ykonishi/5569005にあります。

上記のリンクから、メルセンヌツイスタのfortran90コード(mt19937.f90)をダウンロードします。
そして、メインプログラム

program main
  use mt19937
  implicit none
  integer::i
  double precision::d

  call sgrnd(2) ! seed
 
  do i=1,10
     write(6,*)grnd()
  enddo
 
  stop
end program main

をmt19937.f90と一緒に

gfortran -fno-range-check mt19937.f90 main2.f90

というオプションを付けてコンパイル(※1)します。実行すると、

$ ./a.out
   6.4690865343436599E-002
  0.40996560384519398    
  0.14283204451203346    
  0.74749888177029788    
  0.59957117028534412    
  0.53676494420506060    
  0.38914293772540987    
  0.94303490873426199    
  0.15882158395834267    
  0.15933134709484875    
$

という結果を得ることが出来ます。

(※1)
このオプションが、型が扱える範囲を超えていても無視するためのオプションです。
何故かgfortranコンパイラ(ver4.8.4で確認)で出ます。
そして、これはコンパイラの問題だと私は結論付けました。
fortranの整数は
-2147483648から2147483647までで定義されているのにもかかわらず、
gfortran(ver4.8.4)は
-2147483647から2147483647の範囲でなければエラーを出すようです。
しかし、実際に整数に-2147483648を代入し、このエラーを無視する上のオプションを付けて実行すると、ちゃんと値が入ります。なので、コンパイラに問題があると判断しました。

[adsense1]

任意の関数に従う乱数(von Neumannの棄却法)


このページのサムネイル画像の右は等方的2次元調和振動子励起状態の密度
\(
\begin{align}
f(x,y)=\frac{4}{\pi}x^2y^2e^{-(x^2+y^2)}
\end{align}
\)
を点の濃さで表現するためのプログラムです。

これは、上の関数に従う乱数分布を書くことにほかなりません。
一様乱数を任意の関数に従う乱数に変換する方法として、
von Neumannの棄却法と呼ばれる方法があります。

以下のようにすると一様乱数を関数\(f(x)\)に従う乱数に変えることが出来ます。

\(x\)の範囲\([x_a,x_b]\)で定義された関数\(f(x)\)に従う乱数を発生させたい。
区間\([x_a,x_b]\)で関数は\([f_a,f_b]\)の値を持つとすると、
 1. 範囲\([x_a,x_b]\)の一様乱数\(x_r\)を生成する。
 2. 範囲\([f_a,f_b]\)の一様乱数\(f_r\)を生成する。
 3. もしも\(f_r\le f(x_r)\)ならば、その\(x_r\)は\(f(x)\)に従う乱数である。そうでなければ、発生させた乱数は捨てる。
 4. 1-3を繰り返す。
という方法です。アルゴリズムを見て分かる通り、この方法は無駄が多いです。
発生させた乱数を捨てる操作は出来ればしたくありません。
ですが、この方法は非常に簡単に実装できるのでとりあえず実装したいという場合には良い方法です。

以下は、上の考えの二次元版です。

program main
  use mt19937
  implicit none
  integer::i,count,N
  double precision::xp,yp,fp
  double precision::a,b,fmin,fmax
  double precision,external::f
 
  call sgrnd(2)

  N=2000
 
  ! fmin :: minimum value of function f(x,...)
  ! fmax :: maxmum value of function f(x,...)
  fmin=0.d0
  fmax=1.d0

  ! range of random number [a,b]
  a=-5d0
  b= 5d0
 
  open(13,file="./density.d")
  count=0
  do while(count.lt.N)
     xp=grnd()*(b-a)+a
     yp=grnd()*(b-a)+a
     fp=grnd()*(fmax-fmin)+fmin
     
     if(fp.le.f(xp,yp))then
        write(13,*)xp,yp
        count=count+1
     endif
  enddo
  close(13)

  stop
end program main

function f(x,y)
  implicit none
  double precision::f
  double precision,intent(in)::x,y

  double precision::pi=acos(-1.d0)
 
  f=abs(sqrt((1.d0/pi))*2d0*x*y*exp(-0.5d0*(x*x+y*y)))**2
 
  return
end function f

カラーマップと3次元での表現はこうなります。
20150524-210920_1_c

乱数を用いた密度表示(下のプログラム)ではこう表現されます。
nxny11density_c

[adsense2]

参考

任意分布の乱数生成 https://www.slideshare.net/shogoosawa581/ss-65259938

以降はfortranの標準組み込み関数を用いる場合のものです。
消すのは忍びないため、一応おいておきます。

4次ルンゲ・クッタ法

微分方程式なら任せろーバリバリバリー

ルンゲ=クッタ法ってもともとどういうもの?理論は?刻み幅\(h\)を自動的に制御する方法について知りたい方は、ルンゲ=クッタ法の系統的扱いと刻み幅制御へどうぞ。

4次ルンゲ=クッタ法は微分方程式を数値的に解く手段です。

ルンゲ=クッタ法が良く使われる理由は、ひとえにプログラムの実装のしやすさです。ルンゲクッタ法は非常に良い!というアルゴリズムではありませんが、他の方法よりもシンプルで、プログラムに組み込みやすいのです。

”4次”は問題の解の関数をテイラー展開した場合、4次までは一致するように作られた、という意味です。
例えば微分方程式
\(
\displaystyle \frac{dy}{dx}=g(x,y)
\)

を考えます。
数値計算では初期値(例えばx=0の時、y=1など)を決めて、そこからxをhだけ増やし、微分方程式というルールに従って関数\(y(0+h),y(0+h+h),y(0+h+h+h),\cdots\)を作り上げていきます。
この時、4次ルンゲ=クッタ法で求められる答えの関数というのは
\(
\displaystyle y(x+h)=y(x)+hg(x,y)+\frac{h^2}{2!}\frac{dg}{dx}+\frac{h^3}{3!}\frac{d^2g}{dx^2}+\frac{h^4}{4!}\frac{d^3g}{dx^3}+O(h^5)
\)

という関数になります。
\(
g(x,y)=-xy
\)

(ただし、初期条件\(x=0\)で\(y=1\))
である場合、微分方程式の解析解は
\(
\displaystyle y=e^{-x^2/2}
\)

であるため、4次ルンゲ=クッタ法によって導かれる答えは、
\(
\displaystyle y(x+h)=y(x)\left[1-hx+\frac{h^2}{2}(x^2-1)+\frac{h^3}{6}(-x^3+3x)+\frac{h^4}{24}(x^4-6x^2+3)\right]+O(h^5)
\)

となります。

本題に入りましょう。
4次ルンゲ=クッタ法は6つのステップが必要となります。
初期値を\((x_0,y_0)\)と書くと、(\(y_0=y(x_0)\)です。)

  1. \((x_0,y_0)\)より\(k_a\)を求める
  2. \(k_a\)より\(k_b\)を求める
  3. \(k_b\)より\(k_c\)を求める
  4. \(k_c\)より\(k_d\)を求める
  5. \(k_a,k_b,k_c,k_d\)より\(y(x_0+h)\)を求める
  6. \((x_0+h,y(x_0+h))\)を初期値だと思って手順1に戻る。

という感じです。
3章:連立ルンゲ・クッタ法による微分方程式の解を参考にすると、数値計算での4次ルンゲ=クッタ法の計算スキームは以下のようになります。

解きたい微分方程式を連立1次微分方程式の形で書くと一般的にはこう書けます。
———
\(
\begin{eqnarray}
\left\{
\begin{aligned}
\frac{dy_1}{dx} &= f_1(x,y_1,y_2,\cdots,y_N) \\
\frac{dy_2}{dx} &= f_2(x,y_1,y_2,\cdots,y_N) \\
&\vdots \\
\frac{dy_N}{dx} &= f_N(x,y_1,y_2,\cdots,y_N) \\
\end{aligned}
\right.
\end{eqnarray}
\)
———
まず係数\(k_a\)を求めます。
———
\(
\begin{eqnarray}
\left\{
\begin{aligned}
k_{a1} &= hf_1(x,y_1,y_2,\cdots,y_N) \\
k_{a2} &= hf_2(x,y_1,y_2,\cdots,y_N) \\
&\vdots \\
k_{aN} &= hf_N(x,y_1,y_2,\cdots,y_N) \\
\end{aligned}
\right.
\end{eqnarray}
\)
———
次に\(k_b\)。
———
\(
\begin{eqnarray}
\left\{
\begin{aligned}
k_{b1} &= hf_1(x+\frac{h}{2},y_1+\frac{k_{a1}}{2},y_2+\frac{k_{a2}}{2},\cdots,y_N+\frac{k_{aN}}{2}) \\
k_{b2} &= hf_2(x+\frac{h}{2},y_1+\frac{k_{a1}}{2},y_2+\frac{k_{a2}}{2},\cdots,y_N+\frac{k_{aN}}{2}) \\
&\vdots \\
k_{bN} &= hf_N(x+\frac{h}{2},y_1+\frac{k_{a1}}{2},y_2+\frac{k_{a2}}{2},\cdots,y_N+\frac{k_{aN}}{2}) \\
\end{aligned}
\right.
\end{eqnarray}
\)
———
そして\(k_c\)。
———
\(
\begin{eqnarray}
\left\{
\begin{aligned}
k_{c1} &= hf_1(x+\frac{h}{2},y_1+\frac{k_{b1}}{2},y_2+\frac{k_{b2}}{2},\cdots,y_N+\frac{k_{bN}}{2}) \\
k_{c2} &= hf_2(x+\frac{h}{2},y_1+\frac{k_{b1}}{2},y_2+\frac{k_{b2}}{2},\cdots,y_N+\frac{k_{bN}}{2}) \\
&\vdots \\
k_{cN} &= hf_N(x+\frac{h}{2},y_1+\frac{k_{b1}}{2},y_2+\frac{k_{b2}}{2},\cdots,y_N+\frac{k_{bN}}{2}) \\
\end{aligned}
\right.
\end{eqnarray}
\)
———
最後に\(k_d\)。
———
\(
\begin{eqnarray}
\left\{
\begin{aligned}
k_{d1} &= hf_1(x+h,y_1+k_{c1},y_2+k_{c2},\cdots,y_N+k_{cN}) \\
k_{d2} &= hf_2(x+h,y_1+k_{c1},y_2+k_{c2},\cdots,y_N+k_{cN}) \\
&\vdots \\
k_{dN} &= hf_N(x+h,y_1+k_{c1},y_2+k_{c2},\cdots,y_N+k_{cN}) \\
\end{aligned}
\right.
\end{eqnarray}
\)
———
最後に求めた\(k_a,k_b,k_c,k_d\)を使って\(x+h\)でのそれぞれの関数の値を導きます。、
———
\(
\begin{eqnarray}
\left\{
\begin{aligned}
x &= x+h \\
y_{1} &= y_{1}+(k_{a1}+2k_{b1}+2k_{c1}+k_{d1})/6 \\
y_{2} &= y_{2}+(k_{a2}+2k_{b2}+2k_{c2}+k_{d2})/6 \\
&\vdots \\
y_{N} &= y_{N}+(k_{aN}+2k_{bN}+2k_{cN}+k_{dN})/6 \\
\end{aligned}
\right.
\end{eqnarray}
\)
———
となります。

4次ルンゲ=クッタ法のプログラム


実際に例題を解きましょう。
2つの例題を解きます。

[adsense1]

1階微分方程式


1つ目は
\(
\displaystyle \frac{dy}{dx}=-y\sin{x}
\)

です。
一般解は
\(
y=Ae^{\cos{x}}
\)

であり、初期条件\(x=0,y=2\)として解けば解析解は
\(
y=2e^{\cos{x}-1}
\)

です。これを4次ルンゲ=クッタ法を用いて解くには、以下のプログラムで実現できます。

解いて、gnuplotで
plot “fort.10”
数値計算解(赤点)解析解(緑線)と共に出力すると、こんなグラフが得られます。
4次ルンゲクッタ法による計算1

連立1階微分方程式


もう一つの例題は微分方程式
\(
\displaystyle \frac{d^2y}{dx^2}+2\gamma \frac{dy}{dx}+y=0
\)

を解きます。これは物理の世界ではバネの減衰振動を表す運動方程式で(詳しくは減衰振動へ。)、\(0\lt\gamma\lt1\)の場合、解は
\(
y(x)=Ae^{-\gamma x}\cos(x\sqrt{1-\gamma^2}-\alpha)
\)

となります。
\(\gamma=0.15\), 初期条件を今、
\(
\begin{eqnarray}
\left\{
\begin{aligned}
\left.y\right|_{x=0} &= 1 \\
\left.\frac{dy}{dx}\right|_{x=0} &= -0.15 \\
\end{aligned}
\right.
\end{eqnarray}
\)
とすると、解析解は
\(
y(x)=e^{-\gamma x}\cos{(x\sqrt{1-0.15^2})}
\)

となります。
プログラムで計算する際は、まず連立1次微分方程式に焼きなおす必要があります。すなわち、
\(
\begin{eqnarray}
\left\{
\begin{aligned}
\frac{dy}{dx}&=v \\
\frac{dv}{dx}&=-2\gamma v -y \\
\end{aligned}
\right.
\end{eqnarray}
\)
として解けばいいわけです。

その時の変更するべき場所は少しで、mainとrkfdの一部を変えればおしまいです。
変えた場所をコメントで
!+—+
を入れたので確認してください。

gnuplotで数値計算解(赤点)解析解(緑線)のグラフを書くとこうでなります。
4次ルンゲクッタ法による計算2

[adsense2]