Program f02sdfe ! F02SDF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: f02sdf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: relep, rmu Integer :: i, ifail, j, k, k1, k2, lda, ldb, & lwork, ma, mb, n Logical :: sym ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:,:), b(:,:), vec(:), work(:) Real (Kind=nag_wp) :: d(30) Integer, Allocatable :: iwork(:) ! .. Intrinsic Procedures .. Intrinsic :: min ! .. Executable Statements .. Write (nout,*) 'F02SDF Example Program Results' ! Skip heading in data file Read (nin,*) Read (nin,*) n, ma, mb lda = 2*ma + 1 ldb = 2*mb + 1 lwork = n*(ma+2) Allocate (a(lda,n),b(ldb,n),vec(n),work(lwork),iwork(n)) Do i = 1, n k1 = ma + 1 - min(ma,i-1) k2 = ma + 1 + min(ma,n-i) Read (nin,*)(a(k,i),k=k1,k2) End Do Do i = 1, n k1 = mb + 1 - min(mb,i-1) k2 = mb + 1 + min(mb,n-i) Read (nin,*)(b(k,i),k=k1,k2) End Do Read (nin,*) rmu, d(1) sym = .False. relep = 0.0E0_nag_wp ! ifail: behaviour on error exit ! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft ifail = 1 Call f02sdf(n,ma+1,mb+1,a,lda,b,ldb,sym,relep,rmu,vec,d,iwork,work, & lwork,ifail) Write (nout,*) If (ifail==0) Then Write (nout,99999) 'Corrected eigenvalue = ', rmu + d(30) Write (nout,*) Write (nout,*) 'Eigenvector is' Write (nout,99998) vec(1:n) Else If (ifail>0) Then Write (nout,99997) 'Error in F02SDF. IFAIL =', ifail If (ifail==7 .Or. ifail==9) Then Write (nout,*) Write (nout,*) 'Successive corrections to RMU were' Write (nout,*) Do j = 1, 29 If (d(j)==0.0E0_nag_wp) Go To 100 Write (nout,99996) d(j) End Do End If Else Write (nout,99995) ifail End If 100 Continue 99999 Format (1X,A,F8.4) 99998 Format (1X,5F9.4) 99997 Format (1X,A,I5) 99996 Format (1X,E20.4) 99995 Format (1X,' ** F02SDF returned with IFAIL = ',I5) End Program f02sdfe