Program f08ygfe ! F08YGF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: dtgsen, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: pl, pr Integer :: i, ijob, info, lda, ldb, ldc, ldq, & ldz, liwork, lwork, m, n Logical :: wantq, wantz ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:,:), alphai(:), alphar(:), & b(:,:), beta(:), c(:,:), q(:,:), & work(:), z(:,:) Real (Kind=nag_wp) :: dif(2) Integer, Allocatable :: iwork(:) Logical, Allocatable :: select(:) ! .. Executable Statements .. Write (nout,*) 'F08YGF Example Program Results' Write (nout,*) Flush (nout) ! Skip heading in data file Read (nin,*) Read (nin,*) n lda = n ldb = n ldc = n ldq = n ldz = n liwork = (n*n)/2 + 6 lwork = n*(n+4) + 16 Allocate (a(lda,n),alphai(n),alphar(n),b(ldb,n),beta(n),c(ldc,n), & q(ldq,n),work(lwork),z(ldz,n),iwork(liwork),select(n)) ! Read A, B, Q, Z and the logical array SELECT from data file Read (nin,*)(a(i,1:n),i=1,n) Read (nin,*)(b(i,1:n),i=1,n) Read (nin,*)(q(i,1:n),i=1,n) Read (nin,*)(z(i,1:n),i=1,n) Read (nin,*) select(1:n) ! Set ijob, wantq and wantz ijob = 4 wantq = .True. wantz = .True. ! Reorder the Schur factors A and B and update the matrices ! Q and Z ! The NAG name equivalent of dtgsen is f08ygf Call dtgsen(ijob,wantq,wantz,select,n,a,lda,b,ldb,alphar,alphai,beta,q, & ldq,z,ldz,m,pl,pr,dif,work,lwork,iwork,liwork,info) If (info>0) Then Write (nout,99999) info Write (nout,*) Flush (nout) End If ! Print Results Write (nout,99996) 'Number of selected eigenvalues = ', m Write (nout,*) Write (nout,*) 'Selected Generalized Eigenvalues' Write (nout,*) Write (nout,99997)(i,alphar(i)/beta(i),alphai(i)/beta(i),i=1,m) Write (nout,*) Write (nout,99998) 'Norm estimate of projection onto', & ' left eigenspace for selected cluster', 1.0_nag_wp/pl Write (nout,*) Write (nout,99998) 'Norm estimate of projection onto', & ' right eigenspace for selected cluster', 1.0_nag_wp/pr Write (nout,*) Write (nout,99998) 'F-norm based upper bound on', ' Difu', dif(1) Write (nout,*) Write (nout,99998) 'F-norm based upper bound on', ' Difl', dif(2) 99999 Format (' Reordering could not be completed. INFO = ',I3) 99998 Format (1X,2A/1X,1P,E10.2) 99997 Format (1X,I2,1X,'(',1P,E11.4,',',E11.4,')') 99996 Format (1X,A,I4) End Program f08ygfe