!2階微分方程式の、ルンゲクッタ描画。

 投稿者:SECOND  投稿日:2009年11月21日(土)09時27分17秒
  !2階微分方程式の、ルンゲクッタ描画。

!ベッセルの微分方程式の場合。

!x^2*(d2y/dx2)+x*(dy/dx)+(x^2-a^2)*y=0 …ベッセル
!x^2*(d2y/dx2)+x*(dy/dx)-(x^2+a^2)*y=0 …変形ベッセル
!-------------------------------
OPTION ARITHMETIC NATIVE
OPTION BASE 0
SET TEXT background "opaque"
DIM col(4), y0(4)
MAT READ col
DATA 4,10,2,14, 12 ! 0次 ~4次の色分け
!-----------------------------------------------------------------------
!0白 1黒   2青      3緑      4赤    5水色    6黄色        7赤紫
!    8灰色 9濃い青 10濃い緑 11青緑 12えび茶 13オリーブ色 14濃い紫 15銀色
!-----------------------------------------------------------------------

SUB Dji( oddy,ody, iddy,idy,y)
   LET oddy=-( x*idy +(sj*x^2-a^2)*y)/x^2 ! ddy=(d2y/dx2) :sj=1(ベッセル)
   LET ody=-(x^2*iddy+(sj*x^2-a^2)*y)/x   ! dy=  (dy/dx)  :sj=-1(変形ベッセル)
END SUB

SUB RungeKutta
   CALL Dji( oddy1,ody1, iddy, idy, y)
   CALL Dji( oddy2,ody2, iddy, idy+oddy1*dx/2, y+ody1*dx/2)
   CALL Dji( oddy3,ody3, iddy, idy+oddy2*dx/2, y+ody2*dx/2)
   CALL Dji( oddy4,ody4, iddy, idy+oddy3*dx  , y+ody3*dx  )
   LET  y=y+(ody1+2*ody2+2*ody3+ody4)*dx/6
   LET idy=idy+(oddy1+2*oddy2+2*oddy3+oddy4)*dx/6
   LET iddy=oddy4
END SUB

LET dx=.0005               !pitch
LET y0(0)=1                !yの初期値
LET y0(1)= 0.708248*dx
LET y0(2)=-1.2017  *dx^2
LET y0(3)=-0.015   *dx^3
LET y0(4)= 0.00615 *dx^4
!-----
LET sj=-1
LET m$="変形"
CALL window_
CALL Rk_bessel  !変形ベッセルの微分方程式( ルンゲクッタ描画 )
CALL fn_bessel  !変形ベッセル関数1種 In(x)
WAIT DELAY 2
!-----
LET sj=1
LET m$=""
CALL window_
CALL Rk_bessel  !  ベッセルの微分方程式( ルンゲクッタ描画 )
CALL fn_bessel  !  ベッセル関数1種 Jn(x)

SUB window_
   CLEAR
   IF sj=1 THEN  !----ベッセル
      LET h=1
      LET l=-1
      LET xr=20
      SET WINDOW -3,xr, l, h
      DRAW grid(xr/4,h/5)
   ELSEIF sj=-1 THEN  !----変形ベッセル
      LET h=4
      LET l=-1.5
      LET xr=4
      SET WINDOW -0.3,xr, l, h
      DRAW grid(xr/8,h/8)
   END IF
   ASK PIXEL SIZE(0,0;xr,0) px,py
   LET ss=Xr/px
END SUB

!-------------------- 微分方程式のルンゲクッタ描画
SUB Rk_bessel
   SET TEXT COLOR 4
   PLOT TEXT,AT (.325+.225*sj)*xr,.9*h-(.2-.04*sj)*(h-l) :"ルンゲクッタ描画"
   FOR a=0 TO 4
      LET y=y0(a)
      LET idy=0
      LET iddy=0
      SET LINE COLOR "gray" !col(a+4)
      SET TEXT COLOR "gray" !col(a+4)
      PLOT TEXT,AT .1*xr,.9*h-.04*(h-l)*a :m$& "ベッセルの微分方程式 "& STR$(a)& "次"
      !------------
      FOR x=dx TO xr+dx STEP dx
         PLOT LINES: x,y; ! PEN-on
         IF FP(x)< dx THEN PRINT USING"##.## ###.######":x,y
         CALL RungeKutta
      NEXT x
      !------------
      PLOT LINES !PEN-off
      PRINT
   NEXT a
END SUB

!********************* 解のベッセル関数を重ねて照合する。
SUB fn_bessel
   SET TEXT COLOR 1
   PLOT TEXT,AT (.325+.225*sj)*xr,.9*h-(.2-.04*sj)*(h-l) :"関数で、重ね書き"
   FOR n=0 TO 4
      SET LINE COLOR col(n)
      SET TEXT COLOR col(n)
      PLOT TEXT,AT .1*xr,.9*h-.04*(h-l)*n :m$& "ベッセル関数1種 "& STR$(n)& "次  "
      !------------画素間隔のStep
      FOR x=dx TO xr+ss STEP ss
         PLOT LINES: x,bessel(n,x); ! PEN-on
         IF FP(x)< ss AND dx< x THEN PRINT USING"##.## ###.######":IP(x),bessel(n,IP(x))
      NEXT x
      !------------
      PLOT LINES !PEN-off
      PRINT
   NEXT n
END SUB

!------- ベッセル関数 変形ベッセル関数
FUNCTION bessel(n,x)
   LET m=2*INT( (6+MAX(n,1.5*ABS(x))+9*1.5*ABS(x)/(1.5*ABS(x)+2))/2)
   LET w=0
   IF sj=1 THEN      !---- ベッセル関数 Jn(x)
      FOR k=1 TO m/2
         LET w=w+Tk(k*2,x)
      NEXT k
      LET bessel=Tk(n,x)/(Tk(0,x)+2*w)
   ELSEIF sj=-1 THEN !---- 変形ベッセル関数 In(x)
      FOR k=1 TO m
         LET w=w+Tk(k,x)
      NEXT k
      LET bessel=EXP(x)*Tk(n,x)/(Tk(0,x)+2*w)
   END IF
END FUNCTION

FUNCTION Tk(i,x)
   LET t2=0
   LET t1=1e-9
   LET t0=2*(m+1)/x*t1-sj*t2
   FOR kp1=m TO i+1 STEP -1
      LET t2=t1
      LET t1=t0
      LET t0=2*kp1/x*t1-sj*t2
   NEXT kp1
   LET Tk=t0
END FUNCTION

END
 

戻る