libflame  revision_anchor
Functions
sorgl2.c File Reference

(r)

Functions

int sorgl2_fla (integer *m, integer *n, integer *k, real *a, integer *lda, real *tau, real *work, integer *info)
 

Function Documentation

◆ sorgl2_fla()

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

Referenced by sorglq_fla().