File: JACORD.BA of Tape: Various/ETH/ba1

(Source file text) 

---

10 DIM C2(15,15)
20 DIM P1(15,15)
30 PRINT "'JACORD' CYCLIC JACOBI ROTATION OF MATRIX"
40 PRINT "GIVE SIZE OF MATRIX";
50 INPUT M
60 M=M-1
70 PRINT "ENTER MATRIX"
80 PRINT
100 FOR J=0 TO M
110 FOR K=J TO M
115 PRINT "A("&STR$(J)&","&STR$(K)&")";
120 INPUT C2(J,K)
130 NEXT K
140 PRINT
150 NEXT J
160 GOSUB 2000
162 PRINT "NUMBER OF ITERATIONS";L
165 PRINT\PRINT "EIGENVALUES"\PRINT
170 FOR I=0 TO M
180 PRINT C2(I,I),
190 NEXT I
200 PRINT\PRINT\PRINT "EIGENVECTORS"
210 FOR J=0 TO M
220 PRINT
230 FOR K=0 TO M
240 PRINT P1(J,K),
250 NEXT K
260 NEXT J
270 STOP
2000 FOR J=0 TO M
2010 FOR K=0 TO M
2020 P1(J,K)=0
2030 NEXT K
2040 P1(J,J)=1
2050 NEXT J
2100 FOR L=1 TO 50
2110 S9=0
2120 FOR J=0 TO M-1
2130 FOR K=J+1 TO M
2140 S9=S9+C2(J,K)*C2(J,K)
2150 NEXT K
2160 NEXT J
2170 T9=0
2180 IF L>3 THEN 2200
2190 T9=.2*SQR(2*S9)/(M+1)
2200 FOR J=0 TO M-1
2210 FOR K=J+1 TO M
2220 IF C2(J,J)+C2(J,K)<>C2(J,J) THEN 2240
2230 IF C2(K,K)+C2(J,K)=C2(K,K) THEN 2300
2240 IF C2(J,K)*C2(J,K)=0 THEN 2300
2250 IF ABS(C2(J,K))<=T9 THEN 2900
2260 T8=.5*(C2(K,K)-C2(J,J))/C2(J,K)
2270 IF .1/(T8*T8)=0 THEN 2290
2275 T=1/(ABS(T8)+SQR(1+T8*T8))
2280 IF T8>0 THEN 2285
2283 T=-T
2285 C=1/SQR(1+T*T)\S=T*C\GOTO 2400
2290 S=.5/T8\C=1\GOTO 2400
2300 C2(J,K)=0
2330 IF C2(J,J)>=C2(K,K) THEN 2900
2350 C=0
2380 S=1
2400 H=C*C*C2(J,J)-2*C*S*C2(J,K)+S*S*C2(K,K)
2410 G=S*S*C2(J,J)+2*C*S*C2(J,K)+C*C*C2(K,K)
2420 C2(J,K)=C*S*(C2(J,J)-C2(K,K))+C2(J,K)*(C*C-S*S)
2430 C2(J,J)=H\C2(K,K)=G
2440 FOR I=0 TO J-1
2450 H=C*C2(I,J)-S*C2(I,K)
2460 C2(I,K)=S*C2(I,J)+C*C2(I,K)\C2(I,J)=H
2470 NEXT I
2480 FOR I=J+1 TO K-1
2490 H=C*C2(J,I)-S*C2(I,K)
2500 C2(I,K)=S*C2(J,I)+C*C2(I,K)\C2(J,I)=H
2510 NEXT I
2520 FOR I=K+1 TO M
2530 H=C*C2(J,I)-S*C2(K,I)
2540 C2(K,I)=S*C2(J,I)+C*C2(K,I)\C2(J,I)=H
2550 NEXT I
2560 FOR I=0 TO M
2570 H=C*P1(I,J)-S*P1(I,K)
2580 P1(I,K)=S*P1(I,J)+C*P1(I,K)\P1(I,J)=H
2590 NEXT I
2600 C2(J,K)=0
2900 NEXT K
2910 NEXT J
2920 IF S9=0 THEN 2950
2930 NEXT L
2950 RETURN
3000 END

---