ENH: Improving the travis dashboard name
[platform/upstream/lapack.git] / 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