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