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 
)
177{
178 /* System generated locals */
180 char ch__1[2];
181 /* Builtin functions */
182 /* Subroutine */
183
184 /* Local variables */
185 integer i1, i2, nb, mi, nh, ni, nq, nw;
187 extern logical lsame_(char *, char *);
189 extern /* Subroutine */
190 int xerbla_(char *, integer *);
191 extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *);
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}
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 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

References i, and sormqr_fla().