NAG Library Manual, Mark 30.2
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
    Program f08mbfe

!     F08MBF Example Program Text

!     Mark 30.2 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: dbdsvdx, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: vl, vu
      Integer                          :: il, info, iu, ldz, n, ns
      Character (1)                    :: range
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: d(:), e(:), s(:), work(:), z(:,:)
      Integer, Allocatable             :: iwork(:)
!     .. Executable Statements ..
      Write (nout,*) 'F08MBF Example Program Results'
      Write (nout,*)
      Flush (nout)
!     Skip heading in data file
      Read (nin,*)
      Read (nin,*) n
      ldz = 2*n
      Allocate (d(n),e(n-1),s(n),z(ldz,n+1),work(14*n),iwork(12*n))

!     Read the bidiagonal matrix B from data file, first
!     the diagonal elements, and then the off diagonal elements

      Read (nin,*) d(1:n)
      Read (nin,*) e(1:n-1)

!     Read range for selected singular values
      Read (nin,*) range

      If (range=='I' .Or. range=='i') Then
        Read (nin,*) il, iu
      Else If (range=='V' .Or. range=='v') Then
        Read (nin,*) vl, vu
      End If

!     Calculate the singular values and singular vectors of B.

!     The NAG name equivalent of dbdsvdx is f08mbf
      Call dbdsvdx('Upper','V',range,n,d,e,vl,vu,il,iu,ns,s,z,ldz,work,iwork,  &
        info)

      If (info==0) Then
!       Print the singular values of B.

        If (range=='I' .Or. range=='i') Then
          Write (nout,99999) ns, il, iu
        Else If (range=='V' .Or. range=='v') Then
          Write (nout,99998) ns, vl, vu
        End If
        Write (nout,99997) s(1:ns)
      Else
        Write (nout,99996) '** F08MBF/DBDSVDX failed with INFO = ', info
      End If

99999 Format (1X,I2,1X,'singular values of B in the index range [',I2,',',I2,  &
        ']:')
99998 Format (1X,I2,1X,'singular values of B in the range (',F7.3,',',F7.3,    &
        ']:')
99997 Format (1X,4(3X,F11.4))
99996 Format (1X,A,I10)
    End Program f08mbfe