計算ルーチン: 実一般行列から縮約された実準対角行列の特異値分解

DBDSQR Example Program Data
  4                           :Value of N
  3.62  -2.41   1.92  -1.43
  1.26  -1.53   1.19          :End of matrix B
  'U'                         :Value of UPLO

 DBDSQR Example Program Results

 Singular values
     4.0001  3.0006  1.9960  0.9998

 Right singular vectors, by row
          1       2       3       4
 1   0.8261  0.5246  0.2024  0.0369
 2   0.4512 -0.4056 -0.7350 -0.3030
 3   0.2823 -0.5644  0.1731  0.7561
 4   0.1852 -0.4916  0.6236 -0.5789

 Left singular vectors, by column
          1       2       3       4
 1   0.9129  0.3740  0.1556  0.0512
 2  -0.3935  0.7005  0.5489  0.2307
 3   0.1081 -0.5904  0.6173  0.5086
 4  -0.0132  0.1444 -0.5417  0.8280

    Program dbdsqr_example

!     DBDSQR Example Program Text

!     Copyright 2017, Numerical Algorithms Group Ltd. http://www.nag.com

!     .. Use Statements ..
      Use lapack_example_aux, Only: nagf_file_print_matrix_real_gen
      Use lapack_interfaces, Only: dbdsqr, dlaset
      Use lapack_precision, Only: dp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Real (Kind=dp), Parameter :: one = 1.0_dp
      Real (Kind=dp), Parameter :: zero = 0.0_dp
      Integer, Parameter :: nin = 5, nout = 6
!     .. Local Scalars ..
      Integer :: ifail, info, ldc, ldu, ldvt, n
      Character (1) :: uplo
!     .. Local Arrays ..
      Real (Kind=dp), Allocatable :: c(:, :), d(:), e(:), u(:, :), vt(:, :), &
        work(:)
!     .. Executable Statements ..
      Write (nout, *) 'DBDSQR Example Program Results'
!     Skip heading in data file
      Read (nin, *)
      Read (nin, *) n
      ldc = 1
      ldu = n
      ldvt = n
      Allocate (c(ldc,1), d(n), e(n-1), u(ldu,n), vt(ldvt,n), work(4*n))

!     Read B from data file

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

      Read (nin, *) uplo

!     Initialize U and VT to be the unit matrix
      Call dlaset('General', n, n, zero, one, u, ldu)
      Call dlaset('General', n, n, zero, one, vt, ldvt)

!     Calculate the SVD of B
      Call dbdsqr(uplo, n, n, n, 0, d, e, vt, ldvt, u, ldu, c, ldc, work, &
        info)

      Write (nout, *)
      If (info>0) Then
        Write (nout, *) 'Failure to converge.'
      Else

!       Print singular values, left & right singular vectors

        Write (nout, *) 'Singular values'
        Write (nout, 100) d(1:n)
        Write (nout, *)
        Flush (nout)

!       ifail: behaviour on error exit
!              =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
        ifail = 0
        Call nagf_file_print_matrix_real_gen('General', ' ', n, n, vt, ldvt, &
          'Right singular vectors, by row', ifail)

        Write (nout, *)
        Flush (nout)

        ifail = 0
        Call nagf_file_print_matrix_real_gen('General', ' ', n, n, u, ldu, &
          'Left singular vectors, by column', ifail)

      End If

100   Format (3X, (8F8.4))
    End Program