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 OTHERauxiliary

*

*> \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

.GT.         IF( NCC0 ) THEN

.EQ.            IF( SQRE10 ) 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

.LT.            IF( D( J )SMIN ) THEN

               ISUB = J

               SMIN = D( J )

            END IF

   30    CONTINUE

.NE.         IF( ISUBI ) THEN

*

*           Swap singular values and vectors.

*

            D( ISUB ) = D( I )

            D( I ) = SMIN

.GT.            IF( NCVT0 )

     $         CALL SSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( I, 1 ), LDVT )

.GT.            IF( NRU0 )

     $         CALL SSWAP( NRU, U( 1, ISUB ), 1, U( 1, I ), 1 )

.GT.            IF( NCC0 )

     $         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

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

slartg
subroutine slartg(f, g, c, s, r)
SLARTG generates a plane rotation with real cosine and real sine.
Definition slartg.f90:113

sbdsqr
subroutine sbdsqr(uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u, ldu, c, ldc, work, info)
SBDSQR
Definition sbdsqr.f:240

xerbla
subroutine xerbla(srname, info)
XERBLA
Definition xerbla.f:60

sswap
subroutine sswap(n, sx, incx, sy, incy)
SSWAP
Definition sswap.f:82

max
#define max(a, b)
Definition macros.h:21