3 /* Table of constant values */
5 static real c_b4 = 1.f;
6 static real c_b5 = 0.f;
7 static integer c__1 = 1;
9 /* Subroutine */ int slarf_(char *side, integer *m, integer *n, real *v,
10 integer *incv, real *tau, real *c__, integer *ldc, real *work)
12 /* System generated locals */
13 integer c_dim1, c_offset;
17 extern /* Subroutine */ int sger_(integer *, integer *, real *, real *,
18 integer *, real *, integer *, real *, integer *);
19 extern logical lsame_(char *, char *);
20 extern /* Subroutine */ int sgemv_(char *, integer *, integer *, real *,
21 real *, integer *, real *, integer *, real *, real *, integer *);
24 /* -- LAPACK auxiliary routine (version 3.1) -- */
25 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
28 /* .. Scalar Arguments .. */
30 /* .. Array Arguments .. */
36 /* SLARF applies a real elementary reflector H to a real m by n matrix */
37 /* C, from either the left or the right. H is represented in the form */
39 /* H = I - tau * v * v' */
41 /* where tau is a real scalar and v is a real vector. */
43 /* If tau = 0, then H is taken to be the unit matrix. */
48 /* SIDE (input) CHARACTER*1 */
49 /* = 'L': form H * C */
50 /* = 'R': form C * H */
52 /* M (input) INTEGER */
53 /* The number of rows of the matrix C. */
55 /* N (input) INTEGER */
56 /* The number of columns of the matrix C. */
58 /* V (input) REAL array, dimension */
59 /* (1 + (M-1)*abs(INCV)) if SIDE = 'L' */
60 /* or (1 + (N-1)*abs(INCV)) if SIDE = 'R' */
61 /* The vector v in the representation of H. V is not used if */
64 /* INCV (input) INTEGER */
65 /* The increment between elements of v. INCV <> 0. */
67 /* TAU (input) REAL */
68 /* The value tau in the representation of H. */
70 /* C (input/output) REAL array, dimension (LDC,N) */
71 /* On entry, the m by n matrix C. */
72 /* On exit, C is overwritten by the matrix H * C if SIDE = 'L', */
73 /* or C * H if SIDE = 'R'. */
75 /* LDC (input) INTEGER */
76 /* The leading dimension of the array C. LDC >= max(1,M). */
78 /* WORK (workspace) REAL array, dimension */
79 /* (N) if SIDE = 'L' */
80 /* or (M) if SIDE = 'R' */
82 /* ===================================================================== */
84 /* .. Parameters .. */
86 /* .. External Subroutines .. */
88 /* .. External Functions .. */
90 /* .. Executable Statements .. */
92 /* Parameter adjustments */
95 c_offset = 1 + c_dim1;
100 if (lsame_(side, "L")) {
108 sgemv_("Transpose", m, n, &c_b4, &c__[c_offset], ldc, &v[1], incv,
109 &c_b5, &work[1], &c__1);
111 /* C := C - v * w' */
114 sger_(m, n, &r__1, &v[1], incv, &work[1], &c__1, &c__[c_offset],
125 sgemv_("No transpose", m, n, &c_b4, &c__[c_offset], ldc, &v[1],
126 incv, &c_b5, &work[1], &c__1);
128 /* C := C - w * v' */
131 sger_(m, n, &r__1, &work[1], &c__1, &v[1], incv, &c__[c_offset],