libflame  revision_anchor
Functions
zung2r.c File Reference

(r)

Functions

int zung2r_fla (integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *work, integer *info)
 

Function Documentation

◆ zung2r_fla()

int zung2r_fla ( integer m,
integer n,
integer k,
doublecomplex a,
integer lda,
doublecomplex tau,
doublecomplex work,
integer info 
)

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

Referenced by zungqr_fla().

106 {
107  /* System generated locals */
108  integer a_dim1, a_offset, i__1, i__2, i__3;
109  doublecomplex z__1;
110  /* Local variables */
111  integer i__, j, l;
112  extern /* Subroutine */
113  int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), 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_("ZUNG2R", &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.;
181  a[i__3].i = 0.; // , expr subst
182  /* L10: */
183  }
184  i__2 = j + j * a_dim1;
185  a[i__2].r = 1.;
186  a[i__2].i = 0.; // , 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.;
198  a[i__1].i = 0.; // , expr subst
199  i__1 = *m - i__ + 1;
200  i__2 = *n - i__;
201  zlarf_("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  z__1.r = -tau[i__2].r;
208  z__1.i = -tau[i__2].i; // , expr subst
209  zscal_(&i__1, &z__1, &a[i__ + 1 + i__ * a_dim1], &c__1);
210  }
211  i__1 = i__ + i__ * a_dim1;
212  i__2 = i__;
213  z__1.r = 1. - tau[i__2].r;
214  z__1.i = 0. - tau[i__2].i; // , expr subst
215  a[i__1].r = z__1.r;
216  a[i__1].i = z__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.;
225  a[i__2].i = 0.; // , expr subst
226  /* L30: */
227  }
228  /* L40: */
229  }
230  return 0;
231  /* End of ZUNG2R */
232 }
doublereal r
Definition: FLA_f2c.h:33
doublereal i
Definition: FLA_f2c.h:33
int integer
Definition: FLA_f2c.h:25
Definition: FLA_f2c.h:33