SRC/slasr.f

   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 *> \date September 2012
 196 *
 197 *> \ingroup auxOTHERauxiliary
 198 *
 199 *  =====================================================================
 200       SUBROUTINE SLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
 201 *
 202 *  -- LAPACK auxiliary routine (version 3.4.2) --
 203 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 204 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 205 *     September 2012
 206 *
 207 *     .. Scalar Arguments ..
 208       CHARACTER          DIRECT, PIVOT, SIDE
 209       INTEGER            LDA, M, N
 210 *     ..
 211 *     .. Array Arguments ..
 212       REAL               A( LDA, * ), C( * ), S( * )
 213 *     ..
 214 *
 215 *  =====================================================================
 216 *
 217 *     .. Parameters ..
 218       REAL               ONE, ZERO
 219       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
 220 *     ..
 221 *     .. Local Scalars ..
 222       INTEGER            I, INFO, J
 223       REAL               CTEMP, STEMP, TEMP
 224 *     ..
 225 *     .. External Functions ..
 226       LOGICAL            LSAME
 227       EXTERNAL           LSAME
 228 *     ..
 229 *     .. External Subroutines ..
 230       EXTERNAL           XERBLA
 231 *     ..
 232 *     .. Intrinsic Functions ..
 233       INTRINSIC          MAX
 234 *     ..
 235 *     .. Executable Statements ..
 236 *
 237 *     Test the input parameters
 238 *
 239       INFO = 0
 240       IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN
 241          INFO = 1
 242       ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT,
 243      $         'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN
 244          INFO = 2
 245       ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) )
 246      $          THEN
 247          INFO = 3
 248       ELSE IF( M.LT.0 ) THEN
 249          INFO = 4
 250       ELSE IF( N.LT.0 ) THEN
 251          INFO = 5
 252       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
 253          INFO = 9
 254       END IF
 255       IF( INFO.NE.0 ) THEN
 256          CALL XERBLA( 'SLASR ', INFO )
 257          RETURN
 258       END IF
 259 *
 260 *     Quick return if possible
 261 *
 262       IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
 263      $   RETURN
 264       IF( LSAME( SIDE, 'L' ) ) THEN
 265 *
 266 *        Form  P * A
 267 *
 268          IF( LSAME( PIVOT, 'V' ) ) THEN
 269             IF( LSAME( DIRECT, 'F' ) ) THEN
 270                DO 20 J = 1, M - 1
 271                   CTEMP = C( J )
 272                   STEMP = S( J )
 273                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
 274                      DO 10 I = 1, N
 275                         TEMP = A( J+1, I )
 276                         A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
 277                         A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
 278    10                CONTINUE
 279                   END IF
 280    20          CONTINUE
 281             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
 282                DO 40 J = M - 1, 1, -1
 283                   CTEMP = C( J )
 284                   STEMP = S( J )
 285                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
 286                      DO 30 I = 1, N
 287                         TEMP = A( J+1, I )
 288                         A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
 289                         A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
 290    30                CONTINUE
 291                   END IF
 292    40          CONTINUE
 293             END IF
 294          ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
 295             IF( LSAME( DIRECT, 'F' ) ) THEN
 296                DO 60 J = 2, M
 297                   CTEMP = C( J-1 )
 298                   STEMP = S( J-1 )
 299                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
 300                      DO 50 I = 1, N
 301                         TEMP = A( J, I )
 302                         A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
 303                         A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
 304    50                CONTINUE
 305                   END IF
 306    60          CONTINUE
 307             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
 308                DO 80 J = M, 2, -1
 309                   CTEMP = C( J-1 )
 310                   STEMP = S( J-1 )
 311                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
 312                      DO 70 I = 1, N
 313                         TEMP = A( J, I )
 314                         A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
 315                         A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
 316    70                CONTINUE
 317                   END IF
 318    80          CONTINUE
 319             END IF
 320          ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
 321             IF( LSAME( DIRECT, 'F' ) ) THEN
 322                DO 100 J = 1, M - 1
 323                   CTEMP = C( J )
 324                   STEMP = S( J )
 325                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
 326                      DO 90 I = 1, N
 327                         TEMP = A( J, I )
 328                         A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
 329                         A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
 330    90                CONTINUE
 331                   END IF
 332   100          CONTINUE
 333             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
 334                DO 120 J = M - 1, 1, -1
 335                   CTEMP = C( J )
 336                   STEMP = S( J )
 337                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
 338                      DO 110 I = 1, N
 339                         TEMP = A( J, I )
 340                         A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
 341                         A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
 342   110                CONTINUE
 343                   END IF
 344   120          CONTINUE
 345             END IF
 346          END IF
 347       ELSE IF( LSAME( SIDE, 'R' ) ) THEN
 348 *
 349 *        Form A * P**T
 350 *
 351          IF( LSAME( PIVOT, 'V' ) ) THEN
 352             IF( LSAME( DIRECT, 'F' ) ) THEN
 353                DO 140 J = 1, N - 1
 354                   CTEMP = C( J )
 355                   STEMP = S( J )
 356                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
 357                      DO 130 I = 1, M
 358                         TEMP = A( I, J+1 )
 359                         A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
 360                         A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
 361   130                CONTINUE
 362                   END IF
 363   140          CONTINUE
 364             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
 365                DO 160 J = N - 1, 1, -1
 366                   CTEMP = C( J )
 367                   STEMP = S( J )
 368                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
 369                      DO 150 I = 1, M
 370                         TEMP = A( I, J+1 )
 371                         A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
 372                         A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
 373   150                CONTINUE
 374                   END IF
 375   160          CONTINUE
 376             END IF
 377          ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
 378             IF( LSAME( DIRECT, 'F' ) ) THEN
 379                DO 180 J = 2, N
 380                   CTEMP = C( J-1 )
 381                   STEMP = S( J-1 )
 382                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
 383                      DO 170 I = 1, M
 384                         TEMP = A( I, J )
 385                         A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
 386                         A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
 387   170                CONTINUE
 388                   END IF
 389   180          CONTINUE
 390             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
 391                DO 200 J = N, 2, -1
 392                   CTEMP = C( J-1 )
 393                   STEMP = S( J-1 )
 394                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
 395                      DO 190 I = 1, M
 396                         TEMP = A( I, J )
 397                         A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
 398                         A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
 399   190                CONTINUE
 400                   END IF
 401   200          CONTINUE
 402             END IF
 403          ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
 404             IF( LSAME( DIRECT, 'F' ) ) THEN
 405                DO 220 J = 1, N - 1
 406                   CTEMP = C( J )
 407                   STEMP = S( J )
 408                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
 409                      DO 210 I = 1, M
 410                         TEMP = A( I, J )
 411                         A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
 412                         A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
 413   210                CONTINUE
 414                   END IF
 415   220          CONTINUE
 416             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
 417                DO 240 J = N - 1, 1, -1
 418                   CTEMP = C( J )
 419                   STEMP = S( J )
 420                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
 421                      DO 230 I = 1, M
 422                         TEMP = A( I, J )
 423                         A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
 424                         A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
 425   230                CONTINUE
 426                   END IF
 427   240          CONTINUE
 428             END IF
 429          END IF
 430       END IF
 431 *
 432       RETURN
 433 *
 434 *     End of SLASR
 435 *
 436       END