1*> \brief \b SLASR applies a sequence of plane rotations to a general rectangular matrix. 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download SLASR + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasr.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasr.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasr.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE SLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA ) 22* 23* .. Scalar Arguments .. 24* CHARACTER DIRECT, PIVOT, SIDE 25* INTEGER LDA, M, N 26* .. 27* .. Array Arguments .. 28* REAL A( LDA, * ), C( * ), S( * ) 29* .. 30* 31* 32*> \par Purpose: 33* ============= 34*> 35*> \verbatim 36*> 37*> SLASR applies a sequence of plane rotations to a real matrix A, 38*> from either the left or the right. 39*> 40*> When SIDE = 'L', the transformation takes the form 41*> 42*> A := P*A 43*> 44*> and when SIDE = 'R', the transformation takes the form 45*> 46*> A := A*P**T 47*> 48*> where P is an orthogonal matrix consisting of a sequence of z plane 49*> rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R', 50*> and P**T is the transpose of P. 51*> 52*> When DIRECT = 'F' (Forward sequence), then 53*> 54*> P = P(z-1) * ... * P(2) * P(1) 55*> 56*> and when DIRECT = 'B' (Backward sequence), then 57*> 58*> P = P(1) * P(2) * ... * P(z-1) 59*> 60*> where P(k) is a plane rotation matrix defined by the 2-by-2 rotation 61*> 62*> R(k) = ( c(k) s(k) ) 63*> = ( -s(k) c(k) ). 64*> 65*> When PIVOT = 'V' (Variable pivot), the rotation is performed 66*> for the plane (k,k+1), i.e., P(k) has the form 67*> 68*> P(k) = ( 1 ) 69*> ( ... ) 70*> ( 1 ) 71*> ( c(k) s(k) ) 72*> ( -s(k) c(k) ) 73*> ( 1 ) 74*> ( ... ) 75*> ( 1 ) 76*> 77*> where R(k) appears as a rank-2 modification to the identity matrix in 78*> rows and columns k and k+1. 79*> 80*> When PIVOT = 'T' (Top pivot), the rotation is performed for the 81*> plane (1,k+1), so P(k) has the form 82*> 83*> P(k) = ( c(k) s(k) ) 84*> ( 1 ) 85*> ( ... ) 86*> ( 1 ) 87*> ( -s(k) c(k) ) 88*> ( 1 ) 89*> ( ... ) 90*> ( 1 ) 91*> 92*> where R(k) appears in rows and columns 1 and k+1. 93*> 94*> Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is 95*> performed for the plane (k,z), giving P(k) the form 96*> 97*> P(k) = ( 1 ) 98*> ( ... ) 99*> ( 1 ) 100*> ( c(k) s(k) ) 101*> ( 1 ) 102*> ( ... ) 103*> ( 1 ) 104*> ( -s(k) c(k) ) 105*> 106*> where R(k) appears in rows and columns k and z. The rotations are 107*> performed without ever forming P(k) explicitly. 108*> \endverbatim 109* 110* Arguments: 111* ========== 112* 113*> \param[in] SIDE 114*> \verbatim 115*> SIDE is CHARACTER*1 116*> Specifies whether the plane rotation matrix P is applied to 117*> A on the left or the right. 118*> = 'L': Left, compute A := P*A 119*> = 'R': Right, compute A:= A*P**T 120*> \endverbatim 121*> 122*> \param[in] PIVOT 123*> \verbatim 124*> PIVOT is CHARACTER*1 125*> Specifies the plane for which P(k) is a plane rotation 126*> matrix. 127*> = 'V': Variable pivot, the plane (k,k+1) 128*> = 'T': Top pivot, the plane (1,k+1) 129*> = 'B': Bottom pivot, the plane (k,z) 130*> \endverbatim 131*> 132*> \param[in] DIRECT 133*> \verbatim 134*> DIRECT is CHARACTER*1 135*> Specifies whether P is a forward or backward sequence of 136*> plane rotations. 137*> = 'F': Forward, P = P(z-1)*...*P(2)*P(1) 138*> = 'B': Backward, P = P(1)*P(2)*...*P(z-1) 139*> \endverbatim 140*> 141*> \param[in] M 142*> \verbatim 143*> M is INTEGER 144*> The number of rows of the matrix A. If m <= 1, an immediate 145*> return is effected. 146*> \endverbatim 147*> 148*> \param[in] N 149*> \verbatim 150*> N is INTEGER 151*> The number of columns of the matrix A. If n <= 1, an 152*> immediate return is effected. 153*> \endverbatim 154*> 155*> \param[in] C 156*> \verbatim 157*> C is REAL array, dimension 158*> (M-1) if SIDE = 'L' 159*> (N-1) if SIDE = 'R' 160*> The cosines c(k) of the plane rotations. 161*> \endverbatim 162*> 163*> \param[in] S 164*> \verbatim 165*> S is REAL array, dimension 166*> (M-1) if SIDE = 'L' 167*> (N-1) if SIDE = 'R' 168*> The sines s(k) of the plane rotations. The 2-by-2 plane 169*> rotation part of the matrix P(k), R(k), has the form 170*> R(k) = ( c(k) s(k) ) 171*> ( -s(k) c(k) ). 172*> \endverbatim 173*> 174*> \param[in,out] A 175*> \verbatim 176*> A is REAL array, dimension (LDA,N) 177*> The M-by-N matrix A. On exit, A is overwritten by P*A if 178*> SIDE = 'R' or by A*P**T if SIDE = 'L'. 179*> \endverbatim 180*> 181*> \param[in] LDA 182*> \verbatim 183*> LDA is INTEGER 184*> The leading dimension of the array A. LDA >= max(1,M). 185*> \endverbatim 186* 187* Authors: 188* ======== 189* 190*> \author Univ. of Tennessee 191*> \author Univ. of California Berkeley 192*> \author Univ. of Colorado Denver 193*> \author NAG Ltd. 194* 195*> \ingroup OTHERauxiliary 196* 197* ===================================================================== 198 SUBROUTINE SLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA ) 199* 200* -- LAPACK auxiliary routine -- 201* -- LAPACK is a software package provided by Univ. of Tennessee, -- 202* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 203* 204* .. Scalar Arguments .. 205 CHARACTER DIRECT, PIVOT, SIDE 206 INTEGER LDA, M, N 207* .. 208* .. Array Arguments .. 209 REAL A( LDA, * ), C( * ), S( * ) 210* .. 211* 212* ===================================================================== 213* 214* .. Parameters .. 215 REAL ONE, ZERO 216 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 217* .. 218* .. Local Scalars .. 219 INTEGER I, INFO, J 220 REAL CTEMP, STEMP, TEMP 221* .. 222* .. External Functions .. 223 LOGICAL LSAME 224 EXTERNAL LSAME 225* .. 226* .. External Subroutines .. 227 EXTERNAL XERBLA 228* .. 229* .. Intrinsic Functions .. 230 INTRINSIC MAX 231* .. 232* .. Executable Statements .. 233* 234* Test the input parameters 235* 236 INFO = 0 237 IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN 238 INFO = 1 239 ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT, 240 $ 'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN 241 INFO = 2 242 ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) ) 243 $ THEN 244 INFO = 3 245 ELSE IF( M.LT.0 ) THEN 246 INFO = 4 247 ELSE IF( N.LT.0 ) THEN 248 INFO = 5 249 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN 250 INFO = 9 251 END IF 252 IF( INFO.NE.0 ) THEN 253 CALL XERBLA( 'SLASR ', INFO ) 254 RETURN 255 END IF 256* 257* Quick return if possible 258* 259 IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) ) 260 $ RETURN 261 IF( LSAME( SIDE, 'L' ) ) THEN 262* 263* Form P * A 264* 265 IF( LSAME( PIVOT, 'V' ) ) THEN 266 IF( LSAME( DIRECT, 'F' ) ) THEN 267 DO 20 J = 1, M - 1 268 CTEMP = C( J ) 269 STEMP = S( J ) 270 IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN 271 DO 10 I = 1, N 272 TEMP = A( J+1, I ) 273 A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I ) 274 A( J, I ) = STEMP*TEMP + CTEMP*A( J, I ) 275 10 CONTINUE 276 END IF 277 20 CONTINUE 278 ELSE IF( LSAME( DIRECT, 'B' ) ) THEN 279 DO 40 J = M - 1, 1, -1 280 CTEMP = C( J ) 281 STEMP = S( J ) 282 IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN 283 DO 30 I = 1, N 284 TEMP = A( J+1, I ) 285 A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I ) 286 A( J, I ) = STEMP*TEMP + CTEMP*A( J, I ) 287 30 CONTINUE 288 END IF 289 40 CONTINUE 290 END IF 291 ELSE IF( LSAME( PIVOT, 'T' ) ) THEN 292 IF( LSAME( DIRECT, 'F' ) ) THEN 293 DO 60 J = 2, M 294 CTEMP = C( J-1 ) 295 STEMP = S( J-1 ) 296 IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN 297 DO 50 I = 1, N 298 TEMP = A( J, I ) 299 A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I ) 300 A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I ) 301 50 CONTINUE 302 END IF 303 60 CONTINUE 304 ELSE IF( LSAME( DIRECT, 'B' ) ) THEN 305 DO 80 J = M, 2, -1 306 CTEMP = C( J-1 ) 307 STEMP = S( J-1 ) 308 IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN 309 DO 70 I = 1, N 310 TEMP = A( J, I ) 311 A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I ) 312 A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I ) 313 70 CONTINUE 314 END IF 315 80 CONTINUE 316 END IF 317 ELSE IF( LSAME( PIVOT, 'B' ) ) THEN 318 IF( LSAME( DIRECT, 'F' ) ) THEN 319 DO 100 J = 1, M - 1 320 CTEMP = C( J ) 321 STEMP = S( J ) 322 IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN 323 DO 90 I = 1, N 324 TEMP = A( J, I ) 325 A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP 326 A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP 327 90 CONTINUE 328 END IF 329 100 CONTINUE 330 ELSE IF( LSAME( DIRECT, 'B' ) ) THEN 331 DO 120 J = M - 1, 1, -1 332 CTEMP = C( J ) 333 STEMP = S( J ) 334 IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN 335 DO 110 I = 1, N 336 TEMP = A( J, I ) 337 A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP 338 A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP 339 110 CONTINUE 340 END IF 341 120 CONTINUE 342 END IF 343 END IF 344 ELSE IF( LSAME( SIDE, 'R' ) ) THEN 345* 346* Form A * P**T 347* 348 IF( LSAME( PIVOT, 'V' ) ) THEN 349 IF( LSAME( DIRECT, 'F' ) ) THEN 350 DO 140 J = 1, N - 1 351 CTEMP = C( J ) 352 STEMP = S( J ) 353 IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN 354 DO 130 I = 1, M 355 TEMP = A( I, J+1 ) 356 A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J ) 357 A( I, J ) = STEMP*TEMP + CTEMP*A( I, J ) 358 130 CONTINUE 359 END IF 360 140 CONTINUE 361 ELSE IF( LSAME( DIRECT, 'B' ) ) THEN 362 DO 160 J = N - 1, 1, -1 363 CTEMP = C( J ) 364 STEMP = S( J ) 365 IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN 366 DO 150 I = 1, M 367 TEMP = A( I, J+1 ) 368 A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J ) 369 A( I, J ) = STEMP*TEMP + CTEMP*A( I, J ) 370 150 CONTINUE 371 END IF 372 160 CONTINUE 373 END IF 374 ELSE IF( LSAME( PIVOT, 'T' ) ) THEN 375 IF( LSAME( DIRECT, 'F' ) ) THEN 376 DO 180 J = 2, N 377 CTEMP = C( J-1 ) 378 STEMP = S( J-1 ) 379 IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN 380 DO 170 I = 1, M 381 TEMP = A( I, J ) 382 A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 ) 383 A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 ) 384 170 CONTINUE 385 END IF 386 180 CONTINUE 387 ELSE IF( LSAME( DIRECT, 'B' ) ) THEN 388 DO 200 J = N, 2, -1 389 CTEMP = C( J-1 ) 390 STEMP = S( J-1 ) 391 IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN 392 DO 190 I = 1, M 393 TEMP = A( I, J ) 394 A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 ) 395 A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 ) 396 190 CONTINUE 397 END IF 398 200 CONTINUE 399 END IF 400 ELSE IF( LSAME( PIVOT, 'B' ) ) THEN 401 IF( LSAME( DIRECT, 'F' ) ) THEN 402 DO 220 J = 1, N - 1 403 CTEMP = C( J ) 404 STEMP = S( J ) 405 IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN 406 DO 210 I = 1, M 407 TEMP = A( I, J ) 408 A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP 409 A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP 410 210 CONTINUE 411 END IF 412 220 CONTINUE 413 ELSE IF( LSAME( DIRECT, 'B' ) ) THEN 414 DO 240 J = N - 1, 1, -1 415 CTEMP = C( J ) 416 STEMP = S( J ) 417 IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN 418 DO 230 I = 1, M 419 TEMP = A( I, J ) 420 A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP 421 A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP 422 230 CONTINUE 423 END IF 424 240 CONTINUE 425 END IF 426 END IF 427 END IF 428* 429 RETURN 430* 431* End of SLASR 432* 433 END 434