Program f08mbfe
! F08MBF Example Program Text
! Mark 29.2 Release. NAG Copyright 2023.
! .. 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