LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
csbmv.f
Go to the documentation of this file.
00001 *> \brief \b CSBMV
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE CSBMV( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y,
00012 *                         INCY )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       CHARACTER          UPLO
00016 *       INTEGER            INCX, INCY, K, LDA, N
00017 *       COMPLEX            ALPHA, BETA
00018 *       ..
00019 *       .. Array Arguments ..
00020 *       COMPLEX            A( LDA, * ), X( * ), Y( * )
00021 *       ..
00022 *  
00023 *
00024 *> \par Purpose:
00025 *  =============
00026 *>
00027 *> \verbatim
00028 *>
00029 *> CSBMV  performs the matrix-vector  operation
00030 *>
00031 *>    y := alpha*A*x + beta*y,
00032 *>
00033 *> where alpha and beta are scalars, x and y are n element vectors and
00034 *> A is an n by n symmetric band matrix, with k super-diagonals.
00035 *> \endverbatim
00036 *
00037 *  Arguments:
00038 *  ==========
00039 *
00040 *> \verbatim
00041 *>  UPLO   - CHARACTER*1
00042 *>           On entry, UPLO specifies whether the upper or lower
00043 *>           triangular part of the band matrix A is being supplied as
00044 *>           follows:
00045 *>
00046 *>              UPLO = 'U' or 'u'   The upper triangular part of A is
00047 *>                                  being supplied.
00048 *>
00049 *>              UPLO = 'L' or 'l'   The lower triangular part of A is
00050 *>                                  being supplied.
00051 *>
00052 *>           Unchanged on exit.
00053 *>
00054 *>  N      - INTEGER
00055 *>           On entry, N specifies the order of the matrix A.
00056 *>           N must be at least zero.
00057 *>           Unchanged on exit.
00058 *>
00059 *>  K      - INTEGER
00060 *>           On entry, K specifies the number of super-diagonals of the
00061 *>           matrix A. K must satisfy  0 .le. K.
00062 *>           Unchanged on exit.
00063 *>
00064 *>  ALPHA  - COMPLEX
00065 *>           On entry, ALPHA specifies the scalar alpha.
00066 *>           Unchanged on exit.
00067 *>
00068 *>  A      - COMPLEX array, dimension( LDA, N )
00069 *>           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
00070 *>           by n part of the array A must contain the upper triangular
00071 *>           band part of the symmetric matrix, supplied column by
00072 *>           column, with the leading diagonal of the matrix in row
00073 *>           ( k + 1 ) of the array, the first super-diagonal starting at
00074 *>           position 2 in row k, and so on. The top left k by k triangle
00075 *>           of the array A is not referenced.
00076 *>           The following program segment will transfer the upper
00077 *>           triangular part of a symmetric band matrix from conventional
00078 *>           full matrix storage to band storage:
00079 *>
00080 *>                 DO 20, J = 1, N
00081 *>                    M = K + 1 - J
00082 *>                    DO 10, I = MAX( 1, J - K ), J
00083 *>                       A( M + I, J ) = matrix( I, J )
00084 *>              10    CONTINUE
00085 *>              20 CONTINUE
00086 *>
00087 *>           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
00088 *>           by n part of the array A must contain the lower triangular
00089 *>           band part of the symmetric matrix, supplied column by
00090 *>           column, with the leading diagonal of the matrix in row 1 of
00091 *>           the array, the first sub-diagonal starting at position 1 in
00092 *>           row 2, and so on. The bottom right k by k triangle of the
00093 *>           array A is not referenced.
00094 *>           The following program segment will transfer the lower
00095 *>           triangular part of a symmetric band matrix from conventional
00096 *>           full matrix storage to band storage:
00097 *>
00098 *>                 DO 20, J = 1, N
00099 *>                    M = 1 - J
00100 *>                    DO 10, I = J, MIN( N, J + K )
00101 *>                       A( M + I, J ) = matrix( I, J )
00102 *>              10    CONTINUE
00103 *>              20 CONTINUE
00104 *>
00105 *>           Unchanged on exit.
00106 *>
00107 *>  LDA    - INTEGER
00108 *>           On entry, LDA specifies the first dimension of A as declared
00109 *>           in the calling (sub) program. LDA must be at least
00110 *>           ( k + 1 ).
00111 *>           Unchanged on exit.
00112 *>
00113 *>  X      - COMPLEX array, dimension at least
00114 *>           ( 1 + ( N - 1 )*abs( INCX ) ).
00115 *>           Before entry, the incremented array X must contain the
00116 *>           vector x.
00117 *>           Unchanged on exit.
00118 *>
00119 *>  INCX   - INTEGER
00120 *>           On entry, INCX specifies the increment for the elements of
00121 *>           X. INCX must not be zero.
00122 *>           Unchanged on exit.
00123 *>
00124 *>  BETA   - COMPLEX
00125 *>           On entry, BETA specifies the scalar beta.
00126 *>           Unchanged on exit.
00127 *>
00128 *>  Y      - COMPLEX array, dimension at least
00129 *>           ( 1 + ( N - 1 )*abs( INCY ) ).
00130 *>           Before entry, the incremented array Y must contain the
00131 *>           vector y. On exit, Y is overwritten by the updated vector y.
00132 *>
00133 *>  INCY   - INTEGER
00134 *>           On entry, INCY specifies the increment for the elements of
00135 *>           Y. INCY must not be zero.
00136 *>           Unchanged on exit.
00137 *> \endverbatim
00138 *
00139 *  Authors:
00140 *  ========
00141 *
00142 *> \author Univ. of Tennessee 
00143 *> \author Univ. of California Berkeley 
00144 *> \author Univ. of Colorado Denver 
00145 *> \author NAG Ltd. 
00146 *
00147 *> \date November 2011
00148 *
00149 *> \ingroup complex_lin
00150 *
00151 *  =====================================================================
00152       SUBROUTINE CSBMV( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y,
00153      $                  INCY )
00154 *
00155 *  -- LAPACK test routine (version 3.4.0) --
00156 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00157 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00158 *     November 2011
00159 *
00160 *     .. Scalar Arguments ..
00161       CHARACTER          UPLO
00162       INTEGER            INCX, INCY, K, LDA, N
00163       COMPLEX            ALPHA, BETA
00164 *     ..
00165 *     .. Array Arguments ..
00166       COMPLEX            A( LDA, * ), X( * ), Y( * )
00167 *     ..
00168 *
00169 *  =====================================================================
00170 *
00171 *     .. Parameters ..
00172       COMPLEX            ONE
00173       PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ) )
00174       COMPLEX            ZERO
00175       PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
00176 *     ..
00177 *     .. Local Scalars ..
00178       INTEGER            I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L
00179       COMPLEX            TEMP1, TEMP2
00180 *     ..
00181 *     .. External Functions ..
00182       LOGICAL            LSAME
00183       EXTERNAL           LSAME
00184 *     ..
00185 *     .. External Subroutines ..
00186       EXTERNAL           XERBLA
00187 *     ..
00188 *     .. Intrinsic Functions ..
00189       INTRINSIC          MAX, MIN
00190 *     ..
00191 *     .. Executable Statements ..
00192 *
00193 *     Test the input parameters.
00194 *
00195       INFO = 0
00196       IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
00197          INFO = 1
00198       ELSE IF( N.LT.0 ) THEN
00199          INFO = 2
00200       ELSE IF( K.LT.0 ) THEN
00201          INFO = 3
00202       ELSE IF( LDA.LT.( K+1 ) ) THEN
00203          INFO = 6
00204       ELSE IF( INCX.EQ.0 ) THEN
00205          INFO = 8
00206       ELSE IF( INCY.EQ.0 ) THEN
00207          INFO = 11
00208       END IF
00209       IF( INFO.NE.0 ) THEN
00210          CALL XERBLA( 'CSBMV ', INFO )
00211          RETURN
00212       END IF
00213 *
00214 *     Quick return if possible.
00215 *
00216       IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) )
00217      $   RETURN
00218 *
00219 *     Set up the start points in  X  and  Y.
00220 *
00221       IF( INCX.GT.0 ) THEN
00222          KX = 1
00223       ELSE
00224          KX = 1 - ( N-1 )*INCX
00225       END IF
00226       IF( INCY.GT.0 ) THEN
00227          KY = 1
00228       ELSE
00229          KY = 1 - ( N-1 )*INCY
00230       END IF
00231 *
00232 *     Start the operations. In this version the elements of the array A
00233 *     are accessed sequentially with one pass through A.
00234 *
00235 *     First form  y := beta*y.
00236 *
00237       IF( BETA.NE.ONE ) THEN
00238          IF( INCY.EQ.1 ) THEN
00239             IF( BETA.EQ.ZERO ) THEN
00240                DO 10 I = 1, N
00241                   Y( I ) = ZERO
00242    10          CONTINUE
00243             ELSE
00244                DO 20 I = 1, N
00245                   Y( I ) = BETA*Y( I )
00246    20          CONTINUE
00247             END IF
00248          ELSE
00249             IY = KY
00250             IF( BETA.EQ.ZERO ) THEN
00251                DO 30 I = 1, N
00252                   Y( IY ) = ZERO
00253                   IY = IY + INCY
00254    30          CONTINUE
00255             ELSE
00256                DO 40 I = 1, N
00257                   Y( IY ) = BETA*Y( IY )
00258                   IY = IY + INCY
00259    40          CONTINUE
00260             END IF
00261          END IF
00262       END IF
00263       IF( ALPHA.EQ.ZERO )
00264      $   RETURN
00265       IF( LSAME( UPLO, 'U' ) ) THEN
00266 *
00267 *        Form  y  when upper triangle of A is stored.
00268 *
00269          KPLUS1 = K + 1
00270          IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
00271             DO 60 J = 1, N
00272                TEMP1 = ALPHA*X( J )
00273                TEMP2 = ZERO
00274                L = KPLUS1 - J
00275                DO 50 I = MAX( 1, J-K ), J - 1
00276                   Y( I ) = Y( I ) + TEMP1*A( L+I, J )
00277                   TEMP2 = TEMP2 + A( L+I, J )*X( I )
00278    50          CONTINUE
00279                Y( J ) = Y( J ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2
00280    60       CONTINUE
00281          ELSE
00282             JX = KX
00283             JY = KY
00284             DO 80 J = 1, N
00285                TEMP1 = ALPHA*X( JX )
00286                TEMP2 = ZERO
00287                IX = KX
00288                IY = KY
00289                L = KPLUS1 - J
00290                DO 70 I = MAX( 1, J-K ), J - 1
00291                   Y( IY ) = Y( IY ) + TEMP1*A( L+I, J )
00292                   TEMP2 = TEMP2 + A( L+I, J )*X( IX )
00293                   IX = IX + INCX
00294                   IY = IY + INCY
00295    70          CONTINUE
00296                Y( JY ) = Y( JY ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2
00297                JX = JX + INCX
00298                JY = JY + INCY
00299                IF( J.GT.K ) THEN
00300                   KX = KX + INCX
00301                   KY = KY + INCY
00302                END IF
00303    80       CONTINUE
00304          END IF
00305       ELSE
00306 *
00307 *        Form  y  when lower triangle of A is stored.
00308 *
00309          IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
00310             DO 100 J = 1, N
00311                TEMP1 = ALPHA*X( J )
00312                TEMP2 = ZERO
00313                Y( J ) = Y( J ) + TEMP1*A( 1, J )
00314                L = 1 - J
00315                DO 90 I = J + 1, MIN( N, J+K )
00316                   Y( I ) = Y( I ) + TEMP1*A( L+I, J )
00317                   TEMP2 = TEMP2 + A( L+I, J )*X( I )
00318    90          CONTINUE
00319                Y( J ) = Y( J ) + ALPHA*TEMP2
00320   100       CONTINUE
00321          ELSE
00322             JX = KX
00323             JY = KY
00324             DO 120 J = 1, N
00325                TEMP1 = ALPHA*X( JX )
00326                TEMP2 = ZERO
00327                Y( JY ) = Y( JY ) + TEMP1*A( 1, J )
00328                L = 1 - J
00329                IX = JX
00330                IY = JY
00331                DO 110 I = J + 1, MIN( N, J+K )
00332                   IX = IX + INCX
00333                   IY = IY + INCY
00334                   Y( IY ) = Y( IY ) + TEMP1*A( L+I, J )
00335                   TEMP2 = TEMP2 + A( L+I, J )*X( IX )
00336   110          CONTINUE
00337                Y( JY ) = Y( JY ) + ALPHA*TEMP2
00338                JX = JX + INCX
00339                JY = JY + INCY
00340   120       CONTINUE
00341          END IF
00342       END IF
00343 *
00344       RETURN
00345 *
00346 *     End of CSBMV
00347 *
00348       END
 All Files Functions