PROGRAM f08mdfe ! F08MDF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : dbdsdc, nag_wp, x04caf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Scalars .. INTEGER :: ifail, info, ldu, ldvt, n ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: d(:), e(:), u(:,:), vt(:,:), work(:) REAL (KIND=nag_wp) :: q(1) INTEGER :: iq(1) INTEGER, ALLOCATABLE :: iwork(:) ! .. Executable Statements .. WRITE (nout,*) 'F08MDF Example Program Results' WRITE (nout,*) FLUSH (nout) ! Skip heading in data file READ (nin,*) READ (nin,*) n ldu = n ldvt = n ALLOCATE (d(n),e(n-1),u(ldu,n),vt(ldvt,n),work(n*(3*n+4)),iwork(8*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) ! Calculate the singular values and left and right singular ! vectors of B. ! The NAG name equivalent of dbdsdc is f08mdf CALL dbdsdc('Upper','I',n,d,e,u,ldu,vt,ldvt,q,iq,work,iwork,info) IF (info==0) THEN ! Print singular values and vectors ! ifail: behaviour on error exit ! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft ifail = 0 CALL x04caf('General',' ',n,n,u,ldu, & 'Left singular vectors, by column',ifail) WRITE (nout,*) WRITE (nout,*) 'Singular values' WRITE (nout,99999) d(1:n) WRITE (nout,*) FLUSH (nout) ifail = 0 CALL x04caf('General',' ',n,n,vt,ldvt, & 'Right singular vectors, by row',ifail) ELSE WRITE (nout,99998) 'Failure to compute a singular value, INFO = ', & info END IF 99999 FORMAT ((3X,8F8.4)) 99998 FORMAT (1X,A,I10) END PROGRAM f08mdfe