206 lines
6.5 KiB
FortranFixed
206 lines
6.5 KiB
FortranFixed
SUBROUTINE EIGEN (NVEC,NA,N,A,EVR,EVI,VECS,SCR1,SCR2,IERR)
|
|
INTEGER NVEC,NA,N,IERR
|
|
DOUBLE PRECISION A(NA,N),EVR(N),EVI(N),VECS(NA,N),SCR1(N),SCR2(N)
|
|
C
|
|
C ***** PURPOSE:
|
|
C THIS SUBROUTINE COMPUTES THE EIGENVALUES AND EIGENVECTORS
|
|
C (IF DESIRED) OF A REAL GENERAL MATRIX A BY THE DOUBLE FRANCIS
|
|
C QR ALGORITHM AS IMPLEMENTED IN EISPACK.
|
|
C REFERENCE: SMITH, B.T., ET. AL., MATRIX EIGENSYSTEM ROUTINES--
|
|
C EISPACK GUIDE, SECOND EDITION, LECTURE NOTES IN
|
|
C COMPUTER SCIENCE, VOL. 6, SPRINGER-VERLAG, 1976.
|
|
C
|
|
C ON ENTRY:
|
|
C
|
|
C NVEC INTEGER
|
|
C SET = 0 IF NO EIGENVECTORS ARE DESIRED, I.E., TO
|
|
C COMPUTE EIGENVALUES ONLY; OTHERWISE SET TO ANY
|
|
C NONZERO INTEGER IF BOTH EIGENVALUES AND EIGENVECTORS
|
|
C ARE DESIRED.
|
|
C
|
|
C NA INTEGER
|
|
C ROW DIMENSION OF THE ARRAYS CONTAINING A AND VECS
|
|
C AS DECLARED IN THE MAIN CALLING PROGRAM.
|
|
C
|
|
C N INTEGER
|
|
C THE ORDER OF THE MATRIX A.
|
|
C
|
|
C A DOUBLE PRECISION(NA,N)
|
|
C A REAL GENERAL MATRIX WHOSE EIGENVALUES AND EIGEN-
|
|
C VECTORS (IF DESIRED) ARE TO BE COMPUTED.
|
|
C
|
|
C ON RETURN:
|
|
C
|
|
C EVR DOUBLE PRECISION(N)
|
|
C THE REAL PARTS OF THE EIGENVALUES OF A.
|
|
C
|
|
C EVI DOUBLE PRECISION(N)
|
|
C THE CORRESPONDING IMAGINARY PARTS OF THE EIGENVALUES
|
|
C OF A. NOTE THAT COMPLEX CONJUGATE PAIRS OF EIGENVALUES
|
|
C APPEAR CONSECUTIVELY WITH THE EIGENVALUE HAVING THE
|
|
C POSITIVE IMAGINARY PART FIRST.
|
|
C
|
|
C VECS DOUBLE PRECISION(NA,N)
|
|
C IF NVEC IS NONZERO, THIS ARRAY CONTAINS THE REAL AND
|
|
C IMAGINARY PARTS OF THE EIGENVECTORS OF A. IF THE J-TH
|
|
C EIGENVALUE IS REAL, THE J-TH COLUMN OF VECS CONTAINS
|
|
C THE CORRESPONDING EIGENVECTOR (NORMALIZED TO HAVE
|
|
C EUCLIDEAN OR 2- NORM = 1 AND POSITIVE MAXIMUM COMP-
|
|
C ONENT). IF THE J-THE EIGENVALUE IS COMPLEX WITH
|
|
C POSITIVE IMAGINARY PART, THE J-TH AND (J+1)-TH
|
|
C COLUMNS OF VECS CONTAIN THE REAL AND IMAGINARY
|
|
C PARTS OF THE CORRESPONDING COMPLEX EIGENVECTOR
|
|
C (NORMALIZED TO HAVE COMPLEX EUCLIDEAN OR 2- NORM
|
|
C =1 AND REAL, POSITIVE MAXIMUM COMPONENT). THE CONJ-
|
|
C UGATE OF THIS VECTOR IS THE EIGENVECTOR FOR THE
|
|
C CONJUGATE EIGENVALUE.
|
|
C
|
|
C SCR1 DOUBLE PRECISION(N)
|
|
C THE I-TH COMPONENT OF THIS VECTOR CONTAINS THE
|
|
C UNDAMPED NATURAL FREQUENCY (MODULUS) OF THE I-TH
|
|
C EIGENVALUE; SCR1 IS ALSO USED INTERNALLY
|
|
C AS A SCRATCH VECTOR FOR THE EISPACK SUBROUTINE
|
|
C BALANC.
|
|
C
|
|
C SCR2 DOUBLE PRECISION(N)
|
|
C THE I-TH COMPONENT OF THIS VECTOR CONTAINS THE
|
|
C DAMPING RATIO OF THE I-TH EIGENVALUE; SCR2 IS ALSO
|
|
C USED INTERNALLY AS A SCRATCH VECTOR FOR THE
|
|
C EISPACK SUBROUTINE ORTHES.
|
|
C
|
|
C IERR INTEGER
|
|
C ERROR COMPLETION CODE RETURNED BY EISPACK SUBROUTINE
|
|
C HQR OR HQR2. NORMAL RETURN VALUE IS ZERO. SEE THE
|
|
C EISPACK GUIDE, P. 331, FOR A DISCUSSION OF NONZERO
|
|
C VALUES OF IERR.
|
|
C
|
|
C PROGRAM WRITTEN BY ALAN J. LAUB, DEP'T. OF ELEC. AND COMP.ENGRG.,
|
|
C UNIVERSITY OF CALIFORNIA, SANTA BARBARA, CA 93106,
|
|
C PH.: (805) 961-3616.
|
|
C JUNE 1981.
|
|
C MOST RECENT MODIFICATION: JAN. 2, 1985
|
|
C
|
|
C INTERNAL VARIABLES:
|
|
C
|
|
INTEGER I,IGH,J,JM1,K,LOW
|
|
DOUBLE PRECISION ANORM,EI,EPS,EPSP1,ER,T,TIM,TRE,T1,T2
|
|
C
|
|
C FORTRAN FUNCTIONS CALLED:
|
|
C
|
|
DOUBLE PRECISION DABS,DSQRT
|
|
C
|
|
C SUBROUTINES AND FUNCTIONS CALLED:
|
|
C
|
|
C BALANC,BALBAK,HQR,HQR2,ORTHES,ORTRAN (ALL FROM EISPACK)
|
|
C
|
|
C ------------------------------------------------------------------
|
|
C
|
|
C DETERMINE MACHINE PRECISION
|
|
C
|
|
EPS = 1.0D0
|
|
10 CONTINUE
|
|
EPS = EPS/2.0D0
|
|
EPSP1 = EPS+1.0D0
|
|
IF (EPSP1 .GT. 1.0D0) GO TO 10
|
|
EPS = 2.0D0*EPS
|
|
C
|
|
C BALANCE A
|
|
C
|
|
CALL BALANC (NA,N,A,LOW,IGH,SCR1)
|
|
C
|
|
C COMPUTE 1-NORM OF THE BALANCED A
|
|
C
|
|
ANORM = 0.0D0
|
|
DO 30 J = 1,N
|
|
T = 0.0D0
|
|
DO 20 I = 1,N
|
|
T = T+DABS(A(I,J))
|
|
20 CONTINUE
|
|
IF (T .GT. ANORM) ANORM = T
|
|
30 CONTINUE
|
|
C
|
|
C REDUCE A TO UPPER HESSENBERG FORM
|
|
C
|
|
CALL ORTHES (NA,N,LOW,IGH,A,SCR2)
|
|
IF (NVEC .NE. 0) GO TO 40
|
|
C
|
|
C COMPUTE EIGENVALUES USING QR ALGORITHM
|
|
C
|
|
CALL HQR (NA,N,LOW,IGH,A,EVR,EVI,IERR)
|
|
IF (IERR .NE. 0) RETURN
|
|
GO TO 110
|
|
40 CONTINUE
|
|
C
|
|
C COMPUTE EIGENVALUES AND EIGENVECTORS USING QR ALGORITHM
|
|
C
|
|
CALL ORTRAN (NA,N,LOW,IGH,A,SCR2,VECS)
|
|
CALL HQR2 (NA,N,LOW,IGH,A,EVR,EVI,VECS,IERR)
|
|
IF (IERR .NE. 0) RETURN
|
|
CALL BALBAK (NA,N,LOW,IGH,SCR1,N,VECS)
|
|
C
|
|
C NORMALIZE EIGENVECTORS TO HAVE EUCLIDEAN OR 2- NORM EQUAL TO 1
|
|
C
|
|
DO 100 J = 1,N
|
|
IF (EVI(J) .NE. 0.0D0) GO TO 70
|
|
T = 0.0D0
|
|
T1 = 0.0D0
|
|
DO 50 I = 1,N
|
|
T2 = VECS(I,J)**2
|
|
IF (T2 .LE. T1) GO TO 45
|
|
K = I
|
|
T1 = T2
|
|
45 CONTINUE
|
|
T = T+T2
|
|
50 CONTINUE
|
|
T = DSIGN(DSQRT(T),VECS(K,J))
|
|
DO 60 I = 1,N
|
|
VECS(I,J) = VECS(I,J)/T
|
|
60 CONTINUE
|
|
GO TO 100
|
|
70 CONTINUE
|
|
IF (EVI(J) .GT. 0.0D0) GO TO 100
|
|
JM1 = J-1
|
|
T = 0.0D0
|
|
T1 = 0.0D0
|
|
DO 80 I = 1,N
|
|
T2 = VECS(I,JM1)**2 + VECS(I,J)**2
|
|
IF (T2 .LE. T1) GO TO 75
|
|
K = I
|
|
T1 = T2
|
|
75 CONTINUE
|
|
T = T+T2
|
|
80 CONTINUE
|
|
T = DSQRT(T)
|
|
T1 = DSQRT(T1)
|
|
DO 90 I = 1,N
|
|
TRE = VECS(I,JM1)*VECS(K,JM1) + VECS(I,J)*VECS(K,J)
|
|
TIM = VECS(I,J)*VECS(K,JM1) - VECS(I,JM1)*VECS(K,J)
|
|
VECS(I,JM1) = (TRE/T1)/T
|
|
VECS(I,J) = (TIM/T1)/T
|
|
90 CONTINUE
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
C
|
|
C COMPUTE NATURAL FREQUENCIES AND DAMPING RATIOS. SET
|
|
C EIGENVALUES WITH NORM LESS THAN EPS*ANORM TO (0.0D0,0.0D0)
|
|
C
|
|
EPS = EPS*ANORM
|
|
DO 130 I = 1,N
|
|
T = DABS(EVR(I))+DABS(EVI(I))
|
|
IF (T .GT. EPS) GO TO 120
|
|
EVR(I) = 0.0D0
|
|
EVI(I) = 0.0D0
|
|
SCR1(I) = 0.0D0
|
|
SCR2(I) = 1.0D0
|
|
GO TO 130
|
|
120 CONTINUE
|
|
ER = EVR(I)/T
|
|
EI = EVI(I)/T
|
|
SCR1(I) = DSQRT(ER**2 + EI**2)
|
|
SCR2(I) = -ER/SCR1(I)
|
|
SCR1(I) = T*SCR1(I)
|
|
IF (DABS(EVI(I)) .LT. EPS) EVI(I) = 0.0D0
|
|
130 CONTINUE
|
|
RETURN
|
|
END
|