Program f08xnfe ! F08XNF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: f08xnz, nag_wp, x02amf, zgges ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nb = 64, nin = 5, nout = 6 ! .. Local Scalars .. Complex (Kind=nag_wp) :: eig Real (Kind=nag_wp) :: small Integer :: i, info, j, lda, ldb, ldc, ldvsl, & ldvsr, lwork, n, sdim ! .. Local Arrays .. Complex (Kind=nag_wp), Allocatable :: a(:,:), alpha(:), b(:,:), beta(:), & c(:,:), vsl(:,:), vsr(:,:), work(:) Complex (Kind=nag_wp) :: dummy(1) Real (Kind=nag_wp), Allocatable :: rwork(:) Logical, Allocatable :: bwork(:) ! .. Intrinsic Procedures .. Intrinsic :: abs, max, nint, real ! .. Executable Statements .. Write (nout,*) 'F08XNF Example Program Results' Write (nout,*) Flush (nout) ! Skip heading in data file Read (nin,*) Read (nin,*) n lda = n ldb = n ldc = n ldvsl = n ldvsr = n Allocate (a(lda,n),alpha(n),b(ldb,n),beta(n),c(ldc,n),vsl(ldvsl,n), & vsr(ldvsr,n),rwork(8*n),bwork(n)) ! Use routine workspace query to get optimal workspace. lwork = -1 ! The NAG name equivalent of zgges is f08xnf Call zgges('Vectors (left)','Vectors (right)','No sort',f08xnz,n,a,lda, & b,ldb,sdim,alpha,beta,vsl,ldvsl,vsr,ldvsr,dummy,lwork,rwork,bwork, & info) ! Make sure that there is enough workspace for blocksize nb. lwork = max((nb+1)*n,nint(real(dummy(1)))) Allocate (work(lwork)) ! Read in the matrices A and B Read (nin,*)(a(i,1:n),i=1,n) Read (nin,*)(b(i,1:n),i=1,n) ! Find the generalized Schur form ! The NAG name equivalent of zgges is f08xnf Call zgges('Vectors (left)','Vectors (right)','No sort',f08xnz,n,a,lda, & b,ldb,sdim,alpha,beta,vsl,ldvsl,vsr,ldvsr,work,lwork,rwork,bwork,info) If (info>0) Then Write (nout,99999) 'Failure in ZGGES. INFO =', info Else small = x02amf() Write (nout,*) 'Generalized Eigenvalues' Write (nout,*) Do j = 1, n ! Print out information on the jth eigenvalue If ((abs(a(j,j)))*small>=abs(b(j,j))) Then Write (nout,99997) j Else eig = a(j,j)/b(j,j) Write (nout,99998) j, eig End If End Do End If 99999 Format (1X,A,I4) 99998 Format (1X,I2,1X,'(',1P,E11.4,',',E11.4,')') 99997 Format (1X,I2,1X,' Infinite or undetermined') End Program f08xnfe