libflame revision_anchor
Functions
cunmtr.c File Reference

(r)

Functions

int cunmtr_fla (char *side, char *uplo, char *trans, integer *m, integer *n, complex *a, integer *lda, complex *tau, complex *c__, integer *ldc, complex *work, integer *lwork, integer *info)
 

Function Documentation

◆ cunmtr_fla()

int cunmtr_fla ( char side,
char uplo,
char trans,
integer m,
integer n,
complex a,
integer lda,
complex tau,
complex c__,
integer ldc,
complex work,
integer lwork,
integer info 
)
171{
172 /* System generated locals */
174 char ch__1[2];
175 /* Builtin functions */
176 /* Subroutine */
177
178 /* Local variables */
179 integer i1, i2, nb, mi, ni, nq, nw;
181 extern logical lsame_(char *, char *);
184 extern /* Subroutine */
185 int xerbla_(char *, integer *);
186 extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *);
187 extern /* Subroutine */
188 int cunmql_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *), cunmqr_fla(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *);
191 /* -- LAPACK computational routine (version 3.4.0) -- */
192 /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
193 /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
194 /* November 2011 */
195 /* .. Scalar Arguments .. */
196 /* .. */
197 /* .. Array Arguments .. */
198 /* .. */
199 /* ===================================================================== */
200 /* .. Local Scalars .. */
201 /* .. */
202 /* .. External Functions .. */
203 /* .. */
204 /* .. External Subroutines .. */
205 /* .. */
206 /* .. Intrinsic Functions .. */
207 /* .. */
208 /* .. Executable Statements .. */
209 /* Test the input arguments */
210 /* Parameter adjustments */
211 a_dim1 = *lda;
212 a_offset = 1 + a_dim1;
213 a -= a_offset;
214 --tau;
215 c_dim1 = *ldc;
216 c_offset = 1 + c_dim1;
217 c__ -= c_offset;
218 --work;
219 /* Function Body */
220 *info = 0;
221 left = lsame_(side, "L");
222 upper = lsame_(uplo, "U");
223 lquery = *lwork == -1;
224 /* NQ is the order of Q and NW is the minimum dimension of WORK */
225 if (left)
226 {
227 nq = *m;
228 nw = *n;
229 }
230 else
231 {
232 nq = *n;
233 nw = *m;
234 }
235 if (! left && ! lsame_(side, "R"))
236 {
237 *info = -1;
238 }
239 else if (! upper && ! lsame_(uplo, "L"))
240 {
241 *info = -2;
242 }
243 else if (! lsame_(trans, "N") && ! lsame_(trans, "C"))
244 {
245 *info = -3;
246 }
247 else if (*m < 0)
248 {
249 *info = -4;
250 }
251 else if (*n < 0)
252 {
253 *info = -5;
254 }
255 else if (*lda < max(1,nq))
256 {
257 *info = -7;
258 }
259 else if (*ldc < max(1,*m))
260 {
261 *info = -10;
262 }
263 else if (*lwork < max(1,nw) && ! lquery)
264 {
265 *info = -12;
266 }
267 if (*info == 0)
268 {
269 if (upper)
270 {
271 if (left)
272 {
273 i__2 = *m - 1;
274 i__3 = *m - 1;
275 nb = ilaenv_(&c__1, "CUNMQL", ch__1, &i__2, n, &i__3, &c_n1);
276 }
277 else
278 {
279 i__2 = *n - 1;
280 i__3 = *n - 1;
281 nb = ilaenv_(&c__1, "CUNMQL", ch__1, m, &i__2, &i__3, &c_n1);
282 }
283 }
284 else
285 {
286 if (left)
287 {
288 i__2 = *m - 1;
289 i__3 = *m - 1;
290 nb = ilaenv_(&c__1, "CUNMQR", ch__1, &i__2, n, &i__3, &c_n1);
291 }
292 else
293 {
294 i__2 = *n - 1;
295 i__3 = *n - 1;
296 nb = ilaenv_(&c__1, "CUNMQR", ch__1, m, &i__2, &i__3, &c_n1);
297 }
298 }
299 lwkopt = max(1,nw) * nb;
300 work[1].r = (real) lwkopt;
301 work[1].i = 0.f; // , expr subst
302 }
303 if (*info != 0)
304 {
305 i__2 = -(*info);
306 xerbla_("CUNMTR", &i__2);
307 return 0;
308 }
309 else if (lquery)
310 {
311 return 0;
312 }
313 /* Quick return if possible */
314 if (*m == 0 || *n == 0 || nq == 1)
315 {
316 work[1].r = 1.f;
317 work[1].i = 0.f; // , expr subst
318 return 0;
319 }
320 if (left)
321 {
322 mi = *m - 1;
323 ni = *n;
324 }
325 else
326 {
327 mi = *m;
328 ni = *n - 1;
329 }
330 if (upper)
331 {
332 /* Q was determined by a call to CHETRD with UPLO = 'U' */
333 i__2 = nq - 1;
334 cunmql_(side, trans, &mi, &ni, &i__2, &a[(a_dim1 << 1) + 1], lda, & tau[1], &c__[c_offset], ldc, &work[1], lwork, &iinfo);
335 }
336 else
337 {
338 /* Q was determined by a call to CHETRD with UPLO = 'L' */
339 if (left)
340 {
341 i1 = 2;
342 i2 = 1;
343 }
344 else
345 {
346 i1 = 1;
347 i2 = 2;
348 }
349 i__2 = nq - 1;
350 cunmqr_fla(side, trans, &mi, &ni, &i__2, &a[a_dim1 + 2], lda, &tau[1], & c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo);
351 }
352 work[1].r = (real) lwkopt;
353 work[1].i = 0.f; // , expr subst
354 return 0;
355 /* End of CUNMTR */
356}
int integer
Definition FLA_f2c.h:25
int logical
Definition FLA_f2c.h:36
float real
Definition FLA_f2c.h:30
int i
Definition bl1_axmyv2.c:145
int cunmqr_fla(char *side, char *trans, integer *m, integer *n, integer *k, complex *a, integer *lda, complex *tau, complex *c__, integer *ldc, complex *work, integer *lwork, integer *info)
Definition cunmqr.c:169
Definition FLA_f2c.h:32

References cunmqr_fla(), and i.