libflame revision_anchor
Functions
zunmqr.c File Reference

(r)

Functions

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)
 

Function Documentation

◆ zunmqr_fla()

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 
)
169{
170 /* System generated locals */
172 char ch__1[2];
173 /* Builtin functions */
174 /* Subroutine */
175
176 /* Local variables */
177 integer i__;
178 doublecomplex t[4160] /* was [65][64] */
179 ;
180 integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
182 extern logical lsame_(char *, char *);
184 extern /* Subroutine */
185 int zunm2r_fla(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *);
186 extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *);
187 extern /* Subroutine */
188 int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *);
191 extern /* Subroutine */
192 int zlarft_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *);
195 /* -- LAPACK computational routine (version 3.4.0) -- */
196 /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
197 /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
198 /* November 2011 */
199 /* .. Scalar Arguments .. */
200 /* .. */
201 /* .. Array Arguments .. */
202 /* .. */
203 /* ===================================================================== */
204 /* .. Parameters .. */
205 /* .. */
206 /* .. Local Scalars .. */
207 /* .. */
208 /* .. Local Arrays .. */
209 /* .. */
210 /* .. External Functions .. */
211 /* .. */
212 /* .. External Subroutines .. */
213 /* .. */
214 /* .. Intrinsic Functions .. */
215 /* .. */
216 /* .. Executable Statements .. */
217 /* Test the input arguments */
218 /* Parameter adjustments */
219 a_dim1 = *lda;
220 a_offset = 1 + a_dim1;
221 a -= a_offset;
222 --tau;
223 c_dim1 = *ldc;
224 c_offset = 1 + c_dim1;
225 c__ -= c_offset;
226 --work;
227 /* Function Body */
228 *info = 0;
229 left = lsame_(side, "L");
230 notran = lsame_(trans, "N");
231 lquery = *lwork == -1;
232 /* NQ is the order of Q and NW is the minimum dimension of WORK */
233 if (left)
234 {
235 nq = *m;
236 nw = *n;
237 }
238 else
239 {
240 nq = *n;
241 nw = *m;
242 }
243 if (! left && ! lsame_(side, "R"))
244 {
245 *info = -1;
246 }
247 else if (! notran && ! lsame_(trans, "C"))
248 {
249 *info = -2;
250 }
251 else if (*m < 0)
252 {
253 *info = -3;
254 }
255 else if (*n < 0)
256 {
257 *info = -4;
258 }
259 else if (*k < 0 || *k > nq)
260 {
261 *info = -5;
262 }
263 else if (*lda < max(1,nq))
264 {
265 *info = -7;
266 }
267 else if (*ldc < max(1,*m))
268 {
269 *info = -10;
270 }
271 else if (*lwork < max(1,nw) && ! lquery)
272 {
273 *info = -12;
274 }
275 if (*info == 0)
276 {
277 /* Determine the block size. NB may be at most NBMAX, where NBMAX */
278 /* is used to define the local array T. */
279 /* Computing MIN */
280 i__1 = 64;
281 i__2 = ilaenv_(&c__1, "ZUNMQR", ch__1, m, n, k, &c_n1); // , expr subst
282 nb = min(i__1,i__2);
283 lwkopt = max(1,nw) * nb;
284 work[1].r = (doublereal) lwkopt;
285 work[1].i = 0.; // , expr subst
286 }
287 if (*info != 0)
288 {
289 i__1 = -(*info);
290 xerbla_("ZUNMQR", &i__1);
291 return 0;
292 }
293 else if (lquery)
294 {
295 return 0;
296 }
297 /* Quick return if possible */
298 if (*m == 0 || *n == 0 || *k == 0)
299 {
300 work[1].r = 1.;
301 work[1].i = 0.; // , expr subst
302 return 0;
303 }
304 nbmin = 2;
305 ldwork = nw;
306 if (nb > 1 && nb < *k)
307 {
308 iws = nw * nb;
309 if (*lwork < iws)
310 {
311 nb = *lwork / ldwork;
312 /* Computing MAX */
313 i__1 = 2;
314 i__2 = ilaenv_(&c__2, "ZUNMQR", ch__1, m, n, k, &c_n1); // , expr subst
315 nbmin = max(i__1,i__2);
316 }
317 }
318 else
319 {
320 iws = nw;
321 }
322 if (nb < nbmin || nb >= *k)
323 {
324 /* Use unblocked code */
325 zunm2r_fla(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[ c_offset], ldc, &work[1], &iinfo);
326 }
327 else
328 {
329 /* Use blocked code */
330 if (left && ! notran || ! left && notran)
331 {
332 i1 = 1;
333 i2 = *k;
334 i3 = nb;
335 }
336 else
337 {
338 i1 = (*k - 1) / nb * nb + 1;
339 i2 = 1;
340 i3 = -nb;
341 }
342 if (left)
343 {
344 ni = *n;
345 jc = 1;
346 }
347 else
348 {
349 mi = *m;
350 ic = 1;
351 }
352 i__1 = i2;
353 i__2 = i3;
354 for (i__ = i1;
356 i__ += i__2)
357 {
358 /* Computing MIN */
359 i__4 = nb;
360 i__5 = *k - i__ + 1; // , expr subst
361 ib = min(i__4,i__5);
362 /* Form the triangular factor of the block reflector */
363 /* H = H(i) H(i+1) . . . H(i+ib-1) */
364 i__4 = nq - i__ + 1;
365 zlarft_("Forward", "Columnwise", &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], t, &c__65) ;
366 if (left)
367 {
368 /* H or H**H is applied to C(i:m,1:n) */
369 mi = *m - i__ + 1;
370 ic = i__;
371 }
372 else
373 {
374 /* H or H**H is applied to C(1:m,i:n) */
375 ni = *n - i__ + 1;
376 jc = i__;
377 }
378 /* Apply H or H**H */
379 zlarfb_(side, trans, "Forward", "Columnwise", &mi, &ni, &ib, &a[ i__ + i__ * a_dim1], lda, t, &c__65, &c__[ic + jc * c_dim1], ldc, &work[1], &ldwork);
380 /* L10: */
381 }
382 }
383 work[1].r = (doublereal) lwkopt;
384 work[1].i = 0.; // , expr subst
385 return 0;
386 /* End of ZUNMQR */
387}
double doublereal
Definition FLA_f2c.h:31
int integer
Definition FLA_f2c.h:25
int logical
Definition FLA_f2c.h:36
int i
Definition bl1_axmyv2.c:145
Definition FLA_f2c.h:33
int zunm2r_fla(char *side, char *trans, integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info)
Definition zunm2r.c:151

References i, and zunm2r_fla().

Referenced by zunmtr_fla().