SRC/cungbr.f

   1 *> \brief \b CUNGBR
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download CUNGBR + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cungbr.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cungbr.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cungbr.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE CUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER          VECT
  25 *       INTEGER            INFO, K, LDA, LWORK, M, N
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       COMPLEX            A( LDA, * ), TAU( * ), WORK( * )
  29 *       ..
  30 *
  31 *
  32 *> \par Purpose:
  33 *  =============
  34 *>
  35 *> \verbatim
  36 *>
  37 *> CUNGBR generates one of the complex unitary matrices Q or P**H
  38 *> determined by CGEBRD when reducing a complex matrix A to bidiagonal
  39 *> form: A = Q * B * P**H.  Q and P**H are defined as products of
  40 *> elementary reflectors H(i) or G(i) respectively.
  41 *>
  42 *> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
  43 *> is of order M:
  44 *> if m >= k, Q = H(1) H(2) . . . H(k) and CUNGBR returns the first n
  45 *> columns of Q, where m >= n >= k;
  46 *> if m < k, Q = H(1) H(2) . . . H(m-1) and CUNGBR returns Q as an
  47 *> M-by-M matrix.
  48 *>
  49 *> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**H
  50 *> is of order N:
  51 *> if k < n, P**H = G(k) . . . G(2) G(1) and CUNGBR returns the first m
  52 *> rows of P**H, where n >= m >= k;
  53 *> if k >= n, P**H = G(n-1) . . . G(2) G(1) and CUNGBR returns P**H as
  54 *> an N-by-N matrix.
  55 *> \endverbatim
  56 *
  57 *  Arguments:
  58 *  ==========
  59 *
  60 *> \param[in] VECT
  61 *> \verbatim
  62 *>          VECT is CHARACTER*1
  63 *>          Specifies whether the matrix Q or the matrix P**H is
  64 *>          required, as defined in the transformation applied by CGEBRD:
  65 *>          = 'Q':  generate Q;
  66 *>          = 'P':  generate P**H.
  67 *> \endverbatim
  68 *>
  69 *> \param[in] M
  70 *> \verbatim
  71 *>          M is INTEGER
  72 *>          The number of rows of the matrix Q or P**H to be returned.
  73 *>          M >= 0.
  74 *> \endverbatim
  75 *>
  76 *> \param[in] N
  77 *> \verbatim
  78 *>          N is INTEGER
  79 *>          The number of columns of the matrix Q or P**H to be returned.
  80 *>          N >= 0.
  81 *>          If VECT = 'Q', M >= N >= min(M,K);
  82 *>          if VECT = 'P', N >= M >= min(N,K).
  83 *> \endverbatim
  84 *>
  85 *> \param[in] K
  86 *> \verbatim
  87 *>          K is INTEGER
  88 *>          If VECT = 'Q', the number of columns in the original M-by-K
  89 *>          matrix reduced by CGEBRD.
  90 *>          If VECT = 'P', the number of rows in the original K-by-N
  91 *>          matrix reduced by CGEBRD.
  92 *>          K >= 0.
  93 *> \endverbatim
  94 *>
  95 *> \param[in,out] A
  96 *> \verbatim
  97 *>          A is COMPLEX array, dimension (LDA,N)
  98 *>          On entry, the vectors which define the elementary reflectors,
  99 *>          as returned by CGEBRD.
 100 *>          On exit, the M-by-N matrix Q or P**H.
 101 *> \endverbatim
 102 *>
 103 *> \param[in] LDA
 104 *> \verbatim
 105 *>          LDA is INTEGER
 106 *>          The leading dimension of the array A. LDA >= M.
 107 *> \endverbatim
 108 *>
 109 *> \param[in] TAU
 110 *> \verbatim
 111 *>          TAU is COMPLEX array, dimension
 112 *>                                (min(M,K)) if VECT = 'Q'
 113 *>                                (min(N,K)) if VECT = 'P'
 114 *>          TAU(i) must contain the scalar factor of the elementary
 115 *>          reflector H(i) or G(i), which determines Q or P**H, as
 116 *>          returned by CGEBRD in its array argument TAUQ or TAUP.
 117 *> \endverbatim
 118 *>
 119 *> \param[out] WORK
 120 *> \verbatim
 121 *>          WORK is COMPLEX array, dimension (MAX(1,LWORK))
 122 *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
 123 *> \endverbatim
 124 *>
 125 *> \param[in] LWORK
 126 *> \verbatim
 127 *>          LWORK is INTEGER
 128 *>          The dimension of the array WORK. LWORK >= max(1,min(M,N)).
 129 *>          For optimum performance LWORK >= min(M,N)*NB, where NB
 130 *>          is the optimal blocksize.
 131 *>
 132 *>          If LWORK = -1, then a workspace query is assumed; the routine
 133 *>          only calculates the optimal size of the WORK array, returns
 134 *>          this value as the first entry of the WORK array, and no error
 135 *>          message related to LWORK is issued by XERBLA.
 136 *> \endverbatim
 137 *>
 138 *> \param[out] INFO
 139 *> \verbatim
 140 *>          INFO is INTEGER
 141 *>          = 0:  successful exit
 142 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
 143 *> \endverbatim
 144 *
 145 *  Authors:
 146 *  ========
 147 *
 148 *> \author Univ. of Tennessee
 149 *> \author Univ. of California Berkeley
 150 *> \author Univ. of Colorado Denver
 151 *> \author NAG Ltd.
 152 *
 153 *> \date April 2012
 154 *
 155 *> \ingroup complexGBcomputational
 156 *
 157 *  =====================================================================
 158       SUBROUTINE CUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 159 *
 160 *  -- LAPACK computational routine (version 3.4.1) --
 161 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 162 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 163 *     April 2012
 164 *
 165 *     .. Scalar Arguments ..
 166       CHARACTER          VECT
 167       INTEGER            INFO, K, LDA, LWORK, M, N
 168 *     ..
 169 *     .. Array Arguments ..
 170       COMPLEX            A( LDA, * ), TAU( * ), WORK( * )
 171 *     ..
 172 *
 173 *  =====================================================================
 174 *
 175 *     .. Parameters ..
 176       COMPLEX            ZERO, ONE
 177       PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ),
 178      $                   ONE = ( 1.0E+0, 0.0E+0 ) )
 179 *     ..
 180 *     .. Local Scalars ..
 181       LOGICAL            LQUERY, WANTQ
 182       INTEGER            I, IINFO, J, LWKOPT, MN
 183 *     ..
 184 *     .. External Functions ..
 185       LOGICAL            LSAME
 186       INTEGER            ILAENV
 187       EXTERNAL           ILAENV, LSAME
 188 *     ..
 189 *     .. External Subroutines ..
 190       EXTERNAL           CUNGLQ, CUNGQR, XERBLA
 191 *     ..
 192 *     .. Intrinsic Functions ..
 193       INTRINSIC          MAX, MIN
 194 *     ..
 195 *     .. Executable Statements ..
 196 *
 197 *     Test the input arguments
 198 *
 199       INFO = 0
 200       WANTQ = LSAME( VECT, 'Q' )
 201       MN = MIN( M, N )
 202       LQUERY = ( LWORK.EQ.-1 )
 203       IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
 204          INFO = -1
 205       ELSE IF( M.LT.0 ) THEN
 206          INFO = -2
 207       ELSE IF( N.LT.0 .OR. ( WANTQ .AND. ( N.GT.M .OR. N.LT.MIN( M,
 208      $         K ) ) ) .OR. ( .NOT.WANTQ .AND. ( M.GT.N .OR. M.LT.
 209      $         MIN( N, K ) ) ) ) THEN
 210          INFO = -3
 211       ELSE IF( K.LT.0 ) THEN
 212          INFO = -4
 213       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
 214          INFO = -6
 215       ELSE IF( LWORK.LT.MAX( 1, MN ) .AND. .NOT.LQUERY ) THEN
 216          INFO = -9
 217       END IF
 218 *
 219       IF( INFO.EQ.0 ) THEN
 220          WORK( 1 ) = 1
 221          IF( WANTQ ) THEN
 222             IF( M.GE.K ) THEN
 223                CALL CUNGQR( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
 224             ELSE
 225                IF( M.GT.1 ) THEN
 226                   CALL CUNGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
 227      $                         -1, IINFO )
 228                END IF
 229             END IF
 230          ELSE
 231             IF( K.LT.N ) THEN
 232                CALL CUNGLQ( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
 233             ELSE
 234                IF( N.GT.1 ) THEN
 235                   CALL CUNGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
 236      $                         -1, IINFO )
 237                END IF
 238             END IF
 239          END IF
 240          LWKOPT = WORK( 1 )
 241          LWKOPT = MAX (LWKOPT, MN)
 242       END IF
 243 *
 244       IF( INFO.NE.0 ) THEN
 245          CALL XERBLA( 'CUNGBR', -INFO )
 246          RETURN
 247       ELSE IF( LQUERY ) THEN
 248          WORK( 1 ) = LWKOPT
 249          RETURN
 250       END IF
 251 *
 252 *     Quick return if possible
 253 *
 254       IF( M.EQ.0 .OR. N.EQ.0 ) THEN
 255          WORK( 1 ) = 1
 256          RETURN
 257       END IF
 258 *
 259       IF( WANTQ ) THEN
 260 *
 261 *        Form Q, determined by a call to CGEBRD to reduce an m-by-k
 262 *        matrix
 263 *
 264          IF( M.GE.K ) THEN
 265 *
 266 *           If m >= k, assume m >= n >= k
 267 *
 268             CALL CUNGQR( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
 269 *
 270          ELSE
 271 *
 272 *           If m < k, assume m = n
 273 *
 274 *           Shift the vectors which define the elementary reflectors one
 275 *           column to the right, and set the first row and column of Q
 276 *           to those of the unit matrix
 277 *
 278             DO 20 J = M, 2, -1
 279                A( 1, J ) = ZERO
 280                DO 10 I = J + 1, M
 281                   A( I, J ) = A( I, J-1 )
 282    10          CONTINUE
 283    20       CONTINUE
 284             A( 1, 1 ) = ONE
 285             DO 30 I = 2, M
 286                A( I, 1 ) = ZERO
 287    30       CONTINUE
 288             IF( M.GT.1 ) THEN
 289 *
 290 *              Form Q(2:m,2:m)
 291 *
 292                CALL CUNGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
 293      $                      LWORK, IINFO )
 294             END IF
 295          END IF
 296       ELSE
 297 *
 298 *        Form P**H, determined by a call to CGEBRD to reduce a k-by-n
 299 *        matrix
 300 *
 301          IF( K.LT.N ) THEN
 302 *
 303 *           If k < n, assume k <= m <= n
 304 *
 305             CALL CUNGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
 306 *
 307          ELSE
 308 *
 309 *           If k >= n, assume m = n
 310 *
 311 *           Shift the vectors which define the elementary reflectors one
 312 *           row downward, and set the first row and column of P**H to
 313 *           those of the unit matrix
 314 *
 315             A( 1, 1 ) = ONE
 316             DO 40 I = 2, N
 317                A( I, 1 ) = ZERO
 318    40       CONTINUE
 319             DO 60 J = 2, N
 320                DO 50 I = J - 1, 2, -1
 321                   A( I, J ) = A( I-1, J )
 322    50          CONTINUE
 323                A( 1, J ) = ZERO
 324    60       CONTINUE
 325             IF( N.GT.1 ) THEN
 326 *
 327 *              Form P**H(2:n,2:n)
 328 *
 329                CALL CUNGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
 330      $                      LWORK, IINFO )
 331             END IF
 332          END IF
 333       END IF
 334       WORK( 1 ) = LWKOPT
 335       RETURN
 336 *
 337 *     End of CUNGBR
 338 *
 339       END