Program f08yyfe ! F08YYF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: f06bnf, f06uaf, nag_wp, x02ajf, ztgevc, ztgsna ! .. 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 .. Complex (Kind=nag_wp), Allocatable :: a(:,:), b(:,:), vl(:,:), vr(:,:), & work(:) Real (Kind=nag_wp), Allocatable :: dif(:), rwork(:), s(:) Integer, Allocatable :: iwork(:) Logical :: select(1) ! .. Executable Statements .. Write (nout,*) 'F08YYF 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 Allocate (a(lda,n),b(ldb,n),vl(ldvl,n),vr(ldvr,n),work(lwork),dif(n), & rwork(2*n),s(n),iwork(n+2)) ! 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). ! The NAG name equivalent of ztgevc is f08yxf Call ztgevc('Both','All',select,n,a,lda,b,ldb,vl,ldvl,vr,ldvr,n,m,work, & rwork,info) ! Estimate condition numbers for all the generalized eigenvalues ! and right eigenvectors of the pair (A,B) ! The NAG name equivalent of ztgsna is f08yyf Call ztgsna('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,99999) s(1:m) Write (nout,*) Write (nout,*) 'DIF' Write (nout,99999) 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 = f06uaf('1-norm',n,n,a,lda,rwork) tnorm = f06uaf('1-norm',n,n,b,ldb,rwork) stnrm = f06bnf(snorm,tnorm) Write (nout,*) Write (nout,*) 'Approximate error estimates for eigenvalues of (A,B)' Write (nout,99999)(eps*stnrm/s(i),i=1,m) Write (nout,*) Write (nout,*) & 'Approximate error estimates for right eigenvectors of (A,B)' Write (nout,99999)(eps*stnrm/dif(i),i=1,m) 99999 Format ((3X,1P,7E11.1)) End Program f08yyfe