LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
sgebd2.f
Go to the documentation of this file.
00001 *> \brief \b SGEBD2
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download SGEBD2 + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgebd2.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgebd2.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgebd2.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       INTEGER            INFO, LDA, M, N
00025 *       ..
00026 *       .. Array Arguments ..
00027 *       REAL               A( LDA, * ), D( * ), E( * ), TAUP( * ),
00028 *      $                   TAUQ( * ), WORK( * )
00029 *       ..
00030 *  
00031 *
00032 *> \par Purpose:
00033 *  =============
00034 *>
00035 *> \verbatim
00036 *>
00037 *> SGEBD2 reduces a real general m by n matrix A to upper or lower
00038 *> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
00039 *>
00040 *> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
00041 *> \endverbatim
00042 *
00043 *  Arguments:
00044 *  ==========
00045 *
00046 *> \param[in] M
00047 *> \verbatim
00048 *>          M is INTEGER
00049 *>          The number of rows in the matrix A.  M >= 0.
00050 *> \endverbatim
00051 *>
00052 *> \param[in] N
00053 *> \verbatim
00054 *>          N is INTEGER
00055 *>          The number of columns in the matrix A.  N >= 0.
00056 *> \endverbatim
00057 *>
00058 *> \param[in,out] A
00059 *> \verbatim
00060 *>          A is REAL array, dimension (LDA,N)
00061 *>          On entry, the m by n general matrix to be reduced.
00062 *>          On exit,
00063 *>          if m >= n, the diagonal and the first superdiagonal are
00064 *>            overwritten with the upper bidiagonal matrix B; the
00065 *>            elements below the diagonal, with the array TAUQ, represent
00066 *>            the orthogonal matrix Q as a product of elementary
00067 *>            reflectors, and the elements above the first superdiagonal,
00068 *>            with the array TAUP, represent the orthogonal matrix P as
00069 *>            a product of elementary reflectors;
00070 *>          if m < n, the diagonal and the first subdiagonal are
00071 *>            overwritten with the lower bidiagonal matrix B; the
00072 *>            elements below the first subdiagonal, with the array TAUQ,
00073 *>            represent the orthogonal matrix Q as a product of
00074 *>            elementary reflectors, and the elements above the diagonal,
00075 *>            with the array TAUP, represent the orthogonal matrix P as
00076 *>            a product of elementary reflectors.
00077 *>          See Further Details.
00078 *> \endverbatim
00079 *>
00080 *> \param[in] LDA
00081 *> \verbatim
00082 *>          LDA is INTEGER
00083 *>          The leading dimension of the array A.  LDA >= max(1,M).
00084 *> \endverbatim
00085 *>
00086 *> \param[out] D
00087 *> \verbatim
00088 *>          D is REAL array, dimension (min(M,N))
00089 *>          The diagonal elements of the bidiagonal matrix B:
00090 *>          D(i) = A(i,i).
00091 *> \endverbatim
00092 *>
00093 *> \param[out] E
00094 *> \verbatim
00095 *>          E is REAL array, dimension (min(M,N)-1)
00096 *>          The off-diagonal elements of the bidiagonal matrix B:
00097 *>          if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
00098 *>          if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
00099 *> \endverbatim
00100 *>
00101 *> \param[out] TAUQ
00102 *> \verbatim
00103 *>          TAUQ is REAL array dimension (min(M,N))
00104 *>          The scalar factors of the elementary reflectors which
00105 *>          represent the orthogonal matrix Q. See Further Details.
00106 *> \endverbatim
00107 *>
00108 *> \param[out] TAUP
00109 *> \verbatim
00110 *>          TAUP is REAL array, dimension (min(M,N))
00111 *>          The scalar factors of the elementary reflectors which
00112 *>          represent the orthogonal matrix P. See Further Details.
00113 *> \endverbatim
00114 *>
00115 *> \param[out] WORK
00116 *> \verbatim
00117 *>          WORK is REAL array, dimension (max(M,N))
00118 *> \endverbatim
00119 *>
00120 *> \param[out] INFO
00121 *> \verbatim
00122 *>          INFO is INTEGER
00123 *>          = 0: successful exit.
00124 *>          < 0: if INFO = -i, the i-th argument had an illegal value.
00125 *> \endverbatim
00126 *
00127 *  Authors:
00128 *  ========
00129 *
00130 *> \author Univ. of Tennessee 
00131 *> \author Univ. of California Berkeley 
00132 *> \author Univ. of Colorado Denver 
00133 *> \author NAG Ltd. 
00134 *
00135 *> \date November 2011
00136 *
00137 *> \ingroup realGEcomputational
00138 *
00139 *> \par Further Details:
00140 *  =====================
00141 *>
00142 *> \verbatim
00143 *>
00144 *>  The matrices Q and P are represented as products of elementary
00145 *>  reflectors:
00146 *>
00147 *>  If m >= n,
00148 *>
00149 *>     Q = H(1) H(2) . . . H(n)  and  P = G(1) G(2) . . . G(n-1)
00150 *>
00151 *>  Each H(i) and G(i) has the form:
00152 *>
00153 *>     H(i) = I - tauq * v * v**T  and G(i) = I - taup * u * u**T
00154 *>
00155 *>  where tauq and taup are real scalars, and v and u are real vectors;
00156 *>  v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
00157 *>  u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
00158 *>  tauq is stored in TAUQ(i) and taup in TAUP(i).
00159 *>
00160 *>  If m < n,
00161 *>
00162 *>     Q = H(1) H(2) . . . H(m-1)  and  P = G(1) G(2) . . . G(m)
00163 *>
00164 *>  Each H(i) and G(i) has the form:
00165 *>
00166 *>     H(i) = I - tauq * v * v**T  and G(i) = I - taup * u * u**T
00167 *>
00168 *>  where tauq and taup are real scalars, and v and u are real vectors;
00169 *>  v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
00170 *>  u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
00171 *>  tauq is stored in TAUQ(i) and taup in TAUP(i).
00172 *>
00173 *>  The contents of A on exit are illustrated by the following examples:
00174 *>
00175 *>  m = 6 and n = 5 (m > n):          m = 5 and n = 6 (m < n):
00176 *>
00177 *>    (  d   e   u1  u1  u1 )           (  d   u1  u1  u1  u1  u1 )
00178 *>    (  v1  d   e   u2  u2 )           (  e   d   u2  u2  u2  u2 )
00179 *>    (  v1  v2  d   e   u3 )           (  v1  e   d   u3  u3  u3 )
00180 *>    (  v1  v2  v3  d   e  )           (  v1  v2  e   d   u4  u4 )
00181 *>    (  v1  v2  v3  v4  d  )           (  v1  v2  v3  e   d   u5 )
00182 *>    (  v1  v2  v3  v4  v5 )
00183 *>
00184 *>  where d and e denote diagonal and off-diagonal elements of B, vi
00185 *>  denotes an element of the vector defining H(i), and ui an element of
00186 *>  the vector defining G(i).
00187 *> \endverbatim
00188 *>
00189 *  =====================================================================
00190       SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
00191 *
00192 *  -- LAPACK computational routine (version 3.4.0) --
00193 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00194 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00195 *     November 2011
00196 *
00197 *     .. Scalar Arguments ..
00198       INTEGER            INFO, LDA, M, N
00199 *     ..
00200 *     .. Array Arguments ..
00201       REAL               A( LDA, * ), D( * ), E( * ), TAUP( * ),
00202      $                   TAUQ( * ), WORK( * )
00203 *     ..
00204 *
00205 *  =====================================================================
00206 *
00207 *     .. Parameters ..
00208       REAL               ZERO, ONE
00209       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
00210 *     ..
00211 *     .. Local Scalars ..
00212       INTEGER            I
00213 *     ..
00214 *     .. External Subroutines ..
00215       EXTERNAL           SLARF, SLARFG, XERBLA
00216 *     ..
00217 *     .. Intrinsic Functions ..
00218       INTRINSIC          MAX, MIN
00219 *     ..
00220 *     .. Executable Statements ..
00221 *
00222 *     Test the input parameters
00223 *
00224       INFO = 0
00225       IF( M.LT.0 ) THEN
00226          INFO = -1
00227       ELSE IF( N.LT.0 ) THEN
00228          INFO = -2
00229       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
00230          INFO = -4
00231       END IF
00232       IF( INFO.LT.0 ) THEN
00233          CALL XERBLA( 'SGEBD2', -INFO )
00234          RETURN
00235       END IF
00236 *
00237       IF( M.GE.N ) THEN
00238 *
00239 *        Reduce to upper bidiagonal form
00240 *
00241          DO 10 I = 1, N
00242 *
00243 *           Generate elementary reflector H(i) to annihilate A(i+1:m,i)
00244 *
00245             CALL SLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
00246      $                   TAUQ( I ) )
00247             D( I ) = A( I, I )
00248             A( I, I ) = ONE
00249 *
00250 *           Apply H(i) to A(i:m,i+1:n) from the left
00251 *
00252             IF( I.LT.N )
00253      $         CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAUQ( I ),
00254      $                     A( I, I+1 ), LDA, WORK )
00255             A( I, I ) = D( I )
00256 *
00257             IF( I.LT.N ) THEN
00258 *
00259 *              Generate elementary reflector G(i) to annihilate
00260 *              A(i,i+2:n)
00261 *
00262                CALL SLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ),
00263      $                      LDA, TAUP( I ) )
00264                E( I ) = A( I, I+1 )
00265                A( I, I+1 ) = ONE
00266 *
00267 *              Apply G(i) to A(i+1:m,i+1:n) from the right
00268 *
00269                CALL SLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
00270      $                     TAUP( I ), A( I+1, I+1 ), LDA, WORK )
00271                A( I, I+1 ) = E( I )
00272             ELSE
00273                TAUP( I ) = ZERO
00274             END IF
00275    10    CONTINUE
00276       ELSE
00277 *
00278 *        Reduce to lower bidiagonal form
00279 *
00280          DO 20 I = 1, M
00281 *
00282 *           Generate elementary reflector G(i) to annihilate A(i,i+1:n)
00283 *
00284             CALL SLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
00285      $                   TAUP( I ) )
00286             D( I ) = A( I, I )
00287             A( I, I ) = ONE
00288 *
00289 *           Apply G(i) to A(i+1:m,i:n) from the right
00290 *
00291             IF( I.LT.M )
00292      $         CALL SLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
00293      $                     TAUP( I ), A( I+1, I ), LDA, WORK )
00294             A( I, I ) = D( I )
00295 *
00296             IF( I.LT.M ) THEN
00297 *
00298 *              Generate elementary reflector H(i) to annihilate
00299 *              A(i+2:m,i)
00300 *
00301                CALL SLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1,
00302      $                      TAUQ( I ) )
00303                E( I ) = A( I+1, I )
00304                A( I+1, I ) = ONE
00305 *
00306 *              Apply H(i) to A(i+1:m,i+1:n) from the left
00307 *
00308                CALL SLARF( 'Left', M-I, N-I, A( I+1, I ), 1, TAUQ( I ),
00309      $                     A( I+1, I+1 ), LDA, WORK )
00310                A( I+1, I ) = E( I )
00311             ELSE
00312                TAUQ( I ) = ZERO
00313             END IF
00314    20    CONTINUE
00315       END IF
00316       RETURN
00317 *
00318 *     End of SGEBD2
00319 *
00320       END
 All Files Functions