libflame revision_anchor
Functions
cunml2.c File Reference

(r)

Functions

int cunml2_fla (char *side, char *trans, integer *m, integer *n, integer *k, complex *a, integer *lda, complex *tau, complex *c__, integer *ldc, complex *work, integer *info)
 

Function Documentation

◆ cunml2_fla()

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

References i.

Referenced by cunmlq_fla().