*DECK SGEEV SUBROUTINE SGEEV (A, LDA, N, E, V, LDV, WORK, JOB, INFO) C***BEGIN PROLOGUE SGEEV C***PURPOSE Compute the eigenvalues and, optionally, the eigenvectors C of a real general matrix. C***LIBRARY SLATEC C***CATEGORY D4A2 C***TYPE SINGLE PRECISION (SGEEV-S, CGEEV-C) C***KEYWORDS EIGENVALUES, EIGENVECTORS, GENERAL MATRIX C***AUTHOR Kahaner, D. K., (NBS) C Moler, C. B., (U. of New Mexico) C Stewart, G. W., (U. of Maryland) C***DESCRIPTION C C Abstract C SGEEV computes the eigenvalues and, optionally, C the eigenvectors of a general real matrix. C C Call Sequence Parameters- C (The values of parameters marked with * (star) will be changed C by SGEEV.) C C A* REAL(LDA,N) C real nonsymmetric input matrix. C C LDA INTEGER C set by the user to C the leading dimension of the real array A. C C N INTEGER C set by the user to C the order of the matrices A and V, and C the number of elements in E. C C E* COMPLEX(N) C on return from SGEEV, E contains the eigenvalues of A. C See also INFO below. C C V* COMPLEX(LDV,N) C on return from SGEEV, if the user has set JOB C = 0 V is not referenced. C = nonzero the N eigenvectors of A are stored in the C first N columns of V. See also INFO below. C (Note that if the input matrix A is nearly degenerate, C V may be badly conditioned, i.e., may have nearly C dependent columns.) C C LDV INTEGER C set by the user to C the leading dimension of the array V if JOB is also C set nonzero. In that case, N must be .LE. LDV. C If JOB is set to zero, LDV is not referenced. C C WORK* REAL(2N) C temporary storage vector. Contents changed by SGEEV. C C JOB INTEGER C set by the user to C = 0 eigenvalues only to be calculated by SGEEV. C Neither V nor LDV is referenced. C = nonzero eigenvalues and vectors to be calculated. C In this case, A & V must be distinct arrays. C Also, if LDA .GT. LDV, SGEEV changes all the C elements of A thru column N. If LDA < LDV, C SGEEV changes all the elements of V through C column N. If LDA = LDV, only A(I,J) and V(I, C J) for I,J = 1,...,N are changed by SGEEV. C C INFO* INTEGER C on return from SGEEV the value of INFO is C = 0 normal return, calculation successful. C = K if the eigenvalue iteration fails to converge, C eigenvalues K+1 through N are correct, but C no eigenvectors were computed even if they were C requested (JOB nonzero). C C Error Messages C No. 1 recoverable N is greater than LDA C No. 2 recoverable N is less than one. C No. 3 recoverable JOB is nonzero and N is greater than LDV C No. 4 warning LDA > LDV, elements of A other than the C N by N input elements have been changed. C No. 5 warning LDA < LDV, elements of V other than the C N x N output elements have been changed. C C***REFERENCES (NONE) C***ROUTINES CALLED BALANC, BALBAK, HQR, HQR2, ORTHES, ORTRAN, SCOPY, C SCOPYM, XERMSG C***REVISION HISTORY (YYMMDD) C 800808 DATE WRITTEN C 890531 Changed all specific intrinsics to generic. (WRB) C 890531 REVISION DATE from Version 3.2 C 891214 Prologue converted to Version 4.0 format. (BAB) C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) C 900326 Removed duplicate information from DESCRIPTION section. C (WRB) C***END PROLOGUE SGEEV INTEGER I,IHI,ILO,INFO,J,JB,JOB,K,KM,KP,L,LDA,LDV, 1 MDIM,N REAL A(*),E(*),WORK(*),V(*) C***FIRST EXECUTABLE STATEMENT SGEEV IF (N .GT. LDA) CALL XERMSG ('SLATEC', 'SGEEV', 'N .GT. LDA.', 1, + 1) IF (N .GT. LDA) RETURN IF (N .LT. 1) CALL XERMSG ('SLATEC', 'SGEEV', 'N .LT. 1', 2, 1) IF(N .LT. 1) RETURN IF(N .EQ. 1 .AND. JOB .EQ. 0) GO TO 35 MDIM = LDA IF(JOB .EQ. 0) GO TO 5 IF (N .GT. LDV) CALL XERMSG ('SLATEC', 'SGEEV', + 'JOB .NE. 0 AND N .GT. LDV.', 3, 1) IF(N .GT. LDV) RETURN IF(N .EQ. 1) GO TO 35 C C REARRANGE A IF NECESSARY WHEN LDA.GT.LDV AND JOB .NE.0 C MDIM = MIN(LDA,LDV) IF (LDA .LT. LDV) CALL XERMSG ('SLATEC', 'SGEEV', + 'LDA.LT.LDV, ELEMENTS OF V OTHER THAN THE N BY N OUTPUT ' // + 'ELEMENTS HAVE BEEN CHANGED.', 5, 0) IF(LDA.LE.LDV) GO TO 5 CALL XERMSG ('SLATEC', 'SGEEV', + 'LDA.GT.LDV, ELEMENTS OF A OTHER THAN THE N BY N INPUT ' // + 'ELEMENTS HAVE BEEN CHANGED.', 4, 0) L = N - 1 DO 4 J=1,L M = 1+J*LDV K = 1+J*LDA CALL SCOPY(N,A(K),1,A(M),1) 4 CONTINUE 5 CONTINUE C C SCALE AND ORTHOGONAL REDUCTION TO HESSENBERG. C CALL BALANC(MDIM,N,A,ILO,IHI,WORK(1)) CALL ORTHES(MDIM,N,ILO,IHI,A,WORK(N+1)) IF(JOB .NE. 0) GO TO 10 C C EIGENVALUES ONLY C CALL HQR(LDA,N,ILO,IHI,A,E(1),E(N+1),INFO) GO TO 30 C C EIGENVALUES AND EIGENVECTORS. C 10 CALL ORTRAN(MDIM,N,ILO,IHI,A,WORK(N+1),V) CALL HQR2(MDIM,N,ILO,IHI,A,E(1),E(N+1),V,INFO) IF (INFO .NE. 0) GO TO 30 CALL BALBAK(MDIM,N,ILO,IHI,WORK(1),N,V) C C CONVERT EIGENVECTORS TO COMPLEX STORAGE. C DO 20 JB = 1,N J=N+1-JB I=N+J K=(J-1)*MDIM+1 KP=K+MDIM KM=K-MDIM IF(E(I).GE.0.0E0) CALL SCOPY(N,V(K),1,WORK(1),2) IF(E(I).LT.0.0E0) CALL SCOPY(N,V(KM),1,WORK(1),2) IF(E(I).EQ.0.0E0) CALL SCOPY(N,0.0E0,0,WORK(2),2) IF(E(I).GT.0.0E0) CALL SCOPY(N,V(KP),1,WORK(2),2) IF(E(I).LT.0.0E0) CALL SCOPYM(N,V(K),1,WORK(2),2) L=2*(J-1)*LDV+1 CALL SCOPY(2*N,WORK(1),1,V(L),1) 20 CONTINUE C C CONVERT EIGENVALUES TO COMPLEX STORAGE. C 30 CALL SCOPY(N,E(1),1,WORK(1),1) CALL SCOPY(N,E(N+1),1,E(2),2) CALL SCOPY(N,WORK(1),1,E(1),2) RETURN C C TAKE CARE OF N=1 CASE C 35 E(1) = A(1) E(2) = 0.E0 INFO = 0 IF(JOB .EQ. 0) RETURN V(1) = A(1) V(2) = 0.E0 RETURN END