d7/dd1/slasdq_8f_source.html

 *> \brief \b SLASDQ computes the SVD of a real bidiagonal matrix with diagonal d and off-diagonal e. Used by sbdsdc.
 *
 *  =========== DOCUMENTATION ===========
 *
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
 *> \htmlonly
 *> Download SLASDQ + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasdq.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasdq.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasdq.f">
 *> [TXT]</a>
 *> \endhtmlonly
 *
 *  Definition:
 *  ===========
 *
 *       SUBROUTINE SLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT,
 *                          U, LDU, C, LDC, WORK, INFO )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
 *       INTEGER            INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU, SQRE
 *       ..
 *       .. Array Arguments ..
 *       REAL               C( LDC, * ), D( * ), E( * ), U( LDU, * ),
 *      $                   VT( LDVT, * ), WORK( * )
 *       ..
 *
 *
 *> \par Purpose:
 *  =============
 *>
 *> \verbatim
 *>
 *> SLASDQ computes the singular value decomposition (SVD) of a real
 *> (upper or lower) bidiagonal matrix with diagonal D and offdiagonal
 *> E, accumulating the transformations if desired. Letting B denote
 *> the input bidiagonal matrix, the algorithm computes orthogonal
 *> matrices Q and P such that B = Q * S * P**T (P**T denotes the transpose
 *> of P). The singular values S are overwritten on D.
 *>
 *> The input matrix U  is changed to U  * Q  if desired.
 *> The input matrix VT is changed to P**T * VT if desired.
 *> The input matrix C  is changed to Q**T * C  if desired.
 *>
 *> See "Computing  Small Singular Values of Bidiagonal Matrices With
 *> Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
 *> LAPACK Working Note #3, for a detailed description of the algorithm.
 *> \endverbatim
 *
 *  Arguments:
 *  ==========
 *
 *> \param[in] UPLO
 *> \verbatim
 *>          UPLO is CHARACTER*1
 *>        On entry, UPLO specifies whether the input bidiagonal matrix
 *>        is upper or lower bidiagonal, and whether it is square are
 *>        not.
 *>           UPLO = 'U' or 'u'   B is upper bidiagonal.
 *>           UPLO = 'L' or 'l'   B is lower bidiagonal.
 *> \endverbatim
 *>
 *> \param[in] SQRE
 *> \verbatim
 *>          SQRE is INTEGER
 *>        = 0: then the input matrix is N-by-N.
 *>        = 1: then the input matrix is N-by-(N+1) if UPLU = 'U' and
 *>             (N+1)-by-N if UPLU = 'L'.
 *>
 *>        The bidiagonal matrix has
 *>        N = NL + NR + 1 rows and
 *>        M = N + SQRE >= N columns.
 *> \endverbatim
 *>
 *> \param[in] N
 *> \verbatim
 *>          N is INTEGER
 *>        On entry, N specifies the number of rows and columns
 *>        in the matrix. N must be at least 0.
 *> \endverbatim
 *>
 *> \param[in] NCVT
 *> \verbatim
 *>          NCVT is INTEGER
 *>        On entry, NCVT specifies the number of columns of
 *>        the matrix VT. NCVT must be at least 0.
 *> \endverbatim
 *>
 *> \param[in] NRU
 *> \verbatim
 *>          NRU is INTEGER
 *>        On entry, NRU specifies the number of rows of
 *>        the matrix U. NRU must be at least 0.
 *> \endverbatim
 *>
 *> \param[in] NCC
 *> \verbatim
 *>          NCC is INTEGER
 *>        On entry, NCC specifies the number of columns of
 *>        the matrix C. NCC must be at least 0.
 *> \endverbatim
 *>
 *> \param[in,out] D
 *> \verbatim
 *>          D is REAL array, dimension (N)
 *>        On entry, D contains the diagonal entries of the
 *>        bidiagonal matrix whose SVD is desired. On normal exit,
 *>        D contains the singular values in ascending order.
 *> \endverbatim
 *>
 *> \param[in,out] E
 *> \verbatim
 *>          E is REAL array.
 *>        dimension is (N-1) if SQRE = 0 and N if SQRE = 1.
 *>        On entry, the entries of E contain the offdiagonal entries
 *>        of the bidiagonal matrix whose SVD is desired. On normal
 *>        exit, E will contain 0. If the algorithm does not converge,
 *>        D and E will contain the diagonal and superdiagonal entries
 *>        of a bidiagonal matrix orthogonally equivalent to the one
 *>        given as input.
 *> \endverbatim
 *>
 *> \param[in,out] VT
 *> \verbatim
 *>          VT is REAL array, dimension (LDVT, NCVT)
 *>        On entry, contains a matrix which on exit has been
 *>        premultiplied by P**T, dimension N-by-NCVT if SQRE = 0
 *>        and (N+1)-by-NCVT if SQRE = 1 (not referenced if NCVT=0).
 *> \endverbatim
 *>
 *> \param[in] LDVT
 *> \verbatim
 *>          LDVT is INTEGER
 *>        On entry, LDVT specifies the leading dimension of VT as
 *>        declared in the calling (sub) program. LDVT must be at
 *>        least 1. If NCVT is nonzero LDVT must also be at least N.
 *> \endverbatim
 *>
 *> \param[in,out] U
 *> \verbatim
 *>          U is REAL array, dimension (LDU, N)
 *>        On entry, contains a  matrix which on exit has been
 *>        postmultiplied by Q, dimension NRU-by-N if SQRE = 0
 *>        and NRU-by-(N+1) if SQRE = 1 (not referenced if NRU=0).
 *> \endverbatim
 *>
 *> \param[in] LDU
 *> \verbatim
 *>          LDU is INTEGER
 *>        On entry, LDU  specifies the leading dimension of U as
 *>        declared in the calling (sub) program. LDU must be at
 *>        least max( 1, NRU ) .
 *> \endverbatim
 *>
 *> \param[in,out] C
 *> \verbatim
 *>          C is REAL array, dimension (LDC, NCC)
 *>        On entry, contains an N-by-NCC matrix which on exit
 *>        has been premultiplied by Q**T  dimension N-by-NCC if SQRE = 0
 *>        and (N+1)-by-NCC if SQRE = 1 (not referenced if NCC=0).
 *> \endverbatim
 *>
 *> \param[in] LDC
 *> \verbatim
 *>          LDC is INTEGER
 *>        On entry, LDC  specifies the leading dimension of C as
 *>        declared in the calling (sub) program. LDC must be at
 *>        least 1. If NCC is nonzero, LDC must also be at least N.
 *> \endverbatim
 *>
 *> \param[out] WORK
 *> \verbatim
 *>          WORK is REAL array, dimension (4*N)
 *>        Workspace. Only referenced if one of NCVT, NRU, or NCC is
 *>        nonzero, and if N is at least 2.
 *> \endverbatim
 *>
 *> \param[out] INFO
 *> \verbatim
 *>          INFO is INTEGER
 *>        On exit, a value of 0 indicates a successful exit.
 *>        If INFO < 0, argument number -INFO is illegal.
 *>        If INFO > 0, the algorithm did not converge, and INFO
 *>        specifies how many superdiagonals did not converge.
 *> \endverbatim
 *
 *  Authors:
 *  ========
 *
 *> \author Univ. of Tennessee
 *> \author Univ. of California Berkeley
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
 *> \ingroup lasdq
 *
 *> \par Contributors:
 *  ==================
 *>
 *>     Ming Gu and Huan Ren, Computer Science Division, University of
 *>     California at Berkeley, USA
 *>
 *  =====================================================================
       SUBROUTINE slasdq( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT,
      $                   U, LDU, C, LDC, WORK, INFO )
 *
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *
 *     .. Scalar Arguments ..
       CHARACTER          UPLO
       INTEGER            INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU, SQRE
 *     ..
 *     .. Array Arguments ..
       REAL               C( ldc, * ), D( * ), E( * ), U( ldu, * ),
      $                   vt( ldvt, * ), work( * )
 *     ..
 *
 *  =====================================================================
 *
 *     .. Parameters ..
       REAL               ZERO
       parameter( zero = 0.0e+0 )
 *     ..
 *     .. Local Scalars ..
       LOGICAL            ROTATE
       INTEGER            I, ISUB, IUPLO, J, NP1, SQRE1
       REAL               CS, R, SMIN, SN
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           sbdsqr, slartg, slasr, sswap, xerbla
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       EXTERNAL           lsame
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          max
 *     ..
 *     .. Executable Statements ..
 *
 *     Test the input parameters.
 *
       info = 0
       iuplo = 0
       IF( lsame( uplo, 'U' ) )
      $   iuplo = 1
       IF( lsame( uplo, 'L' ) )
      $   iuplo = 2
       IF( iuplo.EQ.0 ) THEN
          info = -1
       ELSE IF( ( sqre.LT.0 ) .OR. ( sqre.GT.1 ) ) THEN
          info = -2
       ELSE IF( n.LT.0 ) THEN
          info = -3
       ELSE IF( ncvt.LT.0 ) THEN
          info = -4
       ELSE IF( nru.LT.0 ) THEN
          info = -5
       ELSE IF( ncc.LT.0 ) THEN
          info = -6
       ELSE IF( ( ncvt.EQ.0 .AND. ldvt.LT.1 ) .OR.
      $         ( ncvt.GT.0 .AND. ldvt.LT.max( 1, n ) ) ) THEN
          info = -10
       ELSE IF( ldu.LT.max( 1, nru ) ) THEN
          info = -12
       ELSE IF( ( ncc.EQ.0 .AND. ldc.LT.1 ) .OR.
      $         ( ncc.GT.0 .AND. ldc.LT.max( 1, n ) ) ) THEN
          info = -14
       END IF
       IF( info.NE.0 ) THEN
          CALL xerbla( 'SLASDQ', -info )
          RETURN
       END IF
       IF( n.EQ.0 )
      $   RETURN
 *
 *     ROTATE is true if any singular vectors desired, false otherwise
 *
       rotate = ( ncvt.GT.0 ) .OR. ( nru.GT.0 ) .OR. ( ncc.GT.0 )
       np1 = n + 1
       sqre1 = sqre
 *
 *     If matrix non-square upper bidiagonal, rotate to be lower
 *     bidiagonal.  The rotations are on the right.
 *
       IF( ( iuplo.EQ.1 ) .AND. ( sqre1.EQ.1 ) ) THEN
          DO 10 i = 1, n - 1
             CALL slartg( d( i ), e( i ), cs, sn, r )
             d( i ) = r
             e( i ) = sn*d( i+1 )
             d( i+1 ) = cs*d( i+1 )
             IF( rotate ) THEN
                work( i ) = cs
                work( n+i ) = sn
             END IF
    10    CONTINUE
          CALL slartg( d( n ), e( n ), cs, sn, r )
          d( n ) = r
          e( n ) = zero
          IF( rotate ) THEN
             work( n ) = cs
             work( n+n ) = sn
          END IF
          iuplo = 2
          sqre1 = 0
 *
 *        Update singular vectors if desired.
 *
          IF( ncvt.GT.0 )
      $      CALL slasr( 'L', 'V', 'F', np1, ncvt, work( 1 ),
      $                  work( np1 ), vt, ldvt )
       END IF
 *
 *     If matrix lower bidiagonal, rotate to be upper bidiagonal
 *     by applying Givens rotations on the left.
 *
       IF( iuplo.EQ.2 ) THEN
          DO 20 i = 1, n - 1
             CALL slartg( d( i ), e( i ), cs, sn, r )
             d( i ) = r
             e( i ) = sn*d( i+1 )
             d( i+1 ) = cs*d( i+1 )
             IF( rotate ) THEN
                work( i ) = cs
                work( n+i ) = sn
             END IF
    20    CONTINUE
 *
 *        If matrix (N+1)-by-N lower bidiagonal, one additional
 *        rotation is needed.
 *
          IF( sqre1.EQ.1 ) THEN
             CALL slartg( d( n ), e( n ), cs, sn, r )
             d( n ) = r
             IF( rotate ) THEN
                work( n ) = cs
                work( n+n ) = sn
             END IF
          END IF
 *
 *        Update singular vectors if desired.
 *
          IF( nru.GT.0 ) THEN
             IF( sqre1.EQ.0 ) THEN
                CALL slasr( 'R', 'V', 'F', nru, n, work( 1 ),
      $                     work( np1 ), u, ldu )
             ELSE
                CALL slasr( 'R', 'V', 'F', nru, np1, work( 1 ),
      $                     work( np1 ), u, ldu )
             END IF
          END IF
          IF( ncc.GT.0 ) THEN
             IF( sqre1.EQ.0 ) THEN
                CALL slasr( 'L', 'V', 'F', n, ncc, work( 1 ),
      $                     work( np1 ), c, ldc )
             ELSE
                CALL slasr( 'L', 'V', 'F', np1, ncc, work( 1 ),
      $                     work( np1 ), c, ldc )
             END IF
          END IF
       END IF
 *
 *     Call SBDSQR to compute the SVD of the reduced real
 *     N-by-N upper bidiagonal matrix.
 *
       CALL sbdsqr( 'U', n, ncvt, nru, ncc, d, e, vt, ldvt, u, ldu, c,
      $             ldc, work, info )
 *
 *     Sort the singular values into ascending order (insertion sort on
 *     singular values, but only one transposition per singular vector)
 *
       DO 40 i = 1, n
 *
 *        Scan for smallest D(I).
 *
          isub = i
          smin = d( i )
          DO 30 j = i + 1, n
             IF( d( j ).LT.smin ) THEN
                isub = j
                smin = d( j )
             END IF
    30    CONTINUE
          IF( isub.NE.i ) THEN
 *
 *           Swap singular values and vectors.
 *
             d( isub ) = d( i )
             d( i ) = smin
             IF( ncvt.GT.0 )
      $         CALL sswap( ncvt, vt( isub, 1 ), ldvt, vt( i, 1 ), ldvt )
             IF( nru.GT.0 )
      $         CALL sswap( nru, u( 1, isub ), 1, u( 1, i ), 1 )
             IF( ncc.GT.0 )
      $         CALL sswap( ncc, c( isub, 1 ), ldc, c( i, 1 ), ldc )
          END IF
    40 CONTINUE
 *
       RETURN
 *
 *     End of SLASDQ
 *
       END
slasdq
subroutine slasdq(UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SLASDQ computes the SVD of a real bidiagonal matrix with diagonal d and off-diagonal e...
Definition: slasdq.f:211

xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60

sswap
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
Definition: sswap.f:82

sbdsqr
subroutine sbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SBDSQR
Definition: sbdsqr.f:240

slasr
subroutine slasr(SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA)
SLASR applies a sequence of plane rotations to a general rectangular matrix.
Definition: slasr.f:199