* F08YLF Example Program Text * Mark 21 Release. NAG Copyright 2004. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER NMAX PARAMETER (NMAX=8) INTEGER LDA, LDB, LDVL, LDVR, LWORK PARAMETER (LDA=NMAX,LDB=NMAX,LDVL=NMAX,LDVR=NMAX, + LWORK=2*NMAX*(NMAX+2)+16) * .. Local Scalars .. DOUBLE PRECISION EPS, SNORM, STNRM, TNORM INTEGER I, INFO, J, M, N * .. Local Arrays .. DOUBLE PRECISION A(LDA,NMAX), B(LDB,NMAX), DIF(NMAX), S(NMAX), + VL(LDVL,NMAX), VR(LDVR,NMAX), WORK(LWORK) INTEGER IWORK(NMAX+6) LOGICAL SELECT(1) * .. External Functions .. DOUBLE PRECISION F06BNF, F06RAF, X02AJF EXTERNAL F06BNF, F06RAF, X02AJF * .. External Subroutines .. EXTERNAL DTGEVC, DTGSNA * .. Executable Statements .. WRITE (NOUT,*) 'F08YLF Example Program Results' WRITE (NOUT,*) * Skip heading in data file READ (NIN,*) READ (NIN,*) N IF (N.LE.NMAX) THEN * * Read A and B from data file * READ (NIN,*) ((A(I,J),J=1,N),I=1,N) READ (NIN,*) ((B(I,J),J=1,N),I=1,N) * * Calculate the left and right generalized eigenvectors of the * pair (A,B). Note that DTGEVC requires WORK to be of dimension * at least 6*N, and LWORK is always greater than 6*NMAX. * CALL DTGEVC('Both','All',SELECT,N,A,LDA,B,LDB,VL,LDVL,VR,LDVR, + N,M,WORK,INFO) IF (INFO.GT.0) THEN WRITE (NOUT,99999) INFO, INFO + 1 GO TO 20 END IF * * Estimate condition numbers for all the generalized eigenvalues * and right eigenvectors of the pair (A,B) * CALL DTGSNA('Both','All',SELECT,N,A,LDA,B,LDB,VL,LDVL,VR,LDVR, + S,DIF,N,M,WORK,LWORK,IWORK,INFO) * * Print condition numbers of eigenvalues and right eigenvectors * WRITE (NOUT,*) 'S' WRITE (NOUT,99998) (S(I),I=1,M) WRITE (NOUT,*) WRITE (NOUT,*) 'DIF' WRITE (NOUT,99998) (DIF(I),I=1,M) * * Calculate approximate error estimates * * Compute the 1-norms of A and B and then compute * SQRT(SNORM**2 + TNORM**2) * EPS = X02AJF() SNORM = F06RAF('1-norm',N,N,A,LDA,WORK) TNORM = F06RAF('1-norm',N,N,B,LDB,WORK) STNRM = F06BNF(SNORM,TNORM) WRITE (NOUT,*) WRITE (NOUT,*) + 'Approximate error estimates for eigenvalues of (A,B)' WRITE (NOUT,99998) (EPS*STNRM/S(I),I=1,M) WRITE (NOUT,*) WRITE (NOUT,*) 'Approximate error estimates for right ', + 'eigenvectors of (A,B)' WRITE (NOUT,99998) (EPS*STNRM/DIF(I),I=1,M) ELSE WRITE (NOUT,*) 'NMAX too small' END IF 20 CONTINUE * 99999 FORMAT (' The 2-by-2 block (',I5,':',I5,') does not have a',' co', + 'mplex eigenvalue') 99998 FORMAT ((3X,1P,7E11.1)) END