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 
)

References cunmqr_fla().

171 {
172  /* System generated locals */
173  integer a_dim1, a_offset, c_dim1, c_offset, i__2, i__3;
174  char ch__1[2];
175  /* Builtin functions */
176  /* Subroutine */
177 
178  /* Local variables */
179  integer i1, i2, nb, mi, ni, nq, nw;
180  logical left;
181  extern logical lsame_(char *, char *);
182  integer iinfo;
183  logical upper;
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 *);
189  integer lwkopt;
190  logical lquery;
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 }
real i
Definition: FLA_f2c.h:32
float real
Definition: FLA_f2c.h:30
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
int logical
Definition: FLA_f2c.h:36
int integer
Definition: FLA_f2c.h:25
Definition: FLA_f2c.h:32
real r
Definition: FLA_f2c.h:32