libflame  revision_anchor
Functions
cung2r.c File Reference

(r)

Functions

int cung2r_fla (integer *m, integer *n, integer *k, complex *a, integer *lda, complex *tau, complex *work, integer *info)
 

Function Documentation

◆ cung2r_fla()

int cung2r_fla ( integer m,
integer n,
integer k,
complex a,
integer lda,
complex tau,
complex work,
integer info 
)
106 {
107  /* System generated locals */
108  integer a_dim1, a_offset, i__1, i__2, i__3;
109  complex q__1;
110  /* Local variables */
111  integer i__, j, l;
112  extern /* Subroutine */
113  int cscal_(integer *, complex *, complex *, integer *), clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *);
114  /* -- LAPACK computational routine (version 3.4.0) -- */
115  /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
116  /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
117  /* November 2011 */
118  /* .. Scalar Arguments .. */
119  /* .. */
120  /* .. Array Arguments .. */
121  /* .. */
122  /* ===================================================================== */
123  /* .. Parameters .. */
124  /* .. */
125  /* .. Local Scalars .. */
126  /* .. */
127  /* .. External Subroutines .. */
128  /* .. */
129  /* .. Intrinsic Functions .. */
130  /* .. */
131  /* .. Executable Statements .. */
132  /* Test the input arguments */
133  /* Parameter adjustments */
134  a_dim1 = *lda;
135  a_offset = 1 + a_dim1;
136  a -= a_offset;
137  --tau;
138  --work;
139  /* Function Body */
140  *info = 0;
141  if (*m < 0)
142  {
143  *info = -1;
144  }
145  else if (*n < 0 || *n > *m)
146  {
147  *info = -2;
148  }
149  else if (*k < 0 || *k > *n)
150  {
151  *info = -3;
152  }
153  else if (*lda < max(1,*m))
154  {
155  *info = -5;
156  }
157  if (*info != 0)
158  {
159  i__1 = -(*info);
160  xerbla_("CUNG2R", &i__1);
161  return 0;
162  }
163  /* Quick return if possible */
164  if (*n <= 0)
165  {
166  return 0;
167  }
168  /* Initialise columns k+1:n to columns of the unit matrix */
169  i__1 = *n;
170  for (j = *k + 1;
171  j <= i__1;
172  ++j)
173  {
174  i__2 = *m;
175  for (l = 1;
176  l <= i__2;
177  ++l)
178  {
179  i__3 = l + j * a_dim1;
180  a[i__3].r = 0.f;
181  a[i__3].i = 0.f; // , expr subst
182  /* L10: */
183  }
184  i__2 = j + j * a_dim1;
185  a[i__2].r = 1.f;
186  a[i__2].i = 0.f; // , expr subst
187  /* L20: */
188  }
189  for (i__ = *k;
190  i__ >= 1;
191  --i__)
192  {
193  /* Apply H(i) to A(i:m,i:n) from the left */
194  if (i__ < *n)
195  {
196  i__1 = i__ + i__ * a_dim1;
197  a[i__1].r = 1.f;
198  a[i__1].i = 0.f; // , expr subst
199  i__1 = *m - i__ + 1;
200  i__2 = *n - i__;
201  clarf_("Left", &i__1, &i__2, &a[i__ + i__ * a_dim1], &c__1, &tau[ i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1]);
202  }
203  if (i__ < *m)
204  {
205  i__1 = *m - i__;
206  i__2 = i__;
207  q__1.r = -tau[i__2].r;
208  q__1.i = -tau[i__2].i; // , expr subst
209  cscal_(&i__1, &q__1, &a[i__ + 1 + i__ * a_dim1], &c__1);
210  }
211  i__1 = i__ + i__ * a_dim1;
212  i__2 = i__;
213  q__1.r = 1.f - tau[i__2].r;
214  q__1.i = 0.f - tau[i__2].i; // , expr subst
215  a[i__1].r = q__1.r;
216  a[i__1].i = q__1.i; // , expr subst
217  /* Set A(1:i-1,i) to zero */
218  i__1 = i__ - 1;
219  for (l = 1;
220  l <= i__1;
221  ++l)
222  {
223  i__2 = l + i__ * a_dim1;
224  a[i__2].r = 0.f;
225  a[i__2].i = 0.f; // , expr subst
226  /* L30: */
227  }
228  /* L40: */
229  }
230  return 0;
231  /* End of CUNG2R */
232 }
int integer
Definition: FLA_f2c.h:25
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 cungqr_fla().