home *** CD-ROM | disk | FTP | other *** search
- 1 POKE 53280,0:POKE 53281,0:PRINT""
- 5 PRINT"[147]"
- 10 REM JACOBI METHOD FOR FINDING THE
- 12 REM EIGENVALUES AND EIGENVECTORS OF
- 13 REM A SYMETRIC MATRIX
- 14 REM *******************************
- 15 REM ORIGINAL BASIC PROGRAM BY
- 16 REM DR. THOMAS MITCHEL. PORTED TO
- 17 REM THE COMMODORE 64 BY JIM STUBBE
- 18 REM *******************************
- 19 REM TITLE SCREEN
- 20 PRINT" EIGENVALUE/EIGENVECTOR FINDER"
- 21 PRINT
- 22 PRINT:PRINT" BY JIM STUBBE":PRINT
- 23 PRINT" THIS PROGRAM FINDS THE"
- 24 PRINT" EIGENVALUES AND EIGENVACTORS"
- 25 PRINT" OF A SYMETRIC MATRIX USING"
- 26 PRINT" THE JACOBI METHOD.":PRINT:PRINT" THE EQN SOLVED IS:
- 27 [153]" A(NN)B(N)=CI(NN)B(N)":[153]
- 28 [153]" WHERE A IS A SQUARE MATRIX,"
- 29 [153]" I IS THE IDENTITY MATRIX, C IS A"
- 30 [153]" SCALAR AND B IS A VECTOR.":[153]
- 31 [153]
- 32 [143] INPUT DEGREE OF MATRIX A
- 33 [153]"ENTER DEGREE OF A (A IS N BY N)":[133] N%
- 34 N[178]N%
- 36 [153]:[153]" ******(HIT ANY KEY TO CONTINUE)****** "
- 37 [161] A$:[139] A$[178]"" [167] 37
- 38 [153] "LOAD"
- 39 [143] DIMENSION A AND R
- 40 [134] A(N%,N%),R(N%,N%),XX(N%,N%),C(N%,N%)
- 41 [141] 6000
- 42 [143] INPUT ELEMENTS OF A
- 50 [129] I[178]1 [164] N%
- 60 [129] J[178]1 [164] N%
- 70 [153]" ENTER A("I""J"):":[133] A(I,J)
- 90 [130] J
- 100 [130] I
- 110 :[153]:[153]"DO YOU WANT OUTPUT PRINTED(Y/N)?"
- 111 [161] B$:[139] B$[178]"" [167] 111
- 112 [139] B$[178]"Y" [167] 114
- 113 CT[178]0:[137] 116
- 114 [143] OPEN PRINTER AND SET PRINT CONTROL (CT)
- 115 [159] 4,4:CT[178]1
- 116 [143] GOSUB TO PRINT A
- 117 [153]"LOAD":[141] 3000
- 119 [143] INITIALIZE UNIT MATRIX
- 120 [143]
- 121 [153]:[153]"THE MATRIX I IS:"
- 122 [153]
- 123 [139] CT[178]1 [167] [152]4,:[139] CT[178]1 [167] [152]4,"THE MATRIX I IS:"
- 124 [139] CT[178]1 [167] [152]4,
- 125 [143] SET TR (TRACE(A)) TO ZERO
- 126 TR[178]0
- 150 [129] A[178]1 [164] N%
- 160 [129] B[178]1 [164] N%
- 170 [139] A[178]B [167] R(A,B)[178]1: [139] A[178]B [167] [137] 180
- 175 R(A,B)[178]0
- 180 [139] CT[178]1 [167] [152]4, R(A,B);" ";
- 181 [153] R(A,B);" ";
- 182 [139] A[178]B [167] TR[178]TR[170]A(A,B)
- 190 [130] B
- 191 [139] CT[178]1 [167] [152]4,
- 192 [153]
- 200 [130] A
- 201 [153]:[139] CT[178]1 [167] [152]4,
- 205 [153]:[153]
- 206 [153]" *****(HIT ANY KEY TO CONTINUE*****"
- 207 [161] S$:[139] S$[178]"" [167] [137] 207
- 208 [153]"LOAD"
- 230 NUSWEEP[178]0
- 240 NSKIP[178]0
- 250 [129] I[178]1 [164] N%[171]1
- 260 L[178]I[170]1
- 270 [129] J[178]L [164] N%
- 280 AVRG[178].5[172](A(I,J)[170]A(J,I))
- 290 DELT[178]A(I,I)[171]A(J,J)
- 300 RAD[178][186](DELT[172]DELT[170]4[172]AVRG[172]AVRG)
- 310 [139] RAD[178]0 [167] [137] 430
- 320 [139] RAD[179]0 [167] [137] 390
- 330 [139] [182](A(I,I))[178][182](A(I,I))[170]100[172][182](AVRG) [167] [137] 350
- 340 [137] 360
- 350 [139] [182](A(J,J))[178][182](A(J,J))[170]100[172][182](AVRG) [167] [137] 430
- 360 CSN[178][186]((RAD[170]DELT)[173](2[172]RAD))
- 370 SN[178]AVRG[173](RAD[172]CSN)
- 380 [137] 420
- 390 SN[178][186]((RAD[171]DELT)[173](2[172]RAD))
- 400 [139] AVRG[179]0 [167] SN[178][171]SN
- 410 CSN[178]AVRG[173](RAD[172]SN)
- 420 [139] 1[179]1[170][182](SN) [167] [137] 450
- 430 NSKIP[178]NSKIP[170]1
- 440 [137] 580
- 450 [129] K[178]1 [164] N%
- 460 Q[178]A(I,K)
- 470 A(I,K)[178]CSN[172]Q[170]SN[172]A(J,K)
- 480 A(J,K)[178][171]SN[172]Q[170]CSN[172]A(J,K)
- 490 [130] K
- 500 [129] K[178]1 [164] N%
- 510 Q[178]A(K,I)
- 520 A(K,I)[178]CSN[172]Q[170]SN[172]A(K,J)
- 530 A(K,J)[178][171]SN[172]Q[170]CSN[172]A(K,J)
- 540 Q[178]R(K,I)
- 550 R(K,I)[178]CSN[172]Q[170]SN[172]R(K,J)
- 560 R(K,J)[178][171]SN[172]Q[170]CSN[172]R(K,J)
- 570 [130] K
- 580 [130] J
- 590 [130] I
- 591 [153]"---------------------------------------"
- 592 [139] CT[178]1 [167] [152]4,"---------------------------------------"
- 600 [139] CT[178]1 [167] [152]4,"NUSWEEP="NUSWEEP,"NSKIP="NSKIP
- 601 [153] "NUSWEEP="NUSWEEP,"NSKIP="NSKIP
- 602 [143] CALL SUBROUTINE TO PRINT A
- 603 [153]:[153]"THE MODIFIED MATRIX A IS:"
- 604 [153]
- 605 [139] CT[178]1 [167] [152]4,:[139] CT[178]1 [167] [152]4,"THE MODIFIED MATRIX A IS:"
- 606 [139] CT[178]1 [167] [152]4,
- 607 [141] 3010
- 609 NUSWEEP[178]NUSWEEP[170]1
- 610 [139] NUSWEEP[177]50 [167] [137] 630
- 620 [139] NSKIP[179]N[172](N[171]1)[173]2 [167] [137] 240
- 630 [143] PRINT FINAL SWEEP VALUES
- 631 [153]"---------------------------------------"
- 632 [139] CT[178]1 [167] [152]4,"---------------------------------------"
- 633 [153]"NUSWEEP="NUSWEEP,"NSKIP="NSKIP:[153]
- 634 [139] CT[178]1 [167] [152]4,"NUSWEEP="NUSWEEP,"NSKIP="NSKIP:[139] CT[178]1 [167] [152]4,
- 635 [153]"THE MODIFIED MATRIX A IS:":[153]
- 636 [139] CT[178]1 [167] [152]4,"THE MODIFIED MATRIX A IS:":[139] CT[178]1 [167] [152]4,
- 637 [141] 3010
- 640 [143] CHECK EIGENVALUES
- 641 [141] 4000
- 642 [143] PRINT EIGENVALUES
- 643 [141] 5000
- 645 [143] PRINT EIGENVALUES
- 646 [153]"THE EIGENVALUES ARE:"
- 647 [139] CT[178]1 [167] [152]4,"THE EIGENVALUES ARE:"
- 648 [153]
- 649 [139] CT[178]1 [167] [152]4,
- 650 [129] J[178]1 [164] N%
- 660 [153] J,A(J,J)
- 661 [139] CT[178]1 [167] [152]4,J,A(J,J)
- 670 [130] J
- 671 [153]
- 672 [139] CT[178]1 [167] [152]4,
- 681 [143] PRINT EIGENVECTORS
- 682 [153]"THE EIGENVECTORS ARE:":[153]
- 683 [139] CT[178]1 [167] [152]4,"THE EIGENVECTORS ARE:":[139] CT[178]1 [167] [152]4,
- 690 [129] I[178]1 [164] N%
- 700 [129] J[178]1 [164] N%
- 710 [153] R(I,J);" ";
- 711 [139] CT[178]1 [167] [152]4,R(I,J);" ";
- 720 [130] J
- 730 [139] CT[178]1 [167] [152]4,
- 731 [153]
- 740 [130] I
- 2990 [128]
- 2998 [143] **************************
- 2999 [143] SUBROUTINE PRINT A
- 3000 [143] **************************
- 3004 [153]"THE MATRIX A IS:":[153]
- 3005 [139] CT[178]1 [167] [152]4,"THE MATRIX A IS:":[139] CT[178]1 [167] [152]4,
- 3010 [129] C[178]1 [164] N%
- 3012 [129] B[178]1 [164] N%
- 3020 [139] CT[178]1 [167] [152]4,A(C,B);" ";
- 3021 [153] A(C,B);" ";
- 3025 [130] B
- 3026 [139] CT[178]1 [167] [152]4,
- 3027 [153]
- 3030 [130] C
- 3031 [139] CT[178]1 [167] [152]4,
- 3032 [153]
- 3035 [142]
- 4000 [143] ***************************
- 4010 [143] SUBROUTINE CHECK EIGENVALUE
- 4050 [143] ***************************
- 4051 [153]"***************************************"
- 4052 [139] CT[178]1 [167] [152]4,"***************************************"
- 4055 TC[178]0
- 4060 [129] G[178]1 [164] N%
- 4070 TC[178]TC[170]A(G,G)
- 4080 [130] G
- 4081 [153]"(AS A CHECK THESE SHOULD BE THE SAME)":[153]
- 4082 [139] CT[178]1 [167] [152]4,"(AS A CHECK THESE SHOULD BE THE SAME)"
- 4083 [139] CT[178]1 [167] [152]4,
- 4085 [153]"THE TRACE OF ORIGINAL A IS:"TR
- 4086 [153]"SUM OF A'S EIGENVALUES ARE:"TC:
- 4090 [139] CT[178]1 [167] [152]4,"THE TRACE OF ORIGINAL A IS:"TR
- 4095 [139] CT[178]1 [167] [152]4,"SUM OF A'S EIGENVALUES ARE:"TC
- 4096 [153]:[139] CT[178]1 [167] [152]4,
- 4099 [142]
- 5000 [143] ****************************
- 5010 [143] SUBROUTINE CHECK EIGENVECTOR
- 5020 [143] ****************************
- 5030 [143] FIND TRANSPOSE OF EIGENVECTORS
- 5040 [129] I[178]1 [164] N%
- 5050 [129] J[178]1 [164] N%
- 5060 XX(J,I)[178]R(I,J)
- 5070 [130] J
- 5080 [130] I
- 5100 [143] MULTIPLY I BY ITS TRANSPOSE
- 5150 [129] I[178]1 [164] N%
- 5200 [129] J[178]1 [164] N%
- 5210 SUM[178]0.0
- 5220 [129] K[178]1 [164] N%
- 5300 SUM[178]SUM[170](R(I,K)[172]XX(K,J))
- 5310 C(I,J)[178]SUM
- 5320 [130] K
- 5325 [130] J
- 5400 [130] I
- 5420 [139] CT[178]1 [167] [152]4,"(AS A CHECK THE FOLLOWING SHOULD BE ";
- 5430 [139] CT[178]1 [167] [152]4,"THE IDENTITY MATRIX)"
- 5500 [153]:[153]"(AS A CHECK THE FOLLOWING SHOULD BE THE IDENTITIY MATRIX)"
- 5600 [153]:[139] CT[178]1 [167] [152]4,
- 5700 [129] I[178]1 [164] N%
- 5710 [129] J[178]1 [164] N%
- 5720 [153] C(I,J);" ";
- 5725 [139] CT[178]1 [167] [152]4,C(I,J);" ";
- 5730 [130] J
- 5740 [153]
- 5745 [139] CT[178]1 [167] [152]4,
- 5750 [130] I
- 5751 [153]:[139] CT[178]1 [167] [152]4,
- 5800 [142]
- 6000 [143] *************************
- 6010 [143] SUBROUTINE GRAPHIC A
- 6020 [143] *************************
- 6030 [153]"MATRIX A IS AS FOLLOWS:":[153]
- 6040 [153]" CHR$A(1,1) A(1,2) ....A(1,N)CHR$"
- 6050 [153]" CHR$A(2,1) A(2,2) ....A(2,N)CHR$"
- 6060 [153]" CHR$A(3,1) A(3,2) ....A(3,N)CHR$"
- 6070 [153]" CHR$ . . . CHR$"
- 6080 [153]" CHR$ . . . CHR$"
- 6090 [153]" CHR$ . . . CHR$"
- 6095 [153]" CHR$A(N,1) A(N,2) ....A(N,N)CHR$"
- 7000 [153]:[142]
-