LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cgebd2.f
Go to the documentation of this file.
00001 *> \brief \b CGEBD2
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CGEBD2 + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgebd2.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgebd2.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgebd2.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE CGEBD2( 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               D( * ), E( * )
00028 *       COMPLEX            A( LDA, * ), TAUP( * ), TAUQ( * ), WORK( * )
00029 *       ..
00030 *  
00031 *
00032 *> \par Purpose:
00033 *  =============
00034 *>
00035 *> \verbatim
00036 *>
00037 *> CGEBD2 reduces a complex general m by n matrix A to upper or lower
00038 *> real bidiagonal form B by a unitary transformation: Q**H * 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 COMPLEX 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 unitary matrix Q as a product of elementary
00067 *>            reflectors, and the elements above the first superdiagonal,
00068 *>            with the array TAUP, represent the unitary 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 unitary matrix Q as a product of
00074 *>            elementary reflectors, and the elements above the diagonal,
00075 *>            with the array TAUP, represent the unitary 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 COMPLEX array dimension (min(M,N))
00104 *>          The scalar factors of the elementary reflectors which
00105 *>          represent the unitary matrix Q. See Further Details.
00106 *> \endverbatim
00107 *>
00108 *> \param[out] TAUP
00109 *> \verbatim
00110 *>          TAUP is COMPLEX array, dimension (min(M,N))
00111 *>          The scalar factors of the elementary reflectors which
00112 *>          represent the unitary matrix P. See Further Details.
00113 *> \endverbatim
00114 *>
00115 *> \param[out] WORK
00116 *> \verbatim
00117 *>          WORK is COMPLEX 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 complexGEcomputational
00138 * @precisions normal c -> s d z
00139 *
00140 *> \par Further Details:
00141 *  =====================
00142 *>
00143 *> \verbatim
00144 *>
00145 *>  The matrices Q and P are represented as products of elementary
00146 *>  reflectors:
00147 *>
00148 *>  If m >= n,
00149 *>
00150 *>     Q = H(1) H(2) . . . H(n)  and  P = G(1) G(2) . . . G(n-1)
00151 *>
00152 *>  Each H(i) and G(i) has the form:
00153 *>
00154 *>     H(i) = I - tauq * v * v**H  and G(i) = I - taup * u * u**H
00155 *>
00156 *>  where tauq and taup are complex scalars, and v and u are complex
00157 *>  vectors; v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in
00158 *>  A(i+1:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in
00159 *>  A(i,i+2:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
00160 *>
00161 *>  If m < n,
00162 *>
00163 *>     Q = H(1) H(2) . . . H(m-1)  and  P = G(1) G(2) . . . G(m)
00164 *>
00165 *>  Each H(i) and G(i) has the form:
00166 *>
00167 *>     H(i) = I - tauq * v * v**H  and G(i) = I - taup * u * u**H
00168 *>
00169 *>  where tauq and taup are complex scalars, v and u are complex vectors;
00170 *>  v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
00171 *>  u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
00172 *>  tauq is stored in TAUQ(i) and taup in TAUP(i).
00173 *>
00174 *>  The contents of A on exit are illustrated by the following examples:
00175 *>
00176 *>  m = 6 and n = 5 (m > n):          m = 5 and n = 6 (m < n):
00177 *>
00178 *>    (  d   e   u1  u1  u1 )           (  d   u1  u1  u1  u1  u1 )
00179 *>    (  v1  d   e   u2  u2 )           (  e   d   u2  u2  u2  u2 )
00180 *>    (  v1  v2  d   e   u3 )           (  v1  e   d   u3  u3  u3 )
00181 *>    (  v1  v2  v3  d   e  )           (  v1  v2  e   d   u4  u4 )
00182 *>    (  v1  v2  v3  v4  d  )           (  v1  v2  v3  e   d   u5 )
00183 *>    (  v1  v2  v3  v4  v5 )
00184 *>
00185 *>  where d and e denote diagonal and off-diagonal elements of B, vi
00186 *>  denotes an element of the vector defining H(i), and ui an element of
00187 *>  the vector defining G(i).
00188 *> \endverbatim
00189 *>
00190 *  =====================================================================
00191       SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
00192 *
00193 *  -- LAPACK computational routine (version 3.4.0) --
00194 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00195 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00196 *     November 2011
00197 *
00198 *     .. Scalar Arguments ..
00199       INTEGER            INFO, LDA, M, N
00200 *     ..
00201 *     .. Array Arguments ..
00202       REAL               D( * ), E( * )
00203       COMPLEX            A( LDA, * ), TAUP( * ), TAUQ( * ), WORK( * )
00204 *     ..
00205 *
00206 *  =====================================================================
00207 *
00208 *     .. Parameters ..
00209       COMPLEX            ZERO, ONE
00210       PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ),
00211      $                   ONE = ( 1.0E+0, 0.0E+0 ) )
00212 *     ..
00213 *     .. Local Scalars ..
00214       INTEGER            I
00215       COMPLEX            ALPHA
00216 *     ..
00217 *     .. External Subroutines ..
00218       EXTERNAL           CLACGV, CLARF, CLARFG, XERBLA
00219 *     ..
00220 *     .. Intrinsic Functions ..
00221       INTRINSIC          CONJG, MAX, MIN
00222 *     ..
00223 *     .. Executable Statements ..
00224 *
00225 *     Test the input parameters
00226 *
00227       INFO = 0
00228       IF( M.LT.0 ) THEN
00229          INFO = -1
00230       ELSE IF( N.LT.0 ) THEN
00231          INFO = -2
00232       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
00233          INFO = -4
00234       END IF
00235       IF( INFO.LT.0 ) THEN
00236          CALL XERBLA( 'CGEBD2', -INFO )
00237          RETURN
00238       END IF
00239 *
00240       IF( M.GE.N ) THEN
00241 *
00242 *        Reduce to upper bidiagonal form
00243 *
00244          DO 10 I = 1, N
00245 *
00246 *           Generate elementary reflector H(i) to annihilate A(i+1:m,i)
00247 *
00248             ALPHA = A( I, I )
00249             CALL CLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1,
00250      $                   TAUQ( I ) )
00251             D( I ) = ALPHA
00252             A( I, I ) = ONE
00253 *
00254 *           Apply H(i)**H to A(i:m,i+1:n) from the left
00255 *
00256             IF( I.LT.N )
00257      $         CALL CLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
00258      $                     CONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK )
00259             A( I, I ) = D( I )
00260 *
00261             IF( I.LT.N ) THEN
00262 *
00263 *              Generate elementary reflector G(i) to annihilate
00264 *              A(i,i+2:n)
00265 *
00266                CALL CLACGV( N-I, A( I, I+1 ), LDA )
00267                ALPHA = A( I, I+1 )
00268                CALL CLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ),
00269      $                      LDA, TAUP( I ) )
00270                E( I ) = ALPHA
00271                A( I, I+1 ) = ONE
00272 *
00273 *              Apply G(i) to A(i+1:m,i+1:n) from the right
00274 *
00275                CALL CLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
00276      $                     TAUP( I ), A( I+1, I+1 ), LDA, WORK )
00277                CALL CLACGV( N-I, A( I, I+1 ), LDA )
00278                A( I, I+1 ) = E( I )
00279             ELSE
00280                TAUP( I ) = ZERO
00281             END IF
00282    10    CONTINUE
00283       ELSE
00284 *
00285 *        Reduce to lower bidiagonal form
00286 *
00287          DO 20 I = 1, M
00288 *
00289 *           Generate elementary reflector G(i) to annihilate A(i,i+1:n)
00290 *
00291             CALL CLACGV( N-I+1, A( I, I ), LDA )
00292             ALPHA = A( I, I )
00293             CALL CLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
00294      $                   TAUP( I ) )
00295             D( I ) = ALPHA
00296             A( I, I ) = ONE
00297 *
00298 *           Apply G(i) to A(i+1:m,i:n) from the right
00299 *
00300             IF( I.LT.M )
00301      $         CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
00302      $                     TAUP( I ), A( I+1, I ), LDA, WORK )
00303             CALL CLACGV( N-I+1, A( I, I ), LDA )
00304             A( I, I ) = D( I )
00305 *
00306             IF( I.LT.M ) THEN
00307 *
00308 *              Generate elementary reflector H(i) to annihilate
00309 *              A(i+2:m,i)
00310 *
00311                ALPHA = A( I+1, I )
00312                CALL CLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1,
00313      $                      TAUQ( I ) )
00314                E( I ) = ALPHA
00315                A( I+1, I ) = ONE
00316 *
00317 *              Apply H(i)**H to A(i+1:m,i+1:n) from the left
00318 *
00319                CALL CLARF( 'Left', M-I, N-I, A( I+1, I ), 1,
00320      $                     CONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA,
00321      $                     WORK )
00322                A( I+1, I ) = E( I )
00323             ELSE
00324                TAUQ( I ) = ZERO
00325             END IF
00326    20    CONTINUE
00327       END IF
00328       RETURN
00329 *
00330 *     End of CGEBD2
00331 *
00332       END
 All Files Functions