8990  REM ***  HP TIME-SHARED BASIC PROGRAM LIBRARY  *********************
8991  REM
8992  REM         JACOBI:  EIGENVALUES AND EIGENVECTORS OF A REAL
8993  REM                  SYMMETRIC MATRIX
8994  REM         36167 (A820) REV A -- 7/71
8995  REM
8996  REM ***  CONTRIBUTED PROGRAM  ***************************************
8997  REM
9000  REM **** JACOBI **** QUANTUM MECHANICS
9001  REM **** WRITTEN BY A. CATLIN **** JULY 1969
9002  REM EIGENVALUES AND EIGENVECTORS OF A REAL SYMMETRIC MATRIX
9003  REM ARE CALCULATED BY THE JACOBI ROTATION METHOD.
9004  REM SEE BURROUGHS PUBLICATION MRS-087/R
9005  PRINT "TYPE 1 IF YOU WANT INSTRUCTIONS, OTHERWISE 0";
9006  INPUT P
9007  IF P>0 THEN 9120
9008  PRINT 
9009  PRINT "WHAT IS REQUIRED RELATIVE ACCURACY OF EIGENVALUES";
9010  INPUT D5
9011  PRINT 
9012  REM INUT ORDER AND ELEMENTS OF SYMMETRIC MATRIX A
9013  PRINT "WHAT IS ORDER OF MATRIX";
9014  INPUT N
9015  PRINT 
9016  PRINT "WHAT ARE THE MATRIX ELEMENTS";
9017  MAT  INPUT A[N,N]
9018  PRINT 
9019  PRINT 
9020  REM SET MATRIX U EQUAL TO THE IDENTITY MATRIX
9021  MAT U=IDN[N,N]
9022  REM CALCULATE THE OFF-DIAGONAL NORM N5 OF MATRIX A
9023  LET N5=0
9024  FOR I=2 TO N
9025  FOR J=1 TO N-1
9026  LET N5=N5+2*(A[I,J]^2)
9027  LET N5=SQR(N5)
9028  NEXT J
9029  NEXT I
9030  REM CALCULATE THE FINAL THRESHOLD V5
9031  LET A5=(N^2)-N
9032  LET V5=D5/SQR(A5)
9033  LET V=N5
9034  REM G5 IS USED AS A CONTROL NUMBER
9035  LET G5=0
9036  LET V=V/N
9037  REM CONSIDER ONLY LOWER TRIANGULAR ELEMENTS AND EXAMINE THE
9038  REM OFF-DIAGONAL ELEMENTS BY ROWS IN SYSTEMATIC ORDER. 
9039  REM ROTATE IF MAGNITUDE IS GREATER THAN CURRENT THRESHOLD V
9040  FOR I0=2 TO N
9041  FOR J0=1 TO I0-1
9042  IF ABS(A[I0,J0]) <= V THEN 9089
9043  LET G5=1
9044  IF A[J0,J0]=A[I0,I0] THEN 9055
9045  IF A[J0,J0]>A[I0,I0] THEN 9047
9046  IF A[J0,J0]<A[I0,I0] THEN 9049
9047  LET S5=1
9048  GOTO 9051
9049  LET S5=-1
9050  GOTO 9051
9051  LET F1=ABS(A[J0,J0]-A[I0,I0])
9052  LET F2=SQR((A[J0,J0]-A[I0,I0])^2+4*A[I0,J0]^2)
9053  LET T=(2*A[I0,J0]*S5)/(F1+F2)
9054  GOTO 9056
9055  LET T=1
9056  LET C=1/SQR(1+T^2)
9057  LET S=T*C
9058  LET C1=C^2
9059  LET S1=S^2
9060  LET T1=T^2
9061  LET T5=A[I0,I0]
9062  LET A[I0,I0]=C1*(A[I0,I0]-2*T*A[I0,J0]+T1*A[J0,J0])
9063  LET A[J0,J0]=C1*(A[J0,J0]+2*T*A[I0,J0]+T1*T5)
9064  LET A[I0,J0]=0
9065  LET J1=J0-1
9066  FOR J=1 TO J1
9067  LET T5=-S*A[J0,J]+C*A[I0,J]
9068  LET A[J0,J]=C*A[J0,J]+S*A[I0,J]
9069  LET A[I0,J]=T5
9070  NEXT J
9071  LET I1=J0+1
9072  LET I2=I0-1
9073  FOR I=I1 TO I2
9074  LET T5=-S*A[I,J0]+C*A[I0,I]
9075  LET A[I,J0]=C*A[I,J0]+S*A[I0,I]
9076  LET A[I0,I]=T5
9077  NEXT I
9078  LET I1=I0+1
9079  FOR I=I1 TO N
9080  LET T5=-S*A[I,J0]+C*A[I,I0]
9081  LET A[I,J0]=C*A[I,J0]+S*A[I,I0]
9082  LET A[I,I0]=T5
9083  NEXT I
9084  FOR I=1 TO N
9085  LET T5=C*U[I,I0]-S*U[I,J0]
9086  LET U[I,J0]=S*U[I,I0]+C*U[I,J0]
9087  LET U[I,I0]=T5
9088  NEXT I
9089  NEXT J0
9090  NEXT I0
9091  REM TEST IF CURRENT THRESHOLD V IS EXCEEDED
9092  REM AND IF NOT, WHETHER FINAL THRESHOLD V5 IS REACHED.
9093  IF G5=1 THEN 9095
9094  GOTO 9097
9095  LET G5=0
9096  GOTO 9040
9097  IF V >= V5 THEN 9036
9098  FOR I=2 TO N
9099  FOR J=1 TO I-1
9100  LET A[J,I]=A[I,J]
9101  NEXT J
9102  NEXT I
9103  PRINT "FINAL THRESHOLD V5="V5
9104  PRINT 
9105  PRINT "EIGENVALUES"
9106  PRINT 
9107  FOR I=1 TO N
9108  PRINT A[I,I]
9109  NEXT I
9110  PRINT 
9111  PRINT "EIGENVECTORS"
9112  PRINT 
9113  FOR J=1 TO N
9114  FOR I=1 TO N
9115  PRINT U[I,J]
9116  NEXT I
9117  PRINT 
9118  NEXT J
9119  STOP 
9120  PRINT "THIS PROGRAM USES THE JACOBI ATION METHOD TO CALCULATE"
9121  PRINT "THE EIGENVALUES AND EIGENVECTORS OF A REAL SYMMETRIC"
9122  PRINT "MATRIX. TYPE RUN AND WHEN ASKED, SUPPLY THE FOLLOWING"
9123  PRINT "INFORMATION:"
9124  PRINT 
9125  PRINT "  1. REQUIRED ACCURACY OF THE EIGENVALUES."
9126  PRINT "     (NORMALLY 1E-6 FOR THE H-P COMPUTER)"
9127  PRINT 
9128  PRINT "  2. THE ORDER OF THE MATRIX."
9129  PRINT "     (A SINGLE NUMBER SINCE THE MATRIX MUST BE SQUARE)"
9130  PRINT 
9131  PRINT "  3. THE MATRIX ELEMENTS BY ROW."
9132  PRINT "     (START AT ROW 1, COLUMN 1 AND SEPARATE THE ELEMENTS"
9133  PRINT "      BY COMMAS. WHEN YOU REACH THE END OF A TYPED LINE,"
9134  PRINT "      PUSH THE RETURN KEY. THE COMPUTER WILL ADVANCE THE"
9135  PRINT "      PAPER AND PRINT ?? IF MORE DATA IS NEEDED.)"
9136  PRINT 
9137  PRINT 
9138  PRINT "NOW TYPE RUN AGAIN."
9999  END 
