libflame  revision_anchor
Functions
cunm2r.c File Reference

(r)

Functions

int cunm2r_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

◆ cunm2r_fla()

int cunm2r_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 
)

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

Referenced by cunmqr_fla().

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