libflame  revision_anchor
Functions
cunml2.c File Reference

(r)

Functions

int cunml2_fla (char *side, char *trans, integer *m, integer *n, integer *k, complex *a, integer *lda, complex *tau, complex *c__, integer *ldc, complex *work, integer *info)
 

Function Documentation

◆ cunml2_fla()

int cunml2_fla ( char *  side,
char *  trans,
integer m,
integer n,
integer k,
complex a,
integer lda,
complex tau,
complex c__,
integer ldc,
complex work,
integer info 
)
149 {
150  /* System generated locals */
151  integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;
152  complex q__1;
153  /* Builtin functions */
154  void r_cnjg(complex *, complex *);
155  /* Local variables */
156  integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
157  complex aii;
158  logical left;
159  complex taui;
160  extern /* Subroutine */
161  int clarf_(char *, integer *, integer *, complex * , integer *, complex *, complex *, integer *, complex *);
162  extern logical lsame_(char *, char *);
163  extern /* Subroutine */
164  int clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *);
165  logical notran;
166  /* -- LAPACK computational routine (version 3.4.2) -- */
167  /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
168  /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
169  /* September 2012 */
170  /* .. Scalar Arguments .. */
171  /* .. */
172  /* .. Array Arguments .. */
173  /* .. */
174  /* ===================================================================== */
175  /* .. Parameters .. */
176  /* .. */
177  /* .. Local Scalars .. */
178  /* .. */
179  /* .. External Functions .. */
180  /* .. */
181  /* .. External Subroutines .. */
182  /* .. */
183  /* .. Intrinsic Functions .. */
184  /* .. */
185  /* .. Executable Statements .. */
186  /* Test the input arguments */
187  /* Parameter adjustments */
188  a_dim1 = *lda;
189  a_offset = 1 + a_dim1;
190  a -= a_offset;
191  --tau;
192  c_dim1 = *ldc;
193  c_offset = 1 + c_dim1;
194  c__ -= c_offset;
195  --work;
196  /* Function Body */
197  *info = 0;
198  left = lsame_(side, "L");
199  notran = lsame_(trans, "N");
200  /* NQ is the order of Q */
201  if (left)
202  {
203  nq = *m;
204  }
205  else
206  {
207  nq = *n;
208  }
209  if (! left && ! lsame_(side, "R"))
210  {
211  *info = -1;
212  }
213  else if (! notran && ! lsame_(trans, "C"))
214  {
215  *info = -2;
216  }
217  else if (*m < 0)
218  {
219  *info = -3;
220  }
221  else if (*n < 0)
222  {
223  *info = -4;
224  }
225  else if (*k < 0 || *k > nq)
226  {
227  *info = -5;
228  }
229  else if (*lda < max(1,*k))
230  {
231  *info = -7;
232  }
233  else if (*ldc < max(1,*m))
234  {
235  *info = -10;
236  }
237  if (*info != 0)
238  {
239  i__1 = -(*info);
240  xerbla_("CUNML2", &i__1);
241  return 0;
242  }
243  /* Quick return if possible */
244  if (*m == 0 || *n == 0 || *k == 0)
245  {
246  return 0;
247  }
248  if (left && notran || ! left && ! notran)
249  {
250  i1 = 1;
251  i2 = *k;
252  i3 = 1;
253  }
254  else
255  {
256  i1 = *k;
257  i2 = 1;
258  i3 = -1;
259  }
260  if (left)
261  {
262  ni = *n;
263  jc = 1;
264  }
265  else
266  {
267  mi = *m;
268  ic = 1;
269  }
270  i__1 = i2;
271  i__2 = i3;
272  for (i__ = i1;
273  i__2 < 0 ? i__ >= i__1 : i__ <= i__1;
274  i__ += i__2)
275  {
276  if (left)
277  {
278  /* H(i) or H(i)**H is applied to C(i:m,1:n) */
279  mi = *m - i__ + 1;
280  ic = i__;
281  }
282  else
283  {
284  /* H(i) or H(i)**H is applied to C(1:m,i:n) */
285  ni = *n - i__ + 1;
286  jc = i__;
287  }
288  /* Apply H(i) or H(i)**H */
289  if (notran)
290  {
291  r_cnjg(&q__1, &tau[i__]);
292  taui.r = q__1.r;
293  taui.i = q__1.i; // , expr subst
294  }
295  else
296  {
297  i__3 = i__;
298  taui.r = tau[i__3].r;
299  taui.i = tau[i__3].i; // , expr subst
300  }
301  if (i__ < nq)
302  {
303  i__3 = nq - i__;
304  clacgv_(&i__3, &a[i__ + (i__ + 1) * a_dim1], lda);
305  }
306  i__3 = i__ + i__ * a_dim1;
307  aii.r = a[i__3].r;
308  aii.i = a[i__3].i; // , expr subst
309  i__3 = i__ + i__ * a_dim1;
310  a[i__3].r = 1.f;
311  a[i__3].i = 0.f; // , expr subst
312  clarf_(side, &mi, &ni, &a[i__ + i__ * a_dim1], lda, &taui, &c__[ic + jc * c_dim1], ldc, &work[1]);
313  i__3 = i__ + i__ * a_dim1;
314  a[i__3].r = aii.r;
315  a[i__3].i = aii.i; // , expr subst
316  if (i__ < nq)
317  {
318  i__3 = nq - i__;
319  clacgv_(&i__3, &a[i__ + (i__ + 1) * a_dim1], lda);
320  }
321  /* L10: */
322  }
323  return 0;
324  /* End of CUNML2 */
325 }
int integer
Definition: FLA_f2c.h:25
int logical
Definition: FLA_f2c.h:36
Definition: FLA_f2c.h:32
real r
Definition: FLA_f2c.h:32
real i
Definition: FLA_f2c.h:32

References complex::i, and complex::r.

Referenced by cunmlq_fla().