New changes from l2g
w
This commit is contained in:
@@ -0,0 +1,205 @@
|
||||
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
|
||||
Reference in New Issue
Block a user