libflame  revision_anchor
Functions
zunmtr.c File Reference

(r)

Functions

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

Function Documentation

◆ zunmtr_fla()

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

References zunmqr_fla().

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