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 */
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
int i
Definition bl1_axmyv2.c:145

References i.

Referenced by sorglq_fla().