libflame  revision_anchor
Functions
zunml2.c File Reference

(r)

Functions

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

Function Documentation

◆ zunml2_fla()

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

References doublecomplex::i, and doublecomplex::r.

Referenced by zunmlq_fla().