SRC/zlasr.f

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