libflame  revision_anchor
Functions
sormhr.c File Reference

(r)

Functions

int sormhr_ (char *side, char *trans, integer *m, integer *n, integer *ilo, integer *ihi, real *a, integer *lda, real *tau, real *c__, integer *ldc, real *work, integer *lwork, integer *info)
 

Function Documentation

◆ sormhr_()

int sormhr_ ( char *  side,
char *  trans,
integer m,
integer n,
integer ilo,
integer ihi,
real a,
integer lda,
real tau,
real c__,
integer ldc,
real work,
integer lwork,
integer info 
)

References sormqr_fla().

177 {
178  /* System generated locals */
179  integer a_dim1, a_offset, c_dim1, c_offset, i__2;
180  char ch__1[2];
181  /* Builtin functions */
182  /* Subroutine */
183 
184  /* Local variables */
185  integer i1, i2, nb, mi, nh, ni, nq, nw;
186  logical left;
187  extern logical lsame_(char *, char *);
188  integer iinfo;
189  extern /* Subroutine */
190  int xerbla_(char *, integer *);
191  extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *);
192  integer lwkopt;
193  logical lquery;
194  extern /* Subroutine */
195  int sormqr_fla(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, integer *);
196  /* -- LAPACK computational routine (version 3.4.0) -- */
197  /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
198  /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
199  /* November 2011 */
200  /* .. Scalar Arguments .. */
201  /* .. */
202  /* .. Array Arguments .. */
203  /* .. */
204  /* ===================================================================== */
205  /* .. Local Scalars .. */
206  /* .. */
207  /* .. External Functions .. */
208  /* .. */
209  /* .. External Subroutines .. */
210  /* .. */
211  /* .. Intrinsic Functions .. */
212  /* .. */
213  /* .. Executable Statements .. */
214  /* Test the input arguments */
215  /* Parameter adjustments */
216  a_dim1 = *lda;
217  a_offset = 1 + a_dim1;
218  a -= a_offset;
219  --tau;
220  c_dim1 = *ldc;
221  c_offset = 1 + c_dim1;
222  c__ -= c_offset;
223  --work;
224  /* Function Body */
225  *info = 0;
226  nh = *ihi - *ilo;
227  left = lsame_(side, "L");
228  lquery = *lwork == -1;
229  /* NQ is the order of Q and NW is the minimum dimension of WORK */
230  if (left)
231  {
232  nq = *m;
233  nw = *n;
234  }
235  else
236  {
237  nq = *n;
238  nw = *m;
239  }
240  if (! left && ! lsame_(side, "R"))
241  {
242  *info = -1;
243  }
244  else if (! lsame_(trans, "N") && ! lsame_(trans, "T"))
245  {
246  *info = -2;
247  }
248  else if (*m < 0)
249  {
250  *info = -3;
251  }
252  else if (*n < 0)
253  {
254  *info = -4;
255  }
256  else if (*ilo < 1 || *ilo > max(1,nq))
257  {
258  *info = -5;
259  }
260  else if (*ihi < min(*ilo,nq) || *ihi > nq)
261  {
262  *info = -6;
263  }
264  else if (*lda < max(1,nq))
265  {
266  *info = -8;
267  }
268  else if (*ldc < max(1,*m))
269  {
270  *info = -11;
271  }
272  else if (*lwork < max(1,nw) && ! lquery)
273  {
274  *info = -13;
275  }
276  if (*info == 0)
277  {
278  if (left)
279  {
280  nb = ilaenv_(&c__1, "SORMQR", ch__1, &nh, n, &nh, &c_n1);
281  }
282  else
283  {
284  nb = ilaenv_(&c__1, "SORMQR", ch__1, m, &nh, &nh, &c_n1);
285  }
286  lwkopt = max(1,nw) * nb;
287  work[1] = (real) lwkopt;
288  }
289  if (*info != 0)
290  {
291  i__2 = -(*info);
292  xerbla_("SORMHR", &i__2);
293  return 0;
294  }
295  else if (lquery)
296  {
297  return 0;
298  }
299  /* Quick return if possible */
300  if (*m == 0 || *n == 0 || nh == 0)
301  {
302  work[1] = 1.f;
303  return 0;
304  }
305  if (left)
306  {
307  mi = nh;
308  ni = *n;
309  i1 = *ilo + 1;
310  i2 = 1;
311  }
312  else
313  {
314  mi = *m;
315  ni = nh;
316  i1 = 1;
317  i2 = *ilo + 1;
318  }
319  sormqr_fla(side, trans, &mi, &ni, &nh, &a[*ilo + 1 + *ilo * a_dim1], lda, & tau[*ilo], &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo);
320  work[1] = (real) lwkopt;
321  return 0;
322  /* End of SORMHR */
323 }
float real
Definition: FLA_f2c.h:30
int logical
Definition: FLA_f2c.h:36
int integer
Definition: FLA_f2c.h:25
int sormqr_fla(char *side, char *trans, integer *m, integer *n, integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc, real *work, integer *lwork, integer *info)
Definition: sormqr.c:169