LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zlasr.f
Go to the documentation of this file.
00001 *> \brief \b ZLASR
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download ZLASR + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlasr.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlasr.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlasr.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE ZLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       CHARACTER          DIRECT, PIVOT, SIDE
00025 *       INTEGER            LDA, M, N
00026 *       ..
00027 *       .. Array Arguments ..
00028 *       DOUBLE PRECISION   C( * ), S( * )
00029 *       COMPLEX*16         A( LDA, * )
00030 *       ..
00031 *  
00032 *
00033 *> \par Purpose:
00034 *  =============
00035 *>
00036 *> \verbatim
00037 *>
00038 *> ZLASR applies a sequence of real plane rotations to a complex matrix
00039 *> A, from either the left or the right.
00040 *>
00041 *> When SIDE = 'L', the transformation takes the form
00042 *>
00043 *>    A := P*A
00044 *>
00045 *> and when SIDE = 'R', the transformation takes the form
00046 *>
00047 *>    A := A*P**T
00048 *>
00049 *> where P is an orthogonal matrix consisting of a sequence of z plane
00050 *> rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
00051 *> and P**T is the transpose of P.
00052 *> 
00053 *> When DIRECT = 'F' (Forward sequence), then
00054 *> 
00055 *>    P = P(z-1) * ... * P(2) * P(1)
00056 *> 
00057 *> and when DIRECT = 'B' (Backward sequence), then
00058 *> 
00059 *>    P = P(1) * P(2) * ... * P(z-1)
00060 *> 
00061 *> where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
00062 *> 
00063 *>    R(k) = (  c(k)  s(k) )
00064 *>         = ( -s(k)  c(k) ).
00065 *> 
00066 *> When PIVOT = 'V' (Variable pivot), the rotation is performed
00067 *> for the plane (k,k+1), i.e., P(k) has the form
00068 *> 
00069 *>    P(k) = (  1                                            )
00070 *>           (       ...                                     )
00071 *>           (              1                                )
00072 *>           (                   c(k)  s(k)                  )
00073 *>           (                  -s(k)  c(k)                  )
00074 *>           (                                1              )
00075 *>           (                                     ...       )
00076 *>           (                                            1  )
00077 *> 
00078 *> where R(k) appears as a rank-2 modification to the identity matrix in
00079 *> rows and columns k and k+1.
00080 *> 
00081 *> When PIVOT = 'T' (Top pivot), the rotation is performed for the
00082 *> plane (1,k+1), so P(k) has the form
00083 *> 
00084 *>    P(k) = (  c(k)                    s(k)                 )
00085 *>           (         1                                     )
00086 *>           (              ...                              )
00087 *>           (                     1                         )
00088 *>           ( -s(k)                    c(k)                 )
00089 *>           (                                 1             )
00090 *>           (                                      ...      )
00091 *>           (                                             1 )
00092 *> 
00093 *> where R(k) appears in rows and columns 1 and k+1.
00094 *> 
00095 *> Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
00096 *> performed for the plane (k,z), giving P(k) the form
00097 *> 
00098 *>    P(k) = ( 1                                             )
00099 *>           (      ...                                      )
00100 *>           (             1                                 )
00101 *>           (                  c(k)                    s(k) )
00102 *>           (                         1                     )
00103 *>           (                              ...              )
00104 *>           (                                     1         )
00105 *>           (                 -s(k)                    c(k) )
00106 *> 
00107 *> where R(k) appears in rows and columns k and z.  The rotations are
00108 *> performed without ever forming P(k) explicitly.
00109 *> \endverbatim
00110 *
00111 *  Arguments:
00112 *  ==========
00113 *
00114 *> \param[in] SIDE
00115 *> \verbatim
00116 *>          SIDE is CHARACTER*1
00117 *>          Specifies whether the plane rotation matrix P is applied to
00118 *>          A on the left or the right.
00119 *>          = 'L':  Left, compute A := P*A
00120 *>          = 'R':  Right, compute A:= A*P**T
00121 *> \endverbatim
00122 *>
00123 *> \param[in] PIVOT
00124 *> \verbatim
00125 *>          PIVOT is CHARACTER*1
00126 *>          Specifies the plane for which P(k) is a plane rotation
00127 *>          matrix.
00128 *>          = 'V':  Variable pivot, the plane (k,k+1)
00129 *>          = 'T':  Top pivot, the plane (1,k+1)
00130 *>          = 'B':  Bottom pivot, the plane (k,z)
00131 *> \endverbatim
00132 *>
00133 *> \param[in] DIRECT
00134 *> \verbatim
00135 *>          DIRECT is CHARACTER*1
00136 *>          Specifies whether P is a forward or backward sequence of
00137 *>          plane rotations.
00138 *>          = 'F':  Forward, P = P(z-1)*...*P(2)*P(1)
00139 *>          = 'B':  Backward, P = P(1)*P(2)*...*P(z-1)
00140 *> \endverbatim
00141 *>
00142 *> \param[in] M
00143 *> \verbatim
00144 *>          M is INTEGER
00145 *>          The number of rows of the matrix A.  If m <= 1, an immediate
00146 *>          return is effected.
00147 *> \endverbatim
00148 *>
00149 *> \param[in] N
00150 *> \verbatim
00151 *>          N is INTEGER
00152 *>          The number of columns of the matrix A.  If n <= 1, an
00153 *>          immediate return is effected.
00154 *> \endverbatim
00155 *>
00156 *> \param[in] C
00157 *> \verbatim
00158 *>          C is DOUBLE PRECISION array, dimension
00159 *>                  (M-1) if SIDE = 'L'
00160 *>                  (N-1) if SIDE = 'R'
00161 *>          The cosines c(k) of the plane rotations.
00162 *> \endverbatim
00163 *>
00164 *> \param[in] S
00165 *> \verbatim
00166 *>          S is DOUBLE PRECISION array, dimension
00167 *>                  (M-1) if SIDE = 'L'
00168 *>                  (N-1) if SIDE = 'R'
00169 *>          The sines s(k) of the plane rotations.  The 2-by-2 plane
00170 *>          rotation part of the matrix P(k), R(k), has the form
00171 *>          R(k) = (  c(k)  s(k) )
00172 *>                 ( -s(k)  c(k) ).
00173 *> \endverbatim
00174 *>
00175 *> \param[in,out] A
00176 *> \verbatim
00177 *>          A is COMPLEX*16 array, dimension (LDA,N)
00178 *>          The M-by-N matrix A.  On exit, A is overwritten by P*A if
00179 *>          SIDE = 'R' or by A*P**T if SIDE = 'L'.
00180 *> \endverbatim
00181 *>
00182 *> \param[in] LDA
00183 *> \verbatim
00184 *>          LDA is INTEGER
00185 *>          The leading dimension of the array A.  LDA >= max(1,M).
00186 *> \endverbatim
00187 *
00188 *  Authors:
00189 *  ========
00190 *
00191 *> \author Univ. of Tennessee 
00192 *> \author Univ. of California Berkeley 
00193 *> \author Univ. of Colorado Denver 
00194 *> \author NAG Ltd. 
00195 *
00196 *> \date November 2011
00197 *
00198 *> \ingroup complex16OTHERauxiliary
00199 *
00200 *  =====================================================================
00201       SUBROUTINE ZLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
00202 *
00203 *  -- LAPACK auxiliary routine (version 3.4.0) --
00204 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00205 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00206 *     November 2011
00207 *
00208 *     .. Scalar Arguments ..
00209       CHARACTER          DIRECT, PIVOT, SIDE
00210       INTEGER            LDA, M, N
00211 *     ..
00212 *     .. Array Arguments ..
00213       DOUBLE PRECISION   C( * ), S( * )
00214       COMPLEX*16         A( LDA, * )
00215 *     ..
00216 *
00217 *  =====================================================================
00218 *
00219 *     .. Parameters ..
00220       DOUBLE PRECISION   ONE, ZERO
00221       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00222 *     ..
00223 *     .. Local Scalars ..
00224       INTEGER            I, INFO, J
00225       DOUBLE PRECISION   CTEMP, STEMP
00226       COMPLEX*16         TEMP
00227 *     ..
00228 *     .. Intrinsic Functions ..
00229       INTRINSIC          MAX
00230 *     ..
00231 *     .. External Functions ..
00232       LOGICAL            LSAME
00233       EXTERNAL           LSAME
00234 *     ..
00235 *     .. External Subroutines ..
00236       EXTERNAL           XERBLA
00237 *     ..
00238 *     .. Executable Statements ..
00239 *
00240 *     Test the input parameters
00241 *
00242       INFO = 0
00243       IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN
00244          INFO = 1
00245       ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT,
00246      $         'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN
00247          INFO = 2
00248       ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) )
00249      $          THEN
00250          INFO = 3
00251       ELSE IF( M.LT.0 ) THEN
00252          INFO = 4
00253       ELSE IF( N.LT.0 ) THEN
00254          INFO = 5
00255       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
00256          INFO = 9
00257       END IF
00258       IF( INFO.NE.0 ) THEN
00259          CALL XERBLA( 'ZLASR ', INFO )
00260          RETURN
00261       END IF
00262 *
00263 *     Quick return if possible
00264 *
00265       IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
00266      $   RETURN
00267       IF( LSAME( SIDE, 'L' ) ) THEN
00268 *
00269 *        Form  P * A
00270 *
00271          IF( LSAME( PIVOT, 'V' ) ) THEN
00272             IF( LSAME( DIRECT, 'F' ) ) THEN
00273                DO 20 J = 1, M - 1
00274                   CTEMP = C( J )
00275                   STEMP = S( J )
00276                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
00277                      DO 10 I = 1, N
00278                         TEMP = A( J+1, I )
00279                         A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
00280                         A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
00281    10                CONTINUE
00282                   END IF
00283    20          CONTINUE
00284             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
00285                DO 40 J = M - 1, 1, -1
00286                   CTEMP = C( J )
00287                   STEMP = S( J )
00288                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
00289                      DO 30 I = 1, N
00290                         TEMP = A( J+1, I )
00291                         A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
00292                         A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
00293    30                CONTINUE
00294                   END IF
00295    40          CONTINUE
00296             END IF
00297          ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
00298             IF( LSAME( DIRECT, 'F' ) ) THEN
00299                DO 60 J = 2, M
00300                   CTEMP = C( J-1 )
00301                   STEMP = S( J-1 )
00302                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
00303                      DO 50 I = 1, N
00304                         TEMP = A( J, I )
00305                         A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
00306                         A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
00307    50                CONTINUE
00308                   END IF
00309    60          CONTINUE
00310             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
00311                DO 80 J = M, 2, -1
00312                   CTEMP = C( J-1 )
00313                   STEMP = S( J-1 )
00314                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
00315                      DO 70 I = 1, N
00316                         TEMP = A( J, I )
00317                         A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
00318                         A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
00319    70                CONTINUE
00320                   END IF
00321    80          CONTINUE
00322             END IF
00323          ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
00324             IF( LSAME( DIRECT, 'F' ) ) THEN
00325                DO 100 J = 1, M - 1
00326                   CTEMP = C( J )
00327                   STEMP = S( J )
00328                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
00329                      DO 90 I = 1, N
00330                         TEMP = A( J, I )
00331                         A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
00332                         A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
00333    90                CONTINUE
00334                   END IF
00335   100          CONTINUE
00336             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
00337                DO 120 J = M - 1, 1, -1
00338                   CTEMP = C( J )
00339                   STEMP = S( J )
00340                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
00341                      DO 110 I = 1, N
00342                         TEMP = A( J, I )
00343                         A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
00344                         A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
00345   110                CONTINUE
00346                   END IF
00347   120          CONTINUE
00348             END IF
00349          END IF
00350       ELSE IF( LSAME( SIDE, 'R' ) ) THEN
00351 *
00352 *        Form A * P**T
00353 *
00354          IF( LSAME( PIVOT, 'V' ) ) THEN
00355             IF( LSAME( DIRECT, 'F' ) ) THEN
00356                DO 140 J = 1, N - 1
00357                   CTEMP = C( J )
00358                   STEMP = S( J )
00359                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
00360                      DO 130 I = 1, M
00361                         TEMP = A( I, J+1 )
00362                         A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
00363                         A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
00364   130                CONTINUE
00365                   END IF
00366   140          CONTINUE
00367             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
00368                DO 160 J = N - 1, 1, -1
00369                   CTEMP = C( J )
00370                   STEMP = S( J )
00371                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
00372                      DO 150 I = 1, M
00373                         TEMP = A( I, J+1 )
00374                         A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
00375                         A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
00376   150                CONTINUE
00377                   END IF
00378   160          CONTINUE
00379             END IF
00380          ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
00381             IF( LSAME( DIRECT, 'F' ) ) THEN
00382                DO 180 J = 2, N
00383                   CTEMP = C( J-1 )
00384                   STEMP = S( J-1 )
00385                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
00386                      DO 170 I = 1, M
00387                         TEMP = A( I, J )
00388                         A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
00389                         A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
00390   170                CONTINUE
00391                   END IF
00392   180          CONTINUE
00393             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
00394                DO 200 J = N, 2, -1
00395                   CTEMP = C( J-1 )
00396                   STEMP = S( J-1 )
00397                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
00398                      DO 190 I = 1, M
00399                         TEMP = A( I, J )
00400                         A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
00401                         A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
00402   190                CONTINUE
00403                   END IF
00404   200          CONTINUE
00405             END IF
00406          ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
00407             IF( LSAME( DIRECT, 'F' ) ) THEN
00408                DO 220 J = 1, N - 1
00409                   CTEMP = C( J )
00410                   STEMP = S( J )
00411                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
00412                      DO 210 I = 1, M
00413                         TEMP = A( I, J )
00414                         A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
00415                         A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
00416   210                CONTINUE
00417                   END IF
00418   220          CONTINUE
00419             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
00420                DO 240 J = N - 1, 1, -1
00421                   CTEMP = C( J )
00422                   STEMP = S( J )
00423                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
00424                      DO 230 I = 1, M
00425                         TEMP = A( I, J )
00426                         A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
00427                         A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
00428   230                CONTINUE
00429                   END IF
00430   240          CONTINUE
00431             END IF
00432          END IF
00433       END IF
00434 *
00435       RETURN
00436 *
00437 *     End of ZLASR
00438 *
00439       END
 All Files Functions