* F08NAF Example Program Text * Mark 21. NAG Copyright 2004 * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER NB, NMAX PARAMETER (NB=64,NMAX=10) INTEGER LDA, LDVR, LWORK PARAMETER (LDA=NMAX,LDVR=NMAX,LWORK=(2+NB)*NMAX) * .. Local Scalars .. COMPLEX *16 EIG INTEGER I, INFO, J, LWKOPT, N * .. Local Arrays .. DOUBLE PRECISION A(LDA,NMAX), DUMMY(1,1), VR(LDVR,NMAX), WI(NMAX), + WORK(LWORK), WR(NMAX) * .. External Subroutines .. EXTERNAL DGEEV * .. Intrinsic Functions .. INTRINSIC DCMPLX * .. Executable Statements .. WRITE (NOUT,*) 'F08NAF Example Program Results' * Skip heading in data file READ (NIN,*) READ (NIN,*) N IF (N.LE.NMAX) THEN * * Read the matrix A from data file * READ (NIN,*) ((A(I,J),J=1,N),I=1,N) * * Compute the eigenvalues and right eigenvectors of A * CALL DGEEV('No left vectors','Vectors (right)',N,A,LDA,WR,WI, + DUMMY,1,VR,LDVR,WORK,LWORK,INFO) LWKOPT = WORK(1) * IF (INFO.EQ.0) THEN * * Print solution * DO 20 J = 1, N WRITE (NOUT,*) IF (WI(J).EQ.0.0D0) THEN WRITE (NOUT,99999) 'Eigenvalue(', J, ') = ', WR(J) ELSE EIG = DCMPLX(WR(J),WI(J)) WRITE (NOUT,99998) 'Eigenvalue(', J, ') = ', EIG END IF WRITE (NOUT,*) WRITE (NOUT,99997) 'Eigenvector(', J, ')' IF (WI(J).EQ.0.0D0) THEN WRITE (NOUT,99996) (VR(I,J),I=1,N) ELSE IF (WI(J).GT.0.0D0) THEN WRITE (NOUT,99995) (VR(I,J),VR(I,J+1),I=1,N) ELSE WRITE (NOUT,99995) (VR(I,J-1),-VR(I,J),I=1,N) END IF 20 CONTINUE ELSE WRITE (NOUT,*) WRITE (NOUT,99994) 'Failure in DGEEV. INFO = ', INFO END IF * * Print workspace information * IF (LWORK.LT.LWKOPT) THEN WRITE (NOUT,*) WRITE (NOUT,99993) 'Optimum workspace required = ', LWKOPT, + 'Workspace provided = ', LWORK END IF ELSE WRITE (NOUT,*) WRITE (NOUT,*) 'NMAX too small' END IF STOP * 99999 FORMAT (1X,A,I2,A,1P,E11.4) 99998 FORMAT (1X,A,I2,A,'(',1P,E11.4,',',1P,E11.4,')') 99997 FORMAT (1X,A,I2,A) 99996 FORMAT (1X,1P,E11.4) 99995 FORMAT (1X,'(',1P,E11.4,',',1P,E11.4,')') 99994 FORMAT (1X,A,I4) 99993 FORMAT (1X,A,I5,/1X,A,I5) END