3 /* Subroutine */ int slasr_(char *side, char *pivot, char *direct, integer *m,
4 integer *n, real *c__, real *s, real *a, integer *lda)
6 /* System generated locals */
7 integer a_dim1, a_offset, i__1, i__2;
12 extern logical lsame_(char *, char *);
14 extern /* Subroutine */ int xerbla_(char *, integer *);
17 /* -- LAPACK auxiliary routine (version 3.1) -- */
18 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
21 /* .. Scalar Arguments .. */
23 /* .. Array Arguments .. */
29 /* SLASR applies a sequence of plane rotations to a real matrix A, */
30 /* from either the left or the right. */
32 /* When SIDE = 'L', the transformation takes the form */
36 /* and when SIDE = 'R', the transformation takes the form */
40 /* where P is an orthogonal matrix consisting of a sequence of z plane */
41 /* rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R', */
42 /* and P**T is the transpose of P. */
44 /* When DIRECT = 'F' (Forward sequence), then */
46 /* P = P(z-1) * ... * P(2) * P(1) */
48 /* and when DIRECT = 'B' (Backward sequence), then */
50 /* P = P(1) * P(2) * ... * P(z-1) */
52 /* where P(k) is a plane rotation matrix defined by the 2-by-2 rotation */
54 /* R(k) = ( c(k) s(k) ) */
55 /* = ( -s(k) c(k) ). */
57 /* When PIVOT = 'V' (Variable pivot), the rotation is performed */
58 /* for the plane (k,k+1), i.e., P(k) has the form */
69 /* where R(k) appears as a rank-2 modification to the identity matrix in */
70 /* rows and columns k and k+1. */
72 /* When PIVOT = 'T' (Top pivot), the rotation is performed for the */
73 /* plane (1,k+1), so P(k) has the form */
75 /* P(k) = ( c(k) s(k) ) */
84 /* where R(k) appears in rows and columns 1 and k+1. */
86 /* Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is */
87 /* performed for the plane (k,z), giving P(k) the form */
98 /* where R(k) appears in rows and columns k and z. The rotations are */
99 /* performed without ever forming P(k) explicitly. */
104 /* SIDE (input) CHARACTER*1 */
105 /* Specifies whether the plane rotation matrix P is applied to */
106 /* A on the left or the right. */
107 /* = 'L': Left, compute A := P*A */
108 /* = 'R': Right, compute A:= A*P**T */
110 /* PIVOT (input) CHARACTER*1 */
111 /* Specifies the plane for which P(k) is a plane rotation */
113 /* = 'V': Variable pivot, the plane (k,k+1) */
114 /* = 'T': Top pivot, the plane (1,k+1) */
115 /* = 'B': Bottom pivot, the plane (k,z) */
117 /* DIRECT (input) CHARACTER*1 */
118 /* Specifies whether P is a forward or backward sequence of */
119 /* plane rotations. */
120 /* = 'F': Forward, P = P(z-1)*...*P(2)*P(1) */
121 /* = 'B': Backward, P = P(1)*P(2)*...*P(z-1) */
123 /* M (input) INTEGER */
124 /* The number of rows of the matrix A. If m <= 1, an immediate */
125 /* return is effected. */
127 /* N (input) INTEGER */
128 /* The number of columns of the matrix A. If n <= 1, an */
129 /* immediate return is effected. */
131 /* C (input) REAL array, dimension */
132 /* (M-1) if SIDE = 'L' */
133 /* (N-1) if SIDE = 'R' */
134 /* The cosines c(k) of the plane rotations. */
136 /* S (input) REAL array, dimension */
137 /* (M-1) if SIDE = 'L' */
138 /* (N-1) if SIDE = 'R' */
139 /* The sines s(k) of the plane rotations. The 2-by-2 plane */
140 /* rotation part of the matrix P(k), R(k), has the form */
141 /* R(k) = ( c(k) s(k) ) */
142 /* ( -s(k) c(k) ). */
144 /* A (input/output) REAL array, dimension (LDA,N) */
145 /* The M-by-N matrix A. On exit, A is overwritten by P*A if */
146 /* SIDE = 'R' or by A*P**T if SIDE = 'L'. */
148 /* LDA (input) INTEGER */
149 /* The leading dimension of the array A. LDA >= max(1,M). */
151 /* ===================================================================== */
153 /* .. Parameters .. */
155 /* .. Local Scalars .. */
157 /* .. External Functions .. */
159 /* .. External Subroutines .. */
161 /* .. Intrinsic Functions .. */
163 /* .. Executable Statements .. */
165 /* Test the input parameters */
167 /* Parameter adjustments */
171 a_offset = 1 + a_dim1;
176 if (! (lsame_(side, "L") || lsame_(side, "R"))) {
178 } else if (! (lsame_(pivot, "V") || lsame_(pivot,
179 "T") || lsame_(pivot, "B"))) {
181 } else if (! (lsame_(direct, "F") || lsame_(direct,
188 } else if (*lda < max(1,*m)) {
192 xerbla_("SLASR ", &info);
196 /* Quick return if possible */
198 if (*m == 0 || *n == 0) {
201 if (lsame_(side, "L")) {
205 if (lsame_(pivot, "V")) {
206 if (lsame_(direct, "F")) {
208 for (j = 1; j <= i__1; ++j) {
211 if (ctemp != 1.f || stemp != 0.f) {
213 for (i__ = 1; i__ <= i__2; ++i__) {
214 temp = a[j + 1 + i__ * a_dim1];
215 a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp *
217 a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j
224 } else if (lsame_(direct, "B")) {
225 for (j = *m - 1; j >= 1; --j) {
228 if (ctemp != 1.f || stemp != 0.f) {
230 for (i__ = 1; i__ <= i__1; ++i__) {
231 temp = a[j + 1 + i__ * a_dim1];
232 a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp *
234 a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j
242 } else if (lsame_(pivot, "T")) {
243 if (lsame_(direct, "F")) {
245 for (j = 2; j <= i__1; ++j) {
248 if (ctemp != 1.f || stemp != 0.f) {
250 for (i__ = 1; i__ <= i__2; ++i__) {
251 temp = a[j + i__ * a_dim1];
252 a[j + i__ * a_dim1] = ctemp * temp - stemp * a[
254 a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[
261 } else if (lsame_(direct, "B")) {
262 for (j = *m; j >= 2; --j) {
265 if (ctemp != 1.f || stemp != 0.f) {
267 for (i__ = 1; i__ <= i__1; ++i__) {
268 temp = a[j + i__ * a_dim1];
269 a[j + i__ * a_dim1] = ctemp * temp - stemp * a[
271 a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[
279 } else if (lsame_(pivot, "B")) {
280 if (lsame_(direct, "F")) {
282 for (j = 1; j <= i__1; ++j) {
285 if (ctemp != 1.f || stemp != 0.f) {
287 for (i__ = 1; i__ <= i__2; ++i__) {
288 temp = a[j + i__ * a_dim1];
289 a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1]
291 a[*m + i__ * a_dim1] = ctemp * a[*m + i__ *
292 a_dim1] - stemp * temp;
298 } else if (lsame_(direct, "B")) {
299 for (j = *m - 1; j >= 1; --j) {
302 if (ctemp != 1.f || stemp != 0.f) {
304 for (i__ = 1; i__ <= i__1; ++i__) {
305 temp = a[j + i__ * a_dim1];
306 a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1]
308 a[*m + i__ * a_dim1] = ctemp * a[*m + i__ *
309 a_dim1] - stemp * temp;
317 } else if (lsame_(side, "R")) {
321 if (lsame_(pivot, "V")) {
322 if (lsame_(direct, "F")) {
324 for (j = 1; j <= i__1; ++j) {
327 if (ctemp != 1.f || stemp != 0.f) {
329 for (i__ = 1; i__ <= i__2; ++i__) {
330 temp = a[i__ + (j + 1) * a_dim1];
331 a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp *
333 a[i__ + j * a_dim1] = stemp * temp + ctemp * a[
340 } else if (lsame_(direct, "B")) {
341 for (j = *n - 1; j >= 1; --j) {
344 if (ctemp != 1.f || stemp != 0.f) {
346 for (i__ = 1; i__ <= i__1; ++i__) {
347 temp = a[i__ + (j + 1) * a_dim1];
348 a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp *
350 a[i__ + j * a_dim1] = stemp * temp + ctemp * a[
358 } else if (lsame_(pivot, "T")) {
359 if (lsame_(direct, "F")) {
361 for (j = 2; j <= i__1; ++j) {
364 if (ctemp != 1.f || stemp != 0.f) {
366 for (i__ = 1; i__ <= i__2; ++i__) {
367 temp = a[i__ + j * a_dim1];
368 a[i__ + j * a_dim1] = ctemp * temp - stemp * a[
370 a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ +
377 } else if (lsame_(direct, "B")) {
378 for (j = *n; j >= 2; --j) {
381 if (ctemp != 1.f || stemp != 0.f) {
383 for (i__ = 1; i__ <= i__1; ++i__) {
384 temp = a[i__ + j * a_dim1];
385 a[i__ + j * a_dim1] = ctemp * temp - stemp * a[
387 a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ +
395 } else if (lsame_(pivot, "B")) {
396 if (lsame_(direct, "F")) {
398 for (j = 1; j <= i__1; ++j) {
401 if (ctemp != 1.f || stemp != 0.f) {
403 for (i__ = 1; i__ <= i__2; ++i__) {
404 temp = a[i__ + j * a_dim1];
405 a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1]
407 a[i__ + *n * a_dim1] = ctemp * a[i__ + *n *
408 a_dim1] - stemp * temp;
414 } else if (lsame_(direct, "B")) {
415 for (j = *n - 1; j >= 1; --j) {
418 if (ctemp != 1.f || stemp != 0.f) {
420 for (i__ = 1; i__ <= i__1; ++i__) {
421 temp = a[i__ + j * a_dim1];
422 a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1]
424 a[i__ + *n * a_dim1] = ctemp * a[i__ + *n *
425 a_dim1] - stemp * temp;