PROGRAM f08ylfe

!      F08YLF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. 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