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