Program f08ylfe ! F08YLF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: dtgevc, dtgsna, f06bnf, f06raf, nag_wp, x02ajf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: eps, snorm, stnrm, tnorm Integer :: i, info, lda, ldb, ldvl, ldvr, & lwork, m, n ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:,:), b(:,:), dif(:), s(:), & vl(:,:), vr(:,:), work(:) Integer, Allocatable :: iwork(:) Logical :: select(1) ! .. Executable Statements .. Write (nout,*) 'F08YLF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) Read (nin,*) n lda = n ldb = n ldvl = n ldvr = n lwork = 2*n*(n+2) + 16 Allocate (a(lda,n),b(ldb,n),dif(n),s(n),vl(ldvl,n),vr(ldvr,n), & work(lwork),iwork(n+6)) ! Read A and B from data file Read (nin,*)(a(i,1:n),i=1,n) Read (nin,*)(b(i,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. ! The NAG name equivalent of dtgevc is f08ykf Call dtgevc('Both','All',select,n,a,lda,b,ldb,vl,ldvl,vr,ldvr,n,m,work, & info) If (info>0) Then Write (nout,99999) info, info + 1 Else ! Estimate condition numbers for all the generalized eigenvalues ! and right eigenvectors of the pair (A,B) ! The NAG name equivalent of dtgsna is f08ylf 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(1:m) Write (nout,*) Write (nout,*) 'DIF' Write (nout,99998) dif(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) End If 99999 Format (' The 2-by-2 block (',I5,':',I5,') does not have a co', & 'mplex eigenvalue') 99998 Format ((3X,1P,7E11.1)) End Program f08ylfe