libflame  revision_anchor
Functions
dormtr.c File Reference

(r)

Functions

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

Function Documentation

◆ dormtr_fla()

int dormtr_fla ( char *  side,
char *  uplo,
char *  trans,
integer m,
integer n,
doublereal a,
integer lda,
doublereal tau,
doublereal c__,
integer ldc,
doublereal work,
integer lwork,
integer info 
)
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  extern /* Subroutine */
187  int dormql_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), dormqr_fla(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *);
188  integer lwkopt;
189  logical lquery;
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, "T"))
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, "DORMQL", 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, "DORMQL", 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, "DORMQR", 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, "DORMQR", ch__1, m, &i__2, &i__3, &c_n1);
296  }
297  }
298  lwkopt = max(1,nw) * nb;
299  work[1] = (doublereal) lwkopt;
300  }
301  if (*info != 0)
302  {
303  i__2 = -(*info);
304  xerbla_("DORMTR", &i__2);
305  return 0;
306  }
307  else if (lquery)
308  {
309  return 0;
310  }
311  /* Quick return if possible */
312  if (*m == 0 || *n == 0 || nq == 1)
313  {
314  work[1] = 1.;
315  return 0;
316  }
317  if (left)
318  {
319  mi = *m - 1;
320  ni = *n;
321  }
322  else
323  {
324  mi = *m;
325  ni = *n - 1;
326  }
327  if (upper)
328  {
329  /* Q was determined by a call to DSYTRD with UPLO = 'U' */
330  i__2 = nq - 1;
331  dormql_(side, trans, &mi, &ni, &i__2, &a[(a_dim1 << 1) + 1], lda, & tau[1], &c__[c_offset], ldc, &work[1], lwork, &iinfo);
332  }
333  else
334  {
335  /* Q was determined by a call to DSYTRD with UPLO = 'L' */
336  if (left)
337  {
338  i1 = 2;
339  i2 = 1;
340  }
341  else
342  {
343  i1 = 1;
344  i2 = 2;
345  }
346  i__2 = nq - 1;
347  dormqr_fla(side, trans, &mi, &ni, &i__2, &a[a_dim1 + 2], lda, &tau[1], & c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo);
348  }
349  work[1] = (doublereal) lwkopt;
350  return 0;
351  /* End of DORMTR */
352 }
double doublereal
Definition: FLA_f2c.h:31
int integer
Definition: FLA_f2c.h:25
int logical
Definition: FLA_f2c.h:36
int dormqr_fla(char *side, char *trans, integer *m, integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *c__, integer *ldc, doublereal *work, integer *lwork, integer *info)
Definition: dormqr.c:168

References dormqr_fla().