LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zgebd2.f
Go to the documentation of this file.
00001 *> \brief \b ZGEBD2
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download ZGEBD2 + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgebd2.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgebd2.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgebd2.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE ZGEBD2( 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 *       DOUBLE PRECISION   D( * ), E( * )
00028 *       COMPLEX*16         A( LDA, * ), TAUP( * ), TAUQ( * ), WORK( * )
00029 *       ..
00030 *  
00031 *
00032 *> \par Purpose:
00033 *  =============
00034 *>
00035 *> \verbatim
00036 *>
00037 *> ZGEBD2 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*16 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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*16 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*16 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*16 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 complex16GEcomputational
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**H  and G(i) = I - taup * u * u**H
00154 *>
00155 *>  where tauq and taup are complex scalars, and v and u are complex
00156 *>  vectors; v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in
00157 *>  A(i+1:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in
00158 *>  A(i,i+2:n); 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**H  and G(i) = I - taup * u * u**H
00167 *>
00168 *>  where tauq and taup are complex scalars, v and u are complex 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 ZGEBD2( 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       DOUBLE PRECISION   D( * ), E( * )
00202       COMPLEX*16         A( LDA, * ), TAUP( * ), TAUQ( * ), WORK( * )
00203 *     ..
00204 *
00205 *  =====================================================================
00206 *
00207 *     .. Parameters ..
00208       COMPLEX*16         ZERO, ONE
00209       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
00210      $                   ONE = ( 1.0D+0, 0.0D+0 ) )
00211 *     ..
00212 *     .. Local Scalars ..
00213       INTEGER            I
00214       COMPLEX*16         ALPHA
00215 *     ..
00216 *     .. External Subroutines ..
00217       EXTERNAL           XERBLA, ZLACGV, ZLARF, ZLARFG
00218 *     ..
00219 *     .. Intrinsic Functions ..
00220       INTRINSIC          DCONJG, MAX, MIN
00221 *     ..
00222 *     .. Executable Statements ..
00223 *
00224 *     Test the input parameters
00225 *
00226       INFO = 0
00227       IF( M.LT.0 ) THEN
00228          INFO = -1
00229       ELSE IF( N.LT.0 ) THEN
00230          INFO = -2
00231       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
00232          INFO = -4
00233       END IF
00234       IF( INFO.LT.0 ) THEN
00235          CALL XERBLA( 'ZGEBD2', -INFO )
00236          RETURN
00237       END IF
00238 *
00239       IF( M.GE.N ) THEN
00240 *
00241 *        Reduce to upper bidiagonal form
00242 *
00243          DO 10 I = 1, N
00244 *
00245 *           Generate elementary reflector H(i) to annihilate A(i+1:m,i)
00246 *
00247             ALPHA = A( I, I )
00248             CALL ZLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1,
00249      $                   TAUQ( I ) )
00250             D( I ) = ALPHA
00251             A( I, I ) = ONE
00252 *
00253 *           Apply H(i)**H to A(i:m,i+1:n) from the left
00254 *
00255             IF( I.LT.N )
00256      $         CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
00257      $                     DCONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK )
00258             A( I, I ) = D( I )
00259 *
00260             IF( I.LT.N ) THEN
00261 *
00262 *              Generate elementary reflector G(i) to annihilate
00263 *              A(i,i+2:n)
00264 *
00265                CALL ZLACGV( N-I, A( I, I+1 ), LDA )
00266                ALPHA = A( I, I+1 )
00267                CALL ZLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ), LDA,
00268      $                      TAUP( I ) )
00269                E( I ) = ALPHA
00270                A( I, I+1 ) = ONE
00271 *
00272 *              Apply G(i) to A(i+1:m,i+1:n) from the right
00273 *
00274                CALL ZLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
00275      $                     TAUP( I ), A( I+1, I+1 ), LDA, WORK )
00276                CALL ZLACGV( N-I, A( I, I+1 ), LDA )
00277                A( I, I+1 ) = E( I )
00278             ELSE
00279                TAUP( I ) = ZERO
00280             END IF
00281    10    CONTINUE
00282       ELSE
00283 *
00284 *        Reduce to lower bidiagonal form
00285 *
00286          DO 20 I = 1, M
00287 *
00288 *           Generate elementary reflector G(i) to annihilate A(i,i+1:n)
00289 *
00290             CALL ZLACGV( N-I+1, A( I, I ), LDA )
00291             ALPHA = A( I, I )
00292             CALL ZLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
00293      $                   TAUP( I ) )
00294             D( I ) = ALPHA
00295             A( I, I ) = ONE
00296 *
00297 *           Apply G(i) to A(i+1:m,i:n) from the right
00298 *
00299             IF( I.LT.M )
00300      $         CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
00301      $                     TAUP( I ), A( I+1, I ), LDA, WORK )
00302             CALL ZLACGV( N-I+1, A( I, I ), LDA )
00303             A( I, I ) = D( I )
00304 *
00305             IF( I.LT.M ) THEN
00306 *
00307 *              Generate elementary reflector H(i) to annihilate
00308 *              A(i+2:m,i)
00309 *
00310                ALPHA = A( I+1, I )
00311                CALL ZLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1,
00312      $                      TAUQ( I ) )
00313                E( I ) = ALPHA
00314                A( I+1, I ) = ONE
00315 *
00316 *              Apply H(i)**H to A(i+1:m,i+1:n) from the left
00317 *
00318                CALL ZLARF( 'Left', M-I, N-I, A( I+1, I ), 1,
00319      $                     DCONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA,
00320      $                     WORK )
00321                A( I+1, I ) = E( I )
00322             ELSE
00323                TAUQ( I ) = ZERO
00324             END IF
00325    20    CONTINUE
00326       END IF
00327       RETURN
00328 *
00329 *     End of ZGEBD2
00330 *
00331       END
 All Files Functions