Program f02sdfe

!     F02SDF Example Program Text

!     Mark 26.2 Release. NAG Copyright 2017.

!     .. 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) Then
              Go To 100
            End If
            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