1000 OPTION ARITHMETIC COMPLEX
1010 
1020 LET i=SQR(-1) !虚数単位
1030 
1040 LET cEps=1e-8 !誤差　※単精度
1050 
1060 
1070 LET N=3 !N次正方行列
1080 
1090 FUNCTION tr(A(,)) !行列Aのトレース
1100    LET t=0
1110    FOR j=1 TO N
1120       LET t=t+A(j,j)
1130    NEXT j
1140    LET tr=t
1150 END FUNCTION
1160 
1170 
1180 DIM c(N) !多項式 X^N+c(1)*X^(N-1)+c(2)*X^(N-2)+ … +c(N-1)*X+c(N) の係数
1190 SUB DKA_00(A(),Xr()) !DKA法（Durand Kerner Aberth）
1200    LET r=1 !初期値を仮定する
1210    FOR j=2 TO N
1220       LET rn=ABS(A(j))^(1/j)
1230       if r<rn then LET r=rn
1240    NEXT j
1250    FOR j=1 TO N !半径rの円に等間隔に配置する
1260       LET Xr(j)=-A(1)/N+r*EXP( 2*PI*i/N *(j-3/4) ) !アーバスの初期値
1270    NEXT j
1280     
1290    FOR m=0 TO 100 !反復　※調整要
1300       LET mfx=0
1310       LET maj=0
1320       FOR j=1 TO N
1330          LET Xk=1
1340          LET fx=1
1350          FOR w=1 TO N
1360             LET fx=fx*Xr(j)+A(w)
1370             IF w<>j THEN LET Xk=Xk*(Xr(j)-Xr(w))
1380          NEXT w
1390          LET Xr(j)=Xr(j)-fx/Xk
1400          IF mfx<ABS(fx) THEN LET mfx=ABS(fx)
1410          IF maj<ABS(fx/Xk) THEN LET maj=ABS(fx/Xk)
1420       NEXT j
1430       IF mfx<cEps AND maj<cEps THEN EXIT FOR !収束したら
1440    NEXT m
1450 END SUB
1460 !-------------------- ここまでがサブルーチン
1470 
1480 
1490 DIM A(N,N) !行列A
1500 !DATA 1,0,0 !λ=1（３重根）
1510 !DATA 0,1,1
1520 !DATA 0,0,1
1530 
1540 !DATA 0,1,1 !λ=2,-1（重根）
1550 !DATA 1,0,1
1560 !DATA 1,1,0
1570 
1580 !DATA 3,0,0 !λ=3,±i
1590 !DATA 0,2,-5
1600 !DATA 0,1,-2
1610 
1620 DATA 2,1,-1 !λ=3,2,1
1630 DATA 0,3,0
1640 DATA 0,2,1
1650 
1660 MAT READ A
1670 
1680 MAT PRINT A;
1690 
1700 PRINT 1700
1710 !n次正方行列Aの固有多項式 det(tE-A)=t^n+c1*t^(n-1)+ … + cn を求める。
1720 DIM X(N,N),cE(N,N)
1730 MAT X=IDN !frame法
1740 FOR k=1 TO N
1745    PRINT 1745 ,"A","X"
1746    MAT PRINT A
1747    MAT PRINT X
1750    MAT X=A*X
1755    PRINT 1755 ,"X"
1756    MAT PRINT X
1760    LET c(k)=-tr(X)/k
1765    PRINT 1765
1770    MAT cE=(c(k))*IDN
1775    PRINT 1775  ,"X","cE"
1776    MAT PRINT X
1777    MAT PRINT cE
1780    MAT X=X+cE
1785    PRINT 1785 ;"X"
1786    MAT PRINT X
1790 NEXT k
1800 MAT PRINT c;
1810 PRINT 1810
1820 !ニュートン法などで解く。解が固有値になる。
1830 DIM lmd(N)
1840 CALL DKA_00(c,lmd)
1850 PRINT 1850
1860 FOR k=1 TO N
1870    PRINT "固有値=";lmd(k)
1880 NEXT k
1890 
1900 
1910 
1920 !※N個求まった場合の検算
1930 LET s=1
1940 FOR k=1 TO N
1950    LET s=s*lmd(k)
1960 NEXT k
1970 PRINT s, DET(A) !固有値の積=行列の行列式　Πλi=|A|
1980 
1990 LET s=0
2000 FOR k=1 TO N
2010    LET s=s+lmd(k)
2020 NEXT k
2030 PRINT s, tr(A) !固有値の和=行列のトレース　Σλi=trA
2040 
2050 
2060 END
