LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
cunmtr.f
Go to the documentation of this file.
1 *> \brief \b CUNMTR
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download CUNMTR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cunmtr.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cunmtr.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cunmtr.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE CUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC,
22 * WORK, LWORK, INFO )
23 *
24 * .. Scalar Arguments ..
25 * CHARACTER SIDE, TRANS, UPLO
26 * INTEGER INFO, LDA, LDC, LWORK, M, N
27 * ..
28 * .. Array Arguments ..
29 * COMPLEX A( LDA, * ), C( LDC, * ), TAU( * ),
30 * $ WORK( * )
31 * ..
32 *
33 *
34 *> \par Purpose:
35 * =============
36 *>
37 *> \verbatim
38 *>
39 *> CUNMTR overwrites the general complex M-by-N matrix C with
40 *>
41 *> SIDE = 'L' SIDE = 'R'
42 *> TRANS = 'N': Q * C C * Q
43 *> TRANS = 'C': Q**H * C C * Q**H
44 *>
45 *> where Q is a complex unitary matrix of order nq, with nq = m if
46 *> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
47 *> nq-1 elementary reflectors, as returned by CHETRD:
48 *>
49 *> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
50 *>
51 *> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
52 *> \endverbatim
53 *
54 * Arguments:
55 * ==========
56 *
57 *> \param[in] SIDE
58 *> \verbatim
59 *> SIDE is CHARACTER*1
60 *> = 'L': apply Q or Q**H from the Left;
61 *> = 'R': apply Q or Q**H from the Right.
62 *> \endverbatim
63 *>
64 *> \param[in] UPLO
65 *> \verbatim
66 *> UPLO is CHARACTER*1
67 *> = 'U': Upper triangle of A contains elementary reflectors
68 *> from CHETRD;
69 *> = 'L': Lower triangle of A contains elementary reflectors
70 *> from CHETRD.
71 *> \endverbatim
72 *>
73 *> \param[in] TRANS
74 *> \verbatim
75 *> TRANS is CHARACTER*1
76 *> = 'N': No transpose, apply Q;
77 *> = 'C': Conjugate transpose, apply Q**H.
78 *> \endverbatim
79 *>
80 *> \param[in] M
81 *> \verbatim
82 *> M is INTEGER
83 *> The number of rows of the matrix C. M >= 0.
84 *> \endverbatim
85 *>
86 *> \param[in] N
87 *> \verbatim
88 *> N is INTEGER
89 *> The number of columns of the matrix C. N >= 0.
90 *> \endverbatim
91 *>
92 *> \param[in] A
93 *> \verbatim
94 *> A is COMPLEX array, dimension
95 *> (LDA,M) if SIDE = 'L'
96 *> (LDA,N) if SIDE = 'R'
97 *> The vectors which define the elementary reflectors, as
98 *> returned by CHETRD.
99 *> \endverbatim
100 *>
101 *> \param[in] LDA
102 *> \verbatim
103 *> LDA is INTEGER
104 *> The leading dimension of the array A.
105 *> LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
106 *> \endverbatim
107 *>
108 *> \param[in] TAU
109 *> \verbatim
110 *> TAU is COMPLEX array, dimension
111 *> (M-1) if SIDE = 'L'
112 *> (N-1) if SIDE = 'R'
113 *> TAU(i) must contain the scalar factor of the elementary
114 *> reflector H(i), as returned by CHETRD.
115 *> \endverbatim
116 *>
117 *> \param[in,out] C
118 *> \verbatim
119 *> C is COMPLEX array, dimension (LDC,N)
120 *> On entry, the M-by-N matrix C.
121 *> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
122 *> \endverbatim
123 *>
124 *> \param[in] LDC
125 *> \verbatim
126 *> LDC is INTEGER
127 *> The leading dimension of the array C. LDC >= max(1,M).
128 *> \endverbatim
129 *>
130 *> \param[out] WORK
131 *> \verbatim
132 *> WORK is COMPLEX array, dimension (MAX(1,LWORK))
133 *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
134 *> \endverbatim
135 *>
136 *> \param[in] LWORK
137 *> \verbatim
138 *> LWORK is INTEGER
139 *> The dimension of the array WORK.
140 *> If SIDE = 'L', LWORK >= max(1,N);
141 *> if SIDE = 'R', LWORK >= max(1,M).
142 *> For optimum performance LWORK >= N*NB if SIDE = 'L', and
143 *> LWORK >=M*NB if SIDE = 'R', where NB is the optimal
144 *> blocksize.
145 *>
146 *> If LWORK = -1, then a workspace query is assumed; the routine
147 *> only calculates the optimal size of the WORK array, returns
148 *> this value as the first entry of the WORK array, and no error
149 *> message related to LWORK is issued by XERBLA.
150 *> \endverbatim
151 *>
152 *> \param[out] INFO
153 *> \verbatim
154 *> INFO is INTEGER
155 *> = 0: successful exit
156 *> < 0: if INFO = -i, the i-th argument had an illegal value
157 *> \endverbatim
158 *
159 * Authors:
160 * ========
161 *
162 *> \author Univ. of Tennessee
163 *> \author Univ. of California Berkeley
164 *> \author Univ. of Colorado Denver
165 *> \author NAG Ltd.
166 *
167 *> \ingroup complexOTHERcomputational
168 *
169 * =====================================================================
170  SUBROUTINE cunmtr( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC,
171  $ WORK, LWORK, INFO )
172 *
173 * -- LAPACK computational routine --
174 * -- LAPACK is a software package provided by Univ. of Tennessee, --
175 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
176 *
177 * .. Scalar Arguments ..
178  CHARACTER SIDE, TRANS, UPLO
179  INTEGER INFO, LDA, LDC, LWORK, M, N
180 * ..
181 * .. Array Arguments ..
182  COMPLEX A( LDA, * ), C( LDC, * ), TAU( * ),
183  $ work( * )
184 * ..
185 *
186 * =====================================================================
187 *
188 * .. Local Scalars ..
189  LOGICAL LEFT, LQUERY, UPPER
190  INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW
191 * ..
192 * .. External Functions ..
193  LOGICAL LSAME
194  INTEGER ILAENV
195  EXTERNAL ilaenv, lsame
196 * ..
197 * .. External Subroutines ..
198  EXTERNAL cunmql, cunmqr, xerbla
199 * ..
200 * .. Intrinsic Functions ..
201  INTRINSIC max
202 * ..
203 * .. Executable Statements ..
204 *
205 * Test the input arguments
206 *
207  info = 0
208  left = lsame( side, 'L' )
209  upper = lsame( uplo, 'U' )
210  lquery = ( lwork.EQ.-1 )
211 *
212 * NQ is the order of Q and NW is the minimum dimension of WORK
213 *
214  IF( left ) THEN
215  nq = m
216  nw = max( 1, n )
217  ELSE
218  nq = n
219  nw = max( 1, m )
220  END IF
221  IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
222  info = -1
223  ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
224  info = -2
225  ELSE IF( .NOT.lsame( trans, 'N' ) .AND. .NOT.lsame( trans, 'C' ) )
226  $ THEN
227  info = -3
228  ELSE IF( m.LT.0 ) THEN
229  info = -4
230  ELSE IF( n.LT.0 ) THEN
231  info = -5
232  ELSE IF( lda.LT.max( 1, nq ) ) THEN
233  info = -7
234  ELSE IF( ldc.LT.max( 1, m ) ) THEN
235  info = -10
236  ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
237  info = -12
238  END IF
239 *
240  IF( info.EQ.0 ) THEN
241  IF( upper ) THEN
242  IF( left ) THEN
243  nb = ilaenv( 1, 'CUNMQL', side // trans, m-1, n, m-1,
244  $ -1 )
245  ELSE
246  nb = ilaenv( 1, 'CUNMQL', side // trans, m, n-1, n-1,
247  $ -1 )
248  END IF
249  ELSE
250  IF( left ) THEN
251  nb = ilaenv( 1, 'CUNMQR', side // trans, m-1, n, m-1,
252  $ -1 )
253  ELSE
254  nb = ilaenv( 1, 'CUNMQR', side // trans, m, n-1, n-1,
255  $ -1 )
256  END IF
257  END IF
258  lwkopt = nw*nb
259  work( 1 ) = lwkopt
260  END IF
261 *
262  IF( info.NE.0 ) THEN
263  CALL xerbla( 'CUNMTR', -info )
264  RETURN
265  ELSE IF( lquery ) THEN
266  RETURN
267  END IF
268 *
269 * Quick return if possible
270 *
271  IF( m.EQ.0 .OR. n.EQ.0 .OR. nq.EQ.1 ) THEN
272  work( 1 ) = 1
273  RETURN
274  END IF
275 *
276  IF( left ) THEN
277  mi = m - 1
278  ni = n
279  ELSE
280  mi = m
281  ni = n - 1
282  END IF
283 *
284  IF( upper ) THEN
285 *
286 * Q was determined by a call to CHETRD with UPLO = 'U'
287 *
288  CALL cunmql( side, trans, mi, ni, nq-1, a( 1, 2 ), lda, tau, c,
289  $ ldc, work, lwork, iinfo )
290  ELSE
291 *
292 * Q was determined by a call to CHETRD with UPLO = 'L'
293 *
294  IF( left ) THEN
295  i1 = 2
296  i2 = 1
297  ELSE
298  i1 = 1
299  i2 = 2
300  END IF
301  CALL cunmqr( side, trans, mi, ni, nq-1, a( 2, 1 ), lda, tau,
302  $ c( i1, i2 ), ldc, work, lwork, iinfo )
303  END IF
304  work( 1 ) = lwkopt
305  RETURN
306 *
307 * End of CUNMTR
308 *
309  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine cunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMTR
Definition: cunmtr.f:172
subroutine cunmql(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMQL
Definition: cunmql.f:168
subroutine cunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMQR
Definition: cunmqr.f:168